Skip to content

Commit 77ab848

Browse files
yvan-srakamichaelpj
yvan-sraka
and
michaelpj
committed
Fix #42: use patches for revisions
Co-authored-by: Michael Peyton Jones <[email protected]>
1 parent 9a1eaaf commit 77ab848

File tree

3 files changed

+70
-87
lines changed

3 files changed

+70
-87
lines changed

‎app/Foliage/CmdBuild.hs

+31-19
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ import Codec.Compression.GZip qualified as GZip
1010
import Control.Monad (unless, void, when)
1111
import Data.Aeson qualified as Aeson
1212
import Data.Bifunctor (second)
13-
import Data.ByteString.Char8 qualified as BS
1413
import Data.ByteString.Lazy.Char8 qualified as BL
1514
import Data.List (sortOn)
1615
import Data.List.NonEmpty qualified as NE
@@ -28,7 +27,7 @@ import Foliage.Meta
2827
import Foliage.Meta.Aeson ()
2928
import Foliage.Options
3029
import Foliage.Pages
31-
import Foliage.PreparePackageVersion (PreparedPackageVersion (..), preparePackageVersion)
30+
import Foliage.PreparePackageVersion (PreparedPackageVersion (..), Timestamped (..), preparePackageVersion)
3231
import Foliage.PrepareSdist (addPrepareSdistRule)
3332
import Foliage.PrepareSource (addPrepareSourceRule)
3433
import Foliage.RemoteAsset (addFetchRemoteAssetRule)
@@ -113,18 +112,14 @@ buildAction
113112

114113
cabalEntries <-
115114
foldMap
116-
( \PreparedPackageVersion {pkgId, pkgTimestamp, originalCabalFilePath, cabalFileRevisions} -> do
115+
( \PreparedPackageVersion {pkgId, pkgTimestamp, originalCabalFilePath, cabalFileRevisions} ->
117116
-- original cabal file, with its timestamp (if specified)
118117
let cabalFileTimestamp = fromMaybe currentTime pkgTimestamp
119-
cf <- prepareIndexPkgCabal pkgId cabalFileTimestamp originalCabalFilePath
120-
121-
-- all revised cabal files, with their timestamp
122-
revcf <- for cabalFileRevisions $ uncurry (prepareIndexPkgCabal pkgId)
123-
124118
-- WARN: So far Foliage allows publishing a package and a cabal file revision with the same timestamp
125119
-- This accidentally works because 1) the following inserts the original cabal file before the revisions
126120
-- AND 2) Data.List.sortOn is stable. The revised cabal file will always be after the original one.
127-
return $ cf : revcf
121+
in -- all revised cabal files, with their timestamp
122+
prepareIndexPkgCabal pkgId (Timestamped cabalFileTimestamp originalCabalFilePath) (sortOn timestamp cabalFileRevisions)
128123
)
129124
packageVersions
130125

@@ -138,9 +133,8 @@ buildAction
138133
liftIO $ BL.writeFile path $ renderSignedJSON targetKeys targets
139134
pure $
140135
mkTarEntry
141-
(renderSignedJSON targetKeys targets)
136+
(Timestamped (fromMaybe currentTime pkgTimestamp) (renderSignedJSON targetKeys targets))
142137
(IndexPkgMetadata pkgId)
143-
(fromMaybe currentTime pkgTimestamp)
144138

145139
let extraEntries = getExtraEntries packageVersions
146140

@@ -284,11 +278,29 @@ getPackageVersions inputDir = do
284278

285279
forP metaFiles $ preparePackageVersion inputDir
286280

