Skip to content

Commit

Permalink
Fix #42: use patches for revisions
Browse files Browse the repository at this point in the history
Co-authored-by: Michael Peyton Jones <[email protected]>
  • Loading branch information
yvan-sraka and michaelpj committed Apr 25, 2023
1 parent 586b692 commit 53a2471
Show file tree
Hide file tree
Showing 3 changed files with 62 additions and 46 deletions.
54 changes: 33 additions & 21 deletions app/Foliage/CmdBuild.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ import Codec.Archive.Tar.Entry qualified as Tar
import Codec.Compression.GZip qualified as GZip
import Control.Monad (unless, void, when)
import Data.Aeson qualified as Aeson
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.List (sortOn)
import Data.Maybe (fromMaybe)
Expand All @@ -23,7 +22,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)
Expand Down Expand Up @@ -101,21 +100,16 @@ buildAction

void $ forP packageVersions $ makePackageVersionPage outputDir

void $ forP packageVersions $ \PreparedPackageVersion {pkgId, cabalFilePath} -> do
let PackageIdentifier {pkgName, pkgVersion} = pkgId
copyFileChanged cabalFilePath (outputDir </> "index" </> prettyShow pkgName </> prettyShow pkgVersion </> prettyShow pkgName <.> "cabal")
void $
forP packageVersions $ \PreparedPackageVersion {pkgId, cabalFilePath} -> do
let PackageIdentifier {pkgName, pkgVersion} = pkgId
copyFileChanged cabalFilePath (outputDir </> "index" </> prettyShow pkgName </> prettyShow pkgVersion </> prettyShow pkgName <.> "cabal")

cabalEntries <-
foldMap
( \PreparedPackageVersion {pkgId, pkgTimestamp, originalCabalFilePath, cabalFileRevisions} -> do
-- 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)

return $ cf : revcf
prepareIndexPkgCabal pkgId (Timestamped cabalFileTimestamp originalCabalFilePath) (sortOn timestamp cabalFileRevisions)
)
packageVersions

Expand All @@ -129,9 +123,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 tarContents = Tar.write $ sortOn Tar.entryTime (cabalEntries ++ metadataEntries)
traced "Writing index" $ do
Expand Down Expand Up @@ -272,11 +265,30 @@ 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 withTempFile $ \inputFilePath -> do
withTempFile $ \outputFilePath -> do
liftIO $ BL.writeFile inputFilePath lastRevisionContents
cmd_ ["patch", "-i", revisionPath, "-o", outputFilePath, inputFilePath]
liftIO $ BL.readFile outputFilePath
else pure lastRevisionContents
return $ Timestamped timestamp content

prepareIndexPkgMetadata :: Maybe UTCTime -> PreparedPackageVersion -> Action Targets
prepareIndexPkgMetadata expiryTime PreparedPackageVersion {pkgId, sdistPath} = do
Expand All @@ -290,8 +302,8 @@ prepareIndexPkgMetadata expiryTime PreparedPackageVersion {pkgId, sdistPath} = d
targetsDelegations = Nothing
}

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 =
Expand Down
24 changes: 12 additions & 12 deletions app/Foliage/Pages.hs
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,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
Expand Down Expand Up @@ -83,7 +83,7 @@ makeAllPackagesPage currentTime outputDir packageVersions =
allPackagesPageEntryTimestamp = fromMaybe currentTime pkgTimestamp,
allPackagesPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime pkgTimestamp),
allPackagesPageEntrySource = pkgVersionSource,
allPackagesPageEntryLatestRevisionTimestamp = fst <$> listToMaybe cabalFileRevisions
allPackagesPageEntryLatestRevisionTimestamp = timestamp <$> listToMaybe cabalFileRevisions
}
)
)
Expand Down Expand Up @@ -123,15 +123,15 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions =
allPackageVersionsPageEntryTimestamp = fromMaybe currentTime pkgTimestamp,
allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime pkgTimestamp),
allPackageVersionsPageEntrySource = pkgVersionSource
}
-- list of revisions
: [ AllPackageVersionsPageEntryRevision
{ allPackageVersionsPageEntryPkgId = pkgId,
allPackageVersionsPageEntryTimestamp = revisionTimestamp,
allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp
}
| (revisionTimestamp, _) <- cabalFileRevisions
]
} -- list of revisions
:
[ AllPackageVersionsPageEntryRevision
{ allPackageVersionsPageEntryPkgId = pkgId,
allPackageVersionsPageEntryTimestamp = timestamp revision,
allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds $ timestamp revision
}
| revision <- cabalFileRevisions
]
)
packageVersions
-- sort them by timestamp
Expand All @@ -145,7 +145,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
]
Expand Down
30 changes: 17 additions & 13 deletions app/Foliage/PreparePackageVersion.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ module Foliage.PreparePackageVersion
),
pattern PreparedPackageVersion,
preparePackageVersion,
Timestamped (..),
)
where

Expand All @@ -34,6 +35,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)

data PreparedPackageVersion = PreparedPackageVersion
{ pkgId :: PackageId,
pkgTimestamp :: Maybe UTCTime,
Expand All @@ -43,7 +47,7 @@ data PreparedPackageVersion = PreparedPackageVersion
sdistPath :: FilePath,
cabalFilePath :: FilePath,
originalCabalFilePath :: FilePath,
cabalFileRevisions :: [(UTCTime, FilePath)]
cabalFileRevisions :: [Timestamped FilePath]
}

preparePackageVersion :: FilePath -> FilePath -> Action PreparedPackageVersion
Expand All @@ -60,18 +64,18 @@ preparePackageVersion inputDir metaFile = do
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"
]
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"
]
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

Expand Down Expand Up @@ -113,8 +117,8 @@ preparePackageVersion inputDir metaFile = do

let cabalFileRevisions =
sortOn
(Down . fst)
[ (revisionTimestamp, cabalFileRevisionPath revisionNumber)
(Down . timestamp)
[ Timestamped revisionTimestamp (cabalFileRevisionPath revisionNumber)
| RevisionSpec {revisionTimestamp, revisionNumber} <- packageVersionRevisions pkgSpec
]

Expand Down

0 comments on commit 53a2471

Please sign in to comment.