From 77ab8484e1bb55471c83b2a700d974dd2f4dcbfd Mon Sep 17 00:00:00 2001 From: Yvan Sraka Date: Mon, 17 Apr 2023 16:06:43 +0200 Subject: [PATCH] Fix #42: use patches for revisions Co-authored-by: Michael Peyton Jones --- app/Foliage/CmdBuild.hs | 50 ++++++++++------- app/Foliage/Pages.hs | 27 +++++----- app/Foliage/PreparePackageVersion.hs | 80 +++++++++------------------- 3 files changed, 70 insertions(+), 87 deletions(-) diff --git a/app/Foliage/CmdBuild.hs b/app/Foliage/CmdBuild.hs index 36540a1..94fa814 100644 --- a/app/Foliage/CmdBuild.hs +++ b/app/Foliage/CmdBuild.hs @@ -10,7 +10,6 @@ import Codec.Compression.GZip qualified as GZip import Control.Monad (unless, void, when) import Data.Aeson qualified as Aeson import Data.Bifunctor (second) -import Data.ByteString.Char8 qualified as BS import Data.ByteString.Lazy.Char8 qualified as BL import Data.List (sortOn) import Data.List.NonEmpty qualified as NE @@ -28,7 +27,7 @@ import Foliage.Meta import Foliage.Meta.Aeson () import Foliage.Options import Foliage.Pages -import Foliage.PreparePackageVersion (PreparedPackageVersion (..), preparePackageVersion) +import Foliage.PreparePackageVersion (PreparedPackageVersion (..), Timestamped (..), preparePackageVersion) import Foliage.PrepareSdist (addPrepareSdistRule) import Foliage.PrepareSource (addPrepareSourceRule) import Foliage.RemoteAsset (addFetchRemoteAssetRule) @@ -113,18 +112,14 @@ buildAction cabalEntries <- foldMap - ( \PreparedPackageVersion {pkgId, pkgTimestamp, originalCabalFilePath, cabalFileRevisions} -> do + ( \PreparedPackageVersion {pkgId, pkgTimestamp, originalCabalFilePath, cabalFileRevisions} -> -- original cabal file, with its timestamp (if specified) let cabalFileTimestamp = fromMaybe currentTime pkgTimestamp - cf <- prepareIndexPkgCabal pkgId cabalFileTimestamp originalCabalFilePath - - -- all revised cabal files, with their timestamp - revcf <- for cabalFileRevisions $ uncurry (prepareIndexPkgCabal pkgId) - -- WARN: So far Foliage allows publishing a package and a cabal file revision with the same timestamp -- This accidentally works because 1) the following inserts the original cabal file before the revisions -- AND 2) Data.List.sortOn is stable. The revised cabal file will always be after the original one. - return $ cf : revcf + in -- all revised cabal files, with their timestamp + prepareIndexPkgCabal pkgId (Timestamped cabalFileTimestamp originalCabalFilePath) (sortOn timestamp cabalFileRevisions) ) packageVersions @@ -138,9 +133,8 @@ buildAction liftIO $ BL.writeFile path $ renderSignedJSON targetKeys targets pure $ mkTarEntry - (renderSignedJSON targetKeys targets) + (Timestamped (fromMaybe currentTime pkgTimestamp) (renderSignedJSON targetKeys targets)) (IndexPkgMetadata pkgId) - (fromMaybe currentTime pkgTimestamp) let extraEntries = getExtraEntries packageVersions @@ -284,11 +278,29 @@ getPackageVersions inputDir = do forP metaFiles $ preparePackageVersion inputDir -prepareIndexPkgCabal :: PackageId -> UTCTime -> FilePath -> Action Tar.Entry -prepareIndexPkgCabal pkgId timestamp filePath = do - need [filePath] - contents <- liftIO $ BS.readFile filePath - pure $ mkTarEntry (BL.fromStrict contents) (IndexPkgCabal pkgId) timestamp +prepareIndexPkgCabal :: PackageId -> Timestamped FilePath -> [Timestamped FilePath] -> Action [Tar.Entry] +prepareIndexPkgCabal pkgId (Timestamped timestamp originalFilePath) revisions = do + need (originalFilePath : map timestampedValue revisions) + original <- liftIO (BL.readFile originalFilePath) + revisionsApplied <- applyRevisionsInOrder [Timestamped timestamp original] revisions + pure $ map (\content -> mkTarEntry content (IndexPkgCabal pkgId)) revisionsApplied + +applyRevisionsInOrder :: [Timestamped BL.ByteString] -> [Timestamped FilePath] -> Action [Timestamped BL.ByteString] +applyRevisionsInOrder acc [] = pure (reverse acc) +applyRevisionsInOrder acc (patch : remainingPatches) = do + newContent <- applyRevision (timestampedValue $ last acc) patch + applyRevisionsInOrder (newContent : acc) remainingPatches + +applyRevision :: BL.ByteString -> Timestamped FilePath -> Action (Timestamped BL.ByteString) +applyRevision lastRevisionContents (Timestamped timestamp revisionPath) = do + content <- + if takeExtension revisionPath `elem` [".diff", ".patch"] + then do + liftIO $ putStrLn $ "Applying patch " ++ revisionPath + cmd_ (StdinBS lastRevisionContents) ["patch", "-i", revisionPath] + liftIO $ BL.readFile revisionPath + else pure lastRevisionContents + return $ Timestamped timestamp content prepareIndexPkgMetadata :: Maybe UTCTime -> PreparedPackageVersion -> Action Targets prepareIndexPkgMetadata expiryTime PreparedPackageVersion {pkgId, sdistPath} = do @@ -324,7 +336,7 @@ getExtraEntries packageVersions = effectiveRanges :: [(UTCTime, VersionRange)] effectiveRanges = NE.tail $ NE.scanl applyChangeToRange (posixSecondsToUTCTime 0, anyVersion) deprecationChanges -- Create a `Tar.Entry` for the package group, its computed `VersionRange` and a timestamp. - createTarEntry (ts, effectiveRange) = mkTarEntry (BL.pack $ prettyShow effectiveRange) (IndexPkgPrefs pn) ts + createTarEntry (ts, effectiveRange) = mkTarEntry (Timestamped ts (BL.pack $ prettyShow effectiveRange)) (IndexPkgPrefs pn) in foldMap generateEntriesForGroup groupedPackageVersions -- TODO: the functions belows should be moved to Foliage.PreparedPackageVersion @@ -351,8 +363,8 @@ applyDeprecation pkgVersion deprecated = then intersectVersionRanges (notThisVersion pkgVersion) else unionVersionRanges (thisVersion pkgVersion) -mkTarEntry :: BL.ByteString -> IndexFile dec -> UTCTime -> Tar.Entry -mkTarEntry contents indexFile timestamp = +mkTarEntry :: Timestamped BL.ByteString -> IndexFile dec -> Tar.Entry +mkTarEntry (Timestamped timestamp contents) indexFile = (Tar.fileEntry tarPath contents) { Tar.entryTime = floor $ Time.utcTimeToPOSIXSeconds timestamp, Tar.entryOwnership = diff --git a/app/Foliage/Pages.hs b/app/Foliage/Pages.hs index c0c103f..cbc7c25 100644 --- a/app/Foliage/Pages.hs +++ b/app/Foliage/Pages.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} @@ -29,7 +30,7 @@ import Distribution.Package (PackageIdentifier (pkgName, pkgVersion)) import Distribution.Pretty (prettyShow) import Foliage.Meta (PackageVersionSource) import Foliage.Meta.Aeson () -import Foliage.PreparePackageVersion (PreparedPackageVersion (..)) +import Foliage.PreparePackageVersion (PreparedPackageVersion (..), Timestamped (..)) import Foliage.Utils.Aeson (MyAesonEncoding (..)) import GHC.Generics (Generic) import System.Directory qualified as IO @@ -83,7 +84,7 @@ makeAllPackagesPage currentTime outputDir packageVersions = allPackagesPageEntryTimestamp = fromMaybe currentTime pkgTimestamp, allPackagesPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime pkgTimestamp), allPackagesPageEntrySource = pkgVersionSource, - allPackagesPageEntryLatestRevisionTimestamp = fst <$> listToMaybe cabalFileRevisions + allPackagesPageEntryLatestRevisionTimestamp = timestamp <$> listToMaybe cabalFileRevisions } ) ) @@ -127,16 +128,16 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions = allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime pkgTimestamp), allPackageVersionsPageEntrySource = pkgVersionSource, allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated - } - -- list of revisions - : [ AllPackageVersionsPageEntryRevision - { allPackageVersionsPageEntryPkgId = pkgId, - allPackageVersionsPageEntryTimestamp = revisionTimestamp, - allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp, - allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated - } - | (revisionTimestamp, _) <- cabalFileRevisions - ] + } -- list of revisions + : + [ AllPackageVersionsPageEntryRevision + { allPackageVersionsPageEntryPkgId = pkgId, + allPackageVersionsPageEntryTimestamp = timestamp revision, + allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds $ timestamp revision, + allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated + } + | revision <- cabalFileRevisions + ] ) packageVersions -- sort them by timestamp @@ -150,7 +151,7 @@ makePackageVersionPage outputDir PreparedPackageVersion {pkgId, pkgTimestamp, pk renderMustache packageVersionPageTemplate $ object [ "pkgVersionSource" .= pkgVersionSource, - "cabalFileRevisions" .= map fst cabalFileRevisions, + "cabalFileRevisions" .= map timestamp cabalFileRevisions, "pkgDesc" .= jsonGenericPackageDescription pkgDesc, "pkgTimestamp" .= pkgTimestamp, "pkgVersionDeprecated" .= pkgVersionIsDeprecated diff --git a/app/Foliage/PreparePackageVersion.hs b/app/Foliage/PreparePackageVersion.hs index 2027d1f..19eacbd 100644 --- a/app/Foliage/PreparePackageVersion.hs +++ b/app/Foliage/PreparePackageVersion.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ViewPatterns #-} module Foliage.PreparePackageVersion ( PreparedPackageVersion @@ -18,6 +18,7 @@ module Foliage.PreparePackageVersion ), pattern PreparedPackageVersion, preparePackageVersion, + Timestamped (..), ) where @@ -39,6 +40,9 @@ import Foliage.PrepareSource (prepareSource) import Foliage.Shake (readGenericPackageDescription', readPackageVersionSpec') import System.FilePath (takeBaseName, takeFileName, (<.>), ()) +data Timestamped a = Timestamped {timestamp :: UTCTime, timestampedValue :: a} + deriving (Eq, Ord, Show) + -- TODO: can we ensure that `pkgVersionDeprecationChanges` and `cabalFileRevisions` are -- sorted by timestamp? e.g https://hackage.haskell.org/package/sorted-list data PreparedPackageVersion = PreparedPackageVersion @@ -52,7 +56,7 @@ data PreparedPackageVersion = PreparedPackageVersion sdistPath :: FilePath, cabalFilePath :: FilePath, originalCabalFilePath :: FilePath, - cabalFileRevisions :: [(UTCTime, FilePath)] + cabalFileRevisions :: [Timestamped FilePath] } -- @andreabedini comments: @@ -93,65 +97,31 @@ preparePackageVersion inputDir metaFile = do let pkgId = PackageIdentifier pkgName pkgVersion pkgSpec <- - readPackageVersionSpec' (inputDir metaFile) >>= \meta@PackageVersionSpec {..} -> do - case (NE.nonEmpty packageVersionRevisions, packageVersionTimestamp) of - (Just _someRevisions, Nothing) -> + readPackageVersionSpec' (inputDir metaFile) >>= \case + PackageVersionSpec {packageVersionRevisions, packageVersionTimestamp = Nothing} + | not (null packageVersionRevisions) -> do error $ unlines - [ inputDir metaFile <> " has cabal file revisions but the package has no timestamp.", - "This combination doesn't make sense. Either add a timestamp on the original package or remove the revisions." + [ inputDir metaFile <> " has cabal file revisions but the original package has no timestamp.", + "This combination doesn't make sense. Either add a timestamp on the original package or remove the revisions" ] - (Just (NE.sort -> someRevisions), Just ts) - -- WARN: this should really be a <= - | revisionTimestamp (NE.head someRevisions) < ts -> - error $ - unlines - [ inputDir metaFile <> " has a revision with timestamp earlier than the package itself.", - "Adjust the timestamps so that all revisions come after the package publication." - ] - | not (null $ duplicates (revisionTimestamp <$> someRevisions)) -> - error $ - unlines - [ inputDir metaFile <> " has two revisions entries with the same timestamp.", - "Adjust the timestamps so that all the revisions happen at a different time." - ] - _otherwise -> return () - - case (NE.nonEmpty packageVersionDeprecations, packageVersionTimestamp) of - (Just _someDeprecations, Nothing) -> + PackageVersionSpec {packageVersionRevisions, packageVersionTimestamp = Just pkgTs} + | any ((< pkgTs) . revisionTimestamp) packageVersionRevisions -> do error $ unlines - [ inputDir metaFile <> " has deprecations but the package has no timestamp.", - "This combination doesn't make sense. Either add a timestamp on the original package or remove the deprecation." + [ inputDir metaFile <> " has a revision with timestamp earlier than the package itself.", + "Adjust the timestamps so that all revisions come after the original package" ] - (Just (NE.sort -> someDeprecations), Just ts) - | deprecationTimestamp (NE.head someDeprecations) <= ts -> - error $ - unlines - [ inputDir metaFile <> " has a deprecation entry with timestamp earlier (or equal) than the package itself.", - "Adjust the timestamps so that all the (un-)deprecations come after the package publication." - ] - | not (deprecationIsDeprecated (NE.head someDeprecations)) -> - error $ - "The first deprecation entry in" <> inputDir metaFile <> " cannot be an un-deprecation" - | not (null $ duplicates (deprecationTimestamp <$> someDeprecations)) -> - error $ - unlines - [ inputDir metaFile <> " has two deprecation entries with the same timestamp.", - "Adjust the timestamps so that all the (un-)deprecations happen at a different time." - ] - | not (null $ doubleDeprecations someDeprecations) -> - error $ - unlines - [ inputDir metaFile <> " contains two consecutive deprecations or two consecutive un-deprecations.", - "Make sure deprecations and un-deprecations alternate in time." - ] - _otherwise -> return () - - return meta + meta -> + return meta srcDir <- prepareSource pkgId pkgSpec + -- FIXME: This produce a Shake error since it `need` the file: + -- + -- revisionNumber <.> "cabal" + -- + -- ... which could now be a `.diff` or a `.patch`! let originalCabalFilePath = srcDir prettyShow pkgName <.> "cabal" cabalFileRevisionPath revisionNumber = @@ -189,8 +159,8 @@ preparePackageVersion inputDir metaFile = do let cabalFileRevisions = sortOn - Down - [ (revisionTimestamp, cabalFileRevisionPath revisionNumber) + (Down . timestamp) + [ Timestamped revisionTimestamp (cabalFileRevisionPath revisionNumber) | RevisionSpec {revisionTimestamp, revisionNumber} <- packageVersionRevisions pkgSpec ]