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 Sep 19, 2023
1 parent cbd0c5d commit d56b79b
Show file tree
Hide file tree
Showing 3 changed files with 142 additions and 118 deletions.
103 changes: 69 additions & 34 deletions app/Foliage/CmdBuild.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand All @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 =
Expand Down
16 changes: 8 additions & 8 deletions app/Foliage/Pages.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
}
)
)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
Loading

0 comments on commit d56b79b

Please sign in to comment.