From 1d233793cc8d918db49217c62801afe12f6f76ac 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 | 48 +++++++++----- app/Foliage/Pages.hs | 27 ++++---- app/Foliage/PreparePackageVersion.hs | 93 ++++++++++++---------------- 3 files changed, 84 insertions(+), 84 deletions(-) diff --git a/app/Foliage/CmdBuild.hs b/app/Foliage/CmdBuild.hs index 42805ae..4ce2e99 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) @@ -111,12 +110,12 @@ buildAction ( \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 + cf <- prepareIndexPkgCabal pkgId (Timestamped (fromMaybe currentTime pkgTimestamp) originalCabalFilePath) [] -- FIXME !! -- all revised cabal files, with their timestamp - revcf <- for (zip [1 :: Int ..] cabalFileRevisions) $ \(revNum, (timestamp, path)) -> do + revcf <- for (zip [1 :: Int ..] cabalFileRevisions) $ \(revNum, path) -> do copyFileChanged cabalFilePath (outputDir "package" prettyShow pkgId "revision" show revNum <.> "cabal") - prepareIndexPkgCabal pkgId timestamp path + 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") @@ -124,7 +123,7 @@ buildAction -- 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 + return $ concat $ cf : revcf ) packageVersions @@ -135,9 +134,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 @@ -281,11 +279,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 @@ -322,7 +338,7 @@ getExtraEntries packageVersions = 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 + 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. @@ -353,8 +369,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 ed6867c..f87cf4c 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,42 @@ 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`! + -- + -- @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 + -- > preparePackageVersion (it's becoming a bit of a kitchen sink but shrug). + let originalCabalFilePath = srcDir prettyShow pkgName <.> "cabal" cabalFileRevisionPath revisionNumber = @@ -189,8 +170,8 @@ preparePackageVersion inputDir metaFile = do let cabalFileRevisions = sortOn - Down - [ (revisionTimestamp, cabalFileRevisionPath revisionNumber) + (Down . timestamp) + [ Timestamped revisionTimestamp (cabalFileRevisionPath revisionNumber) | RevisionSpec {revisionTimestamp, revisionNumber} <- packageVersionRevisions pkgSpec ] @@ -218,8 +199,10 @@ preparePackageVersion inputDir metaFile = do cabalFileRevisions } +-- FIXME: Defined but not used: ‘duplicates’ duplicates :: Ord a => NE.NonEmpty a -> [a] duplicates = mapMaybe (listToMaybe . NE.tail) . NE.group +-- FIXME: Defined but not used: ‘doubleDeprecations’ doubleDeprecations :: NE.NonEmpty DeprecationSpec -> [NE.NonEmpty DeprecationSpec] doubleDeprecations = filter ((> 1) . length) . NE.groupWith deprecationIsDeprecated