287-
prepareIndexPkgCabal :: PackageId -> UTCTime -> FilePath -> Action Tar.Entry
288-
prepareIndexPkgCabal pkgId timestamp filePath = do
289-
need [filePath]
290-
contents <- liftIO $ BS.readFile filePath
291-
pure $ mkTarEntry (BL.fromStrict contents) (IndexPkgCabal pkgId) timestamp
281+
prepareIndexPkgCabal :: PackageId -> Timestamped FilePath -> [Timestamped FilePath] -> Action [Tar.Entry]
282+
prepareIndexPkgCabal pkgId (Timestamped timestamp originalFilePath) revisions = do
283+
need (originalFilePath : map timestampedValue revisions)
284+
original <- liftIO (BL.readFile originalFilePath)
285+
revisionsApplied <- applyRevisionsInOrder [Timestamped timestamp original] revisions
286+
pure $ map (\content -> mkTarEntry content (IndexPkgCabal pkgId)) revisionsApplied
287+
288+
applyRevisionsInOrder :: [Timestamped BL.ByteString] -> [Timestamped FilePath] -> Action [Timestamped BL.ByteString]
289+
applyRevisionsInOrder acc [] = pure (reverse acc)
290+
applyRevisionsInOrder acc (patch : remainingPatches) = do
291+
newContent <- applyRevision (timestampedValue $ last acc) patch
292+
applyRevisionsInOrder (newContent : acc) remainingPatches
293+
294+
applyRevision :: BL.ByteString -> Timestamped FilePath -> Action (Timestamped BL.ByteString)
295+
applyRevision lastRevisionContents (Timestamped timestamp revisionPath) = do
296+
content <-
297+
if takeExtension revisionPath `elem` [".diff", ".patch"]
298+
then do
299+
liftIO $ putStrLn $ "Applying patch " ++ revisionPath
300+
cmd_ (StdinBS lastRevisionContents) ["patch", "-i", revisionPath]
301+
liftIO $ BL.readFile revisionPath
302+
else pure lastRevisionContents
303+
return $ Timestamped timestamp content
292304

293305
prepareIndexPkgMetadata :: Maybe UTCTime -> PreparedPackageVersion -> Action Targets
294306
prepareIndexPkgMetadata expiryTime PreparedPackageVersion {pkgId, sdistPath} = do
@@ -324,7 +336,7 @@ getExtraEntries packageVersions =
324336
effectiveRanges :: [(UTCTime, VersionRange)]
325337
effectiveRanges = NE.tail $ NE.scanl applyChangeToRange (posixSecondsToUTCTime 0, anyVersion) deprecationChanges
326338
-- Create a `Tar.Entry` for the package group, its computed `VersionRange` and a timestamp.
327-
createTarEntry (ts, effectiveRange) = mkTarEntry (BL.pack $ prettyShow effectiveRange) (IndexPkgPrefs pn) ts
339+
createTarEntry (ts, effectiveRange) = mkTarEntry (Timestamped ts (BL.pack $ prettyShow effectiveRange)) (IndexPkgPrefs pn)
328340
in foldMap generateEntriesForGroup groupedPackageVersions
329341

330342
-- TODO: the functions belows should be moved to Foliage.PreparedPackageVersion
@@ -351,8 +363,8 @@ applyDeprecation pkgVersion deprecated =
351363
then intersectVersionRanges (notThisVersion pkgVersion)
352364
else unionVersionRanges (thisVersion pkgVersion)
353365

354-
mkTarEntry :: BL.ByteString -> IndexFile dec -> UTCTime -> Tar.Entry
355-
mkTarEntry contents indexFile timestamp =
366+
mkTarEntry :: Timestamped BL.ByteString -> IndexFile dec -> Tar.Entry
367+
mkTarEntry (Timestamped timestamp contents) indexFile =
356368
(Tar.fileEntry tarPath contents)
357369
{ Tar.entryTime = floor $ Time.utcTimeToPOSIXSeconds timestamp,
358370
Tar.entryOwnership =

‎app/Foliage/Pages.hs

+14-13
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE DeriveGeneric #-}
22
{-# LANGUAGE DerivingVia #-}
3+
{-# LANGUAGE ImportQualifiedPost #-}
34
{-# LANGUAGE OverloadedStrings #-}
45
{-# LANGUAGE TemplateHaskell #-}
56

@@ -29,7 +30,7 @@ import Distribution.Package (PackageIdentifier (pkgName, pkgVersion))
2930
import Distribution.Pretty (prettyShow)
3031
import Foliage.Meta (PackageVersionSource)
3132
import Foliage.Meta.Aeson ()
32-
import Foliage.PreparePackageVersion (PreparedPackageVersion (..))
33+
import Foliage.PreparePackageVersion (PreparedPackageVersion (..), Timestamped (..))
3334
import Foliage.Utils.Aeson (MyAesonEncoding (..))
3435
import GHC.Generics (Generic)
3536
import System.Directory qualified as IO
@@ -83,7 +84,7 @@ makeAllPackagesPage currentTime outputDir packageVersions =
8384
allPackagesPageEntryTimestamp = fromMaybe currentTime pkgTimestamp,
8485
allPackagesPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime pkgTimestamp),
8586
allPackagesPageEntrySource = pkgVersionSource,
86-
allPackagesPageEntryLatestRevisionTimestamp = fst <$> listToMaybe cabalFileRevisions
87+
allPackagesPageEntryLatestRevisionTimestamp = timestamp <$> listToMaybe cabalFileRevisions
8788
}
8889
)
8990
)
@@ -127,16 +128,16 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions =
127128
allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime pkgTimestamp),
128129
allPackageVersionsPageEntrySource = pkgVersionSource,
129130
allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated
130-
}
131-
-- list of revisions
132-
: [ AllPackageVersionsPageEntryRevision
133-
{ allPackageVersionsPageEntryPkgId = pkgId,
134-
allPackageVersionsPageEntryTimestamp = revisionTimestamp,
135-
allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp,
136-
allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated
137-
}
138-
| (revisionTimestamp, _) <- cabalFileRevisions
139-
]
131+
} -- list of revisions
132+
:
133+
[ AllPackageVersionsPageEntryRevision
134+
{ allPackageVersionsPageEntryPkgId = pkgId,
135+
allPackageVersionsPageEntryTimestamp = timestamp revision,
136+
allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds $ timestamp revision,
137+
allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated
138+
}
139+
| revision <- cabalFileRevisions
140+
]
140141
)
141142
packageVersions
142143
-- sort them by timestamp
@@ -150,7 +151,7 @@ makePackageVersionPage outputDir PreparedPackageVersion {pkgId, pkgTimestamp, pk
150151
renderMustache packageVersionPageTemplate $
151152
object
152153
[ "pkgVersionSource" .= pkgVersionSource,
153-
"cabalFileRevisions" .= map fst cabalFileRevisions,
154+
"cabalFileRevisions" .= map timestamp cabalFileRevisions,
154155
"pkgDesc" .= jsonGenericPackageDescription pkgDesc,
155156
"pkgTimestamp" .= pkgTimestamp,
156157
"pkgVersionDeprecated" .= pkgVersionIsDeprecated

‎app/Foliage/PreparePackageVersion.hs

+25-55
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
1+
{-# LANGUAGE ImportQualifiedPost #-}
2+
{-# LANGUAGE LambdaCase #-}
13
{-# LANGUAGE PatternSynonyms #-}
2-
{-# LANGUAGE RecordWildCards #-}
3-
{-# LANGUAGE ViewPatterns #-}
44

55
module Foliage.PreparePackageVersion
66
( PreparedPackageVersion
@@ -18,6 +18,7 @@ module Foliage.PreparePackageVersion
1818
),
1919
pattern PreparedPackageVersion,
2020
preparePackageVersion,
21+
Timestamped (..),
2122
)
2223
where
2324

@@ -39,6 +40,9 @@ import Foliage.PrepareSource (prepareSource)
3940
import Foliage.Shake (readGenericPackageDescription', readPackageVersionSpec')
4041
import System.FilePath (takeBaseName, takeFileName, (<.>), (</>))
4142

43+
data Timestamped a = Timestamped {timestamp :: UTCTime, timestampedValue :: a}
44+
deriving (Eq, Ord, Show)
45+
4246
-- TODO: can we ensure that `pkgVersionDeprecationChanges` and `cabalFileRevisions` are
4347
-- sorted by timestamp? e.g https://hackage.haskell.org/package/sorted-list
4448
data PreparedPackageVersion = PreparedPackageVersion
@@ -52,7 +56,7 @@ data PreparedPackageVersion = PreparedPackageVersion
5256
sdistPath :: FilePath,
5357
cabalFilePath :: FilePath,
5458
originalCabalFilePath :: FilePath,
55-
cabalFileRevisions :: [(UTCTime, FilePath)]
59+
cabalFileRevisions :: [Timestamped FilePath]
5660
}
5761

5862
-- @andreabedini comments:
@@ -93,65 +97,31 @@ preparePackageVersion inputDir metaFile = do
9397
let pkgId = PackageIdentifier pkgName pkgVersion
9498

9599
pkgSpec <-
96-
readPackageVersionSpec' (inputDir </> metaFile) >>= \meta@PackageVersionSpec {..} -> do
97-
case (NE.nonEmpty packageVersionRevisions, packageVersionTimestamp) of
98-
(Just _someRevisions, Nothing) ->
100+
readPackageVersionSpec' (inputDir </> metaFile) >>= \case
101+
PackageVersionSpec {packageVersionRevisions, packageVersionTimestamp = Nothing}
102+
| not (null packageVersionRevisions) -> do
99103
error $
100104
unlines
101-
[ inputDir </> metaFile <> " has cabal file revisions but the package has no timestamp.",
102-
"This combination doesn't make sense. Either add a timestamp on the original package or remove the revisions."
105+
[ inputDir </> metaFile <> " has cabal file revisions but the original package has no timestamp.",
106+
"This combination doesn't make sense. Either add a timestamp on the original package or remove the revisions"
103107
]
104-
(Just (NE.sort -> someRevisions), Just ts)
105-
-- WARN: this should really be a <=
106-
| revisionTimestamp (NE.head someRevisions) < ts ->
107-
error $
108-
unlines
109-
[ inputDir </> metaFile <> " has a revision with timestamp earlier than the package itself.",
110-
"Adjust the timestamps so that all revisions come after the package publication."
111-
]
112-
| not (null $ duplicates (revisionTimestamp <$> someRevisions)) ->
113-
error $
114-
unlines
115-
[ inputDir </> metaFile <> " has two revisions entries with the same timestamp.",
116-
"Adjust the timestamps so that all the revisions happen at a different time."
117-
]
118-
_otherwise -> return ()
119-
120-
case (NE.nonEmpty packageVersionDeprecations, packageVersionTimestamp) of
121-
(Just _someDeprecations, Nothing) ->
108+
PackageVersionSpec {packageVersionRevisions, packageVersionTimestamp = Just pkgTs}
109+
| any ((< pkgTs) . revisionTimestamp) packageVersionRevisions -> do
122110
error $
123111
unlines
124-
[ inputDir </> metaFile <> " has deprecations but the package has no timestamp.",
125-
"This combination doesn't make sense. Either add a timestamp on the original package or remove the deprecation."
112+
[ inputDir </> metaFile <> " has a revision with timestamp earlier than the package itself.",
113+
"Adjust the timestamps so that all revisions come after the original package"
126114
]
127-
(Just (NE.sort -> someDeprecations), Just ts)
128-
| deprecationTimestamp (NE.head someDeprecations) <= ts ->
129-
error $
130-
unlines
131-
[ inputDir </> metaFile <> " has a deprecation entry with timestamp earlier (or equal) than the package itself.",
132-
"Adjust the timestamps so that all the (un-)deprecations come after the package publication."
133-
]
134-
| not (deprecationIsDeprecated (NE.head someDeprecations)) ->
135-
error $
136-
"The first deprecation entry in" <> inputDir </> metaFile <> " cannot be an un-deprecation"
137-
| not (null $ duplicates (deprecationTimestamp <$> someDeprecations)) ->
138-
error $
139-
unlines
140-
[ inputDir </> metaFile <> " has two deprecation entries with the same timestamp.",
141-
"Adjust the timestamps so that all the (un-)deprecations happen at a different time."
142-
]
143-
| not (null $ doubleDeprecations someDeprecations) ->
144-
error $
145-
unlines
146-
[ inputDir </> metaFile <> " contains two consecutive deprecations or two consecutive un-deprecations.",
147-
"Make sure deprecations and un-deprecations alternate in time."
148-
]
149-
_otherwise -> return ()
150-
151-
return meta
115+
meta ->
116+
return meta
152117

153118
srcDir <- prepareSource pkgId pkgSpec
154119

120+
-- FIXME: This produce a Shake error since it `need` the file:
121+
--
122+
-- revisionNumber <.> "cabal"
123+
--
124+
-- ... which could now be a `.diff` or a `.patch`!
155125
let originalCabalFilePath = srcDir </> prettyShow pkgName <.> "cabal"
156126

157127
cabalFileRevisionPath revisionNumber =
@@ -189,8 +159,8 @@ preparePackageVersion inputDir metaFile = do
189159

190160
let cabalFileRevisions =
191161
sortOn
192-
Down
193-
[ (revisionTimestamp, cabalFileRevisionPath revisionNumber)
162+
(Down . timestamp)
163+
[ Timestamped revisionTimestamp (cabalFileRevisionPath revisionNumber)
194164
| RevisionSpec {revisionTimestamp, revisionNumber} <- packageVersionRevisions pkgSpec
195165
]
196166

0 commit comments

Comments
 (0)