Update app/Foliage/CmdBuild.hs

Co-authored-by: Michael Peyton Jones <[email protected]>

app/Foliage/CmdBuild.hs

@@ -6,9 +6,8 @@ module Foliage.CmdBuild (cmdBuild) where
 import Codec.Archive.Tar qualified as Tar
 import Codec.Archive.Tar.Entry qualified as Tar
 import Codec.Compression.GZip qualified as GZip
-import Control.Monad (foldM, unless, void, when)
+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)
@@ -110,25 +109,7 @@ buildAction
         ( \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 <-
-              foldM
-                ( \(lastRevisionPath, cabalFiles) (timestamp, revisionPath) -> do
-                    if takeExtension originalCabalFilePath `elem` [".diff", ".patch"]
-                      then do
-                        patchedRevisionPath <- applyPatch lastRevisionPath revisionPath
-                        preparedCabal <- prepareIndexPkgCabal pkgId timestamp patchedRevisionPath
-                        pure (patchedRevisionPath, cabalFiles ++ [preparedCabal])
-                      else do
-                        preparedCabal <- prepareIndexPkgCabal pkgId timestamp revisionPath
-                        pure (revisionPath, cabalFiles ++ [preparedCabal])
-                )
-                (originalCabalFilePath, [])
-                (sortOn fst cabalFileRevisions)
-
-            return $ cf : snd revcf
+            prepareIndexPkgCabal pkgId cabalFileTimestamp originalCabalFilePath (sortOn fst cabalFileRevisions)
         )
         packageVersions
 
@@ -285,11 +266,28 @@ 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 -> UTCTime -> FilePath -> [(UTCTime, FilePath)] -> Action [Tar.Entry]
+prepareIndexPkgCabal pkgId timestamp originalFilePath patches = do
+  need (originalFilePath : map snd patches)
+  original <- liftIO (BL.readFile originalFilePath)
+  patchesApplied <- applyRevisionsInOrder [(timestamp, original)] patches
+  pure $ map (\(time, content) -> mkTarEntry content (IndexPkgCabal pkgId) time) patchesApplied
+
+applyRevisionsInOrder :: [(UTCTime, BL.ByteString)] -> [(UTCTime, FilePath)] -> Action [(UTCTime, BL.ByteString)]
+applyRevisionsInOrder acc [] = pure acc
+applyRevisionsInOrder acc (patch@(revisionTime, _) : remainingPatches) = do
+  newContent <- applyRevision (snd $ last acc) patch
+  applyRevisionsInOrder (acc ++ [(revisionTime, newContent)]) remainingPatches
+
+applyRevision :: BL.ByteString -> (UTCTime, FilePath) -> Action BL.ByteString
+applyRevision lastRevisionContents (_, revisionPath) = do
+  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
 
 prepareIndexPkgMetadata :: Maybe UTCTime -> PreparedPackageVersion -> Action Targets
 prepareIndexPkgMetadata expiryTime PreparedPackageVersion {pkgId, sdistPath} = do
@@ -325,9 +323,3 @@ mkTarEntry contents indexFile timestamp =
 anchorPath :: Path Absolute -> (RepoLayout -> RepoPath) -> FilePath
 anchorPath outputDirRoot p =
   toFilePath $ anchorRepoPathLocally outputDirRoot $ p hackageRepoLayout
-
-applyPatch :: FilePath -> FilePath -> Action FilePath
-applyPatch originalFilePath patchFilePath = do
-  withTempFile $ \outputFilePath -> do
-    cmd_ ["patch", "-i", patchFilePath, "-o", outputFilePath, originalFilePath]
-    return outputFilePath