From d56b79b56c46c2c680e96517c4646ed37eb7541e 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 | 103 ++++++++++++------- app/Foliage/Pages.hs | 16 +-- app/Foliage/PreparePackageVersion.hs | 141 ++++++++++++--------------- 3 files changed, 142 insertions(+), 118 deletions(-) diff --git a/app/Foliage/CmdBuild.hs b/app/Foliage/CmdBuild.hs index c44b4ad..734f44b 100644 --- a/app/Foliage/CmdBuild.hs +++ b/app/Foliage/CmdBuild.hs @@ -10,8 +10,8 @@ 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.Foldable (foldlM) import Data.List (sortOn) import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe) @@ -28,7 +28,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.Shake @@ -107,22 +107,41 @@ buildAction cabalEntries <- foldMap ( \PreparedPackageVersion{pkgId, pkgTimestamp, cabalFilePath, originalCabalFilePath, cabalFileRevisions} -> do - -- original cabal file, with its timestamp (if specified) - copyFileChanged originalCabalFilePath (outputDir "package" prettyShow pkgId "revision" "0" <.> "cabal") - cf <- prepareIndexPkgCabal pkgId (fromMaybe currentTime pkgTimestamp) originalCabalFilePath - - -- all revised cabal files, with their timestamp - revcf <- for (zip [1 :: Int ..] cabalFileRevisions) $ \(revNum, (timestamp, path)) -> do - copyFileChanged cabalFilePath (outputDir "package" prettyShow pkgId "revision" show revNum <.> "cabal") - prepareIndexPkgCabal pkgId timestamp path - - -- current version of the cabal file (after the revisions, if any) - copyFileChanged cabalFilePath (outputDir "package" prettyShow pkgId prettyShow (pkgName pkgId) <.> "cabal") - - -- 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 + -- need [originalCabalFilePath] + + -- initial <- do + -- content <- liftIO $ BL.readFile originalCabalFilePath + -- let entry = mkTarEntry (Timestamped (fromMaybe currentTime pkgTimestamp) originalCabalFilePath) (IndexPkgCabal pkgId) + -- _ + -- foldlM + -- (\prevCabalFilePath (revNum, Timestamped ts patchOrNewCabalFile) -> do + -- need [patchOrNewCabalFile] + -- let outputFile = outputDir "package" prettyShow pkgId "revision" show revNum <.> "cabal" + -- if takeExtension patchOrNewCabalFile `elem` [".diff", ".patch"] + -- then do + -- cmd ["patch", "-i", patchOrNewCabalFile, "-o", outputFile, prevCabalFilePath] + -- else copyFileChanged patchOrNewCabalFile outputFile + -- return outputFile + -- ) + -- cabalFilePath + -- (zip [1:: Int ..] cabalFileRevisions) + + -- -- original cabal file, with its timestamp (if specified) + -- copyFileChanged originalCabalFilePath (outputDir "package" prettyShow pkgId "revision" "0" <.> "cabal") + -- cf <- prepareIndexPkgCabal pkgId (Timestamped (fromMaybe currentTime pkgTimestamp) originalCabalFilePath) [] -- FIXME !! + + -- -- all revised cabal files, with their timestamp + -- revcf <- for (zip [1 :: Int ..] cabalFileRevisions) $ \(revNum, path) -> do + -- copyFileChanged cabalFilePath (outputDir "package" prettyShow pkgId "revision" show revNum <.> "cabal") + -- prepareIndexPkgCabal pkgId path [] -- FIXME !! + + -- -- current version of the cabal file (after the revisions, if any) + -- copyFileChanged cabalFilePath (outputDir "package" prettyShow pkgId prettyShow (pkgName pkgId) <.> "cabal") + + -- -- 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 ) packageVersions @@ -133,9 +152,8 @@ buildAction targets <- prepareIndexPkgMetadata expiryTime ppv pure $ mkTarEntry - (renderSignedJSON targetKeys targets) + (Timestamped (fromMaybe currentTime pkgTimestamp) (renderSignedJSON targetKeys targets)) (IndexPkgMetadata pkgId) - (fromMaybe currentTime pkgTimestamp) let extraEntries = getExtraEntries packageVersions @@ -264,11 +282,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 @@ -304,14 +340,13 @@ getExtraEntries packageVersions = -- Calculate (by applying them chronologically) the effective `VersionRange` for the package group. 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 dep) (IndexPkgPrefs pn) ts - where - -- Cabal uses `Dependency` to represent preferred versions, cf. - -- `parsePreferredVersions`. The (sub)libraries part is ignored. - dep = mkDependency pn effectiveRange mainLibSet in + -- -- Create a `Tar.Entry` for the package group, its computed `VersionRange` and a timestamp. + -- createTarEntry (ts, effectiveRange) = mkTarEntry (Timestamped ts (BL.pack $ prettyShow dep)) (IndexPkgPrefs pn) + -- where + -- -- Cabal uses `Dependency` to represent preferred versions, cf. + -- -- `parsePreferredVersions`. The (sub)libraries part is ignored. + -- dep = mkDependency pn effectiveRange mainLibSet foldMap generateEntriesForGroup groupedPackageVersions -- TODO: the functions belows should be moved to Foliage.PreparedPackageVersion @@ -338,8 +373,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 952cd8d..f5fed82 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,15 +128,14 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions = , allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime pkgTimestamp) , allPackageVersionsPageEntrySource = pkgVersionSource , allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated - } - -- list of revisions + } -- list of revisions : [ AllPackageVersionsPageEntryRevision { allPackageVersionsPageEntryPkgId = pkgId - , allPackageVersionsPageEntryTimestamp = revisionTimestamp - , allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp + , allPackageVersionsPageEntryTimestamp = timestamp revision + , allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds $ timestamp revision , allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated } - | (revisionTimestamp, _) <- cabalFileRevisions + | revision <- cabalFileRevisions ] ) packageVersions @@ -150,7 +150,7 @@ makePackageVersionPage outputDir PreparedPackageVersion{pkgId, pkgTimestamp, pkg 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 3925013..877633c 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,15 +18,18 @@ module Foliage.PreparePackageVersion ( ), pattern PreparedPackageVersion, preparePackageVersion, + Timestamped (..), ) where import Control.Monad (unless) +import Data.ByteString.Lazy.Char8 qualified as BL +import Data.Foldable (foldlM) import Data.List (sortOn) import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import Data.Ord (Down (..)) -import Development.Shake (Action) +import Development.Shake (Action, CmdOption (..), Stdout (..), cmd, copyFileChanged, liftIO, need) import Development.Shake.FilePath (joinPath, splitDirectories) import Distribution.Parsec (simpleParsec) import Distribution.Pretty (prettyShow) @@ -37,7 +40,10 @@ import Foliage.Meta (DeprecationSpec (..), PackageVersionSource, PackageVersionS import Foliage.PrepareSdist (prepareSdist) import Foliage.PrepareSource (prepareSource) import Foliage.Shake (readGenericPackageDescription', readPackageVersionSpec') -import System.FilePath (takeBaseName, takeFileName, (<.>), ()) +import System.FilePath (takeBaseName, takeExtension, 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 @@ -50,9 +56,12 @@ data PreparedPackageVersion = PreparedPackageVersion , pkgVersionDeprecationChanges :: [(UTCTime, Bool)] , pkgDesc :: GenericPackageDescription , sdistPath :: FilePath - , cabalFilePath :: FilePath - , originalCabalFilePath :: FilePath - , cabalFileRevisions :: [(UTCTime, FilePath)] + , -- latest cabal file + cabalFilePath :: FilePath + , -- cabal file in the sdist + originalCabalFilePath :: FilePath + , -- all cabal file revisions + cabalFileRevisions :: [Timestamped FilePath] } -- @andreabedini comments: @@ -93,65 +102,41 @@ 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) -> - 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." - ] - (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) -> - 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." - ] - (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 + readPackageVersionSpec' (inputDir metaFile) >>= \case + PackageVersionSpec{packageVersionRevisions, packageVersionTimestamp = Nothing} + | not (null packageVersionRevisions) -> do + error $ + unlines + [ 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" + ] + PackageVersionSpec{packageVersionRevisions, packageVersionTimestamp = Just pkgTs} + | any ((< pkgTs) . revisionTimestamp) packageVersionRevisions -> do + error $ + unlines + [ inputDir metaFile <> " has a revision with timestamp earlier than the package itself." + , "Adjust the timestamps so that all revisions come after the original package" + ] + 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`! + -- + -- @andreabedini commented: + -- + -- > I don't think that cabalFileRevisions :: [Timestamped FilePath] can work + -- > anymore since there's no filepath for a computed revision (unless we put + -- > it in _cache but I would avoid that). + -- > + -- > @yvan-sraka I think the correct solution is to turn cabalFileRevisions + -- > into [Timestamped ByteString] and compute the revisions as part of + let originalCabalFilePath = srcDir prettyShow pkgName <.> "cabal" cabalFileRevisionPath revisionNumber = @@ -187,13 +172,6 @@ preparePackageVersion inputDir metaFile = do , "version in cabal file: " ++ prettyShow (Distribution.Types.PackageId.pkgVersion $ package $ packageDescription pkgDesc) ] - let cabalFileRevisions = - sortOn - Down - [ (revisionTimestamp, cabalFileRevisionPath revisionNumber) - | RevisionSpec{revisionTimestamp, revisionNumber} <- packageVersionRevisions pkgSpec - ] - let pkgVersionDeprecationChanges = sortOn Down @@ -203,6 +181,23 @@ preparePackageVersion inputDir metaFile = do let pkgVersionIsDeprecated = maybe False snd $ listToMaybe pkgVersionDeprecationChanges + -- use contents rather than path + cabalFileRevisions <- + sortOn + (Down . timestamp) + <$> foldlM + ( \prevCabalFilePath (RevisionSpec{revisionTimestamp, revisionNumber}) -> do + let inputFile = cabalFileRevisionPath revisionNumber + let (Timestamped patch _) = prevCabalFilePath + if takeExtension inputFile `elem` [".diff", ".patch"] + then do + Stdout out <- cmd ["patch", "-i", inputFile, "-o", "-", prevCabalFilePath] + return $ Timestamped revisionTimestamp out + else Timestamped revisionTimestamp <$> BL.readFile inputFile + ) + originalCabalFilePath + (packageVersionRevisions pkgSpec) + return PreparedPackageVersion { pkgId @@ -217,9 +212,3 @@ preparePackageVersion inputDir metaFile = do , originalCabalFilePath , cabalFileRevisions } - -duplicates :: (Ord a) => NE.NonEmpty a -> [a] -duplicates = mapMaybe (listToMaybe . NE.tail) . NE.group - -doubleDeprecations :: NE.NonEmpty DeprecationSpec -> [NE.NonEmpty DeprecationSpec] -doubleDeprecations = filter ((> 1) . length) . NE.groupWith deprecationIsDeprecated