I have no idea what I am doing

app/Foliage/CmdBuild.hs

@@ -25,6 +25,7 @@ import Development.Shake (
   action,
   addOracleCache,
   addShakeExtra,
+  askOracle,
   filePattern,
   forP,
   getDirectoryFiles,
@@ -56,6 +57,8 @@ import Distribution.Parsec (simpleParsec)
 import Distribution.Pretty (prettyShow)
 import Hackage.Security.Server (FileExpires (..))
 
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as M
 import Distribution.Types.Orphans ()
 import Foliage.FetchURL (addFetchURLRule)
 import Foliage.HackageSecurity (createKeys)
@@ -65,6 +68,7 @@ import Foliage.Options
 import Foliage.Rules.Core
 import Foliage.Rules.HackageExtra
 import Foliage.Rules.Pages
+import Foliage.Rules.Utils (PkgSpecs (..))
 import Foliage.SourceDist
 import Foliage.Time
 
@@ -189,32 +193,31 @@ cmdBuild buildOptions = do
     -- Index creation
     --
 
-    getPkgSpecs <- do
-      getPkgSpecs' <- addOracleCache $ \PkgSpecs{} -> do
-        metaFiles <- getDirectoryFiles inputDir ["*/*/meta.toml"]
-        when (null metaFiles) $ do
-          error $
-            unlines
-              [ "We could not find any package metadata file (i.e. _sources/<name>/<version>/meta.toml)"
-              , "Make sure you are passing the right input directory. The default input directory is _sources"
-              ]
+    getPkgSpecs <- addOracleCache $ \PkgSpecs -> do
+      metaFiles <- getDirectoryFiles inputDir ["*/*/meta.toml"]
+      when (null metaFiles) $ do
+        error $
+          unlines
+            [ "We could not find any package metadata file (i.e. _sources/<name>/<version>/meta.toml)"
+            , "Make sure you are passing the right input directory. The default input directory is _sources"
+            ]
 
-        forP metaFiles $ \path ->
-          case filePattern "*/*/meta.toml" path of
-            Just [name, version] -> do
-              let pkgName = fromMaybe (error $ "invalid package name: " ++ name) $ simpleParsec name
-              let pkgVersion = fromMaybe (error $ "invalid package version: " ++ version) $ simpleParsec version
-              let pkgId = PackageIdentifier pkgName pkgVersion
-              pkgSpec <- packageVersionSpec (inputDir </> path)
-              return (inputDir </> path, pkgId, pkgSpec)
-            _ -> error "the impossible happened"
+      entries <- forP metaFiles $ \path ->
+        case filePattern "*/*/meta.toml" path of
+          Just [name, version] -> do
+            let pkgName = fromMaybe (error $ "invalid package name: " ++ name) $ simpleParsec name
+            let pkgVersion = fromMaybe (error $ "invalid package version: " ++ version) $ simpleParsec version
+            let pkgId = PackageIdentifier pkgName pkgVersion
+            pkgSpec <- packageVersionSpec (inputDir </> path)
+            return (pkgId, (inputDir </> path, pkgSpec))
+          _ -> error "the impossible happened"
 
-      return $ getPkgSpecs' $ PkgSpecs ()
+      return $ M.fromList entries
 
     --
     -- Rules for core repository functionality
     --
-    coreRules outputDir cabalFileForPkgId sdistPathForPkgId currentTime getPkgSpecs
+    coreRules outputDir cabalFileForPkgId sdistPathForPkgId currentTime
 
     --
     -- Rules for Hackage-like paths, e.g.
@@ -222,7 +225,7 @@ cmdBuild buildOptions = do
     -- package/pkg-id/revision/rev-num.cabal
     -- package/pkg-id/pkg-name.cabal
 
-    hackageExtraRules outputDir cabalFileForPkgId cabalFileRevisionForPkgId getPkgSpecs
+    hackageExtraRules outputDir cabalFileForPkgId cabalFileRevisionForPkgId pkgSpecForPkgId
 
     --
     -- Foliage metadata
@@ -233,7 +236,7 @@ cmdBuild buildOptions = do
         need [outputDir </> "foliage/packages.json"]
 
     outputDir </> "foliage/packages.json" %> \path ->
-      getPkgSpecs >>= \pkgSpecs ->
+      askOracle PkgSpecs >>= \pkgSpecs ->
         liftIO $
           Aeson.encodeFile
             path
@@ -244,14 +247,14 @@ cmdBuild buildOptions = do
               ]
                 ++ ["forced-version" Aeson..= True | packageVersionForce pkgSpec]
                 ++ (case packageVersionTimestamp pkgSpec of Nothing -> []; Just t -> ["timestamp" Aeson..= t])
-            | (_, pkgId, pkgSpec) <- pkgSpecs
+            | (pkgId, (_, pkgSpec)) <- M.toList pkgSpecs
             ]
 
     --
     -- Website pages
     --
 
-    websitePagesRules outputDir currentTime getPkgSpecs pkgSpecForPkgId cabalFileForPkgId
+    websitePagesRules outputDir currentTime pkgSpecForPkgId cabalFileForPkgId getPkgSpecs
 
 validateMeta :: (MonadFail m) => FilePath -> PackageVersionSpec -> m ()
 validateMeta metaFile PackageVersionSpec{..} = do
@@ -316,6 +319,3 @@ validateMeta metaFile PackageVersionSpec{..} = do
 
   doubleDeprecations :: NE.NonEmpty DeprecationSpec -> [NE.NonEmpty DeprecationSpec]
   doubleDeprecations = filter ((> 1) . length) . NE.groupWith deprecationIsDeprecated
-
-newtype PkgSpecs = PkgSpecs () deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
-type instance RuleResult PkgSpecs = [(FilePath, PackageId, PackageVersionSpec)]

app/Foliage/Meta.hs

@@ -201,13 +201,13 @@ deprecationMetaCodec =
 timeCodec :: Toml.Key -> TomlCodec UTCTime
 timeCodec key = Toml.dimap (utcToZonedTime utc) zonedTimeToUTC $ Toml.zonedTime key
 
+withDefault :: (Eq a) => a -> TomlCodec a -> TomlCodec a
+withDefault d c = (fromMaybe d <$> Toml.dioptional c) .= f
+ where
+  f a = if a == d then Nothing else Just a
+
 latestRevisionNumber :: PackageVersionSpec -> Maybe Int
 latestRevisionNumber sm =
   case sortOn (Down . revisionNumber) (packageVersionRevisions sm) of
     [] -> Nothing
     rev : _ -> Just (revisionNumber rev)
-
-withDefault :: (Eq a) => a -> TomlCodec a -> TomlCodec a
-withDefault d c = (fromMaybe d <$> Toml.dioptional c) .= f
- where
-  f a = if a == d then Nothing else Just a

app/Foliage/Rules/Core.hs

@@ -15,6 +15,8 @@ import Codec.Compression.GZip qualified as GZip
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BSL
 import Data.ByteString.Lazy.Char8 qualified as C8L
+import Data.Map (Map)
+import Data.Map.Strict qualified as M
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
 import Data.Traversable (for)
 import Development.Shake
@@ -25,7 +27,6 @@ import Distribution.Parsec (simpleParsec)
 import Distribution.Pretty (prettyShow)
 import Distribution.Simple
 import Distribution.Simple.PackageDescription (readGenericPackageDescription)
-import Distribution.Utils.Generic (sndOf3)
 import Distribution.Verbosity qualified as Verbosity
 import Hackage.Security.Key.Env (fromKeys)
 import Hackage.Security.Server (
@@ -52,15 +53,15 @@ import Hackage.Security.Util.Path qualified as Sec
 
 import Foliage.HackageSecurity
 import Foliage.Meta
+import Foliage.Rules.Utils
 
 coreRules
   :: FilePath
   -> (PackageIdentifier -> FilePath)
   -> (PackageId -> FilePath)
   -> UTCTime
-  -> Action [(FilePath, PackageId, PackageVersionSpec)]
   -> Rules ()
-coreRules outputDir cabalFileForPkgId sdistPathForPkgId currentTime getPkgSpecs = do
+coreRules outputDir cabalFileForPkgId sdistPathForPkgId currentTime = do
   action $ do
     -- This is all that is necessary since the single source distributions
     -- are required to build 01-index.tar.
@@ -75,7 +76,7 @@ coreRules outputDir cabalFileForPkgId sdistPathForPkgId currentTime getPkgSpecs
 
   getIndexEntries <- do
     getIndexEntries <- newCache $ \IndexEntries{} -> do
-      pkgSpecs <- getPkgSpecs
+      pkgSpecs <- askOracle PkgSpecs
       cabalEntries <- makeCabalEntries currentTime cabalFileForPkgId pkgSpecs
       metadataEntries <- makeMetadataEntries currentTime sdistPathForPkgId pkgSpecs
       let extraEntries = makeExtraEntries pkgSpecs
@@ -108,9 +109,9 @@ coreRules outputDir cabalFileForPkgId sdistPathForPkgId currentTime getPkgSpecs
         liftIO $ packageDirToSdist Verbosity.normal pkgDesc (takeDirectory cabalFilePath) >>= BSL.writeFile path
       _ -> error $ "The path " ++ path ++ " does not correspond to a valid package"
 
-makeCabalEntries :: UTCTime -> (PackageId -> FilePath) -> [(FilePath, PackageId, PackageVersionSpec)] -> Action [Tar.Entry]
+makeCabalEntries :: UTCTime -> (PackageId -> FilePath) -> Map PackageId (FilePath, PackageVersionSpec) -> Action [Tar.Entry]
 makeCabalEntries currentTime cabalFileForPkgId allPkgSpecs = do
-  fmap concat $ forP allPkgSpecs $ \(metaFile, pkgId, pkgSpec) -> do
+  flip M.foldMapWithKey allPkgSpecs $ \pkgId (metaFile, pkgSpec) -> do
     let pkgCabalFile = cabalFileForPkgId pkgId
         pkgTimestamp = fromMaybe currentTime (packageVersionTimestamp pkgSpec)
 
@@ -125,69 +126,66 @@ makeCabalEntries currentTime cabalFileForPkgId allPkgSpecs = do
     -- AND 2) Data.List.sortOn is stable. The revised cabal file will always be after the original one.
     return $ uploadEntry : revisionEntries
 
-makeMetadataEntries :: UTCTime -> (PackageId -> FilePath) -> [(FilePath, PackageId, PackageVersionSpec)] -> Action [Tar.Entry]
+makeMetadataEntries :: UTCTime -> (PackageId -> FilePath) -> Map PackageId (FilePath, PackageVersionSpec) -> Action [Tar.Entry]
 makeMetadataEntries currentTime sdistPathForPkgId allPkgSpecs = do
   Just expiryTime <- getShakeExtra
 
   targetKeys <- readKeys "target"
 
-  forP allPkgSpecs $ \(_metaFile, pkgId, pkgSpec) -> do
+  flip M.foldMapWithKey allPkgSpecs $ \pkgId (_metaFile, pkgSpec) -> do
     let sdistPath = sdistPathForPkgId pkgId
         pkgTimestamp = fromMaybe currentTime (packageVersionTimestamp pkgSpec)
     targets <- makeIndexPkgMetadata expiryTime pkgId sdistPath
-    return $ mkTarEntry (renderSignedJSON targetKeys targets) (IndexPkgMetadata pkgId) pkgTimestamp
+    return [mkTarEntry (renderSignedJSON targetKeys targets) (IndexPkgMetadata pkgId) pkgTimestamp]
 
 -- Currently `extraEntries` are only used for encoding `prefered-versions`.
-makeExtraEntries :: [(FilePath, PackageId, PackageVersionSpec)] -> [Tar.Entry]
-makeExtraEntries allPkgSpecs =
-  let
-    -- Group all (package) versions by package (name)
-    groupedPackageVersions :: [NE.NonEmpty (FilePath, PackageId, PackageVersionSpec)]
-    groupedPackageVersions = NE.groupWith sndOf3 allPkgSpecs
+makeExtraEntries :: Map PackageId (FilePath, PackageVersionSpec) -> [Tar.Entry]
+makeExtraEntries = M.foldMapWithKey generateEntriesForGroup . groupByPackageName
 
-    -- All versions of a given package together form a list of entries
-    -- The list of entries might be empty (in case no version has been deprecated)
-    generateEntriesForGroup :: NE.NonEmpty (FilePath, PackageId, PackageVersionSpec) -> [Tar.Entry]
-    generateEntriesForGroup packageGroup = map createTarEntry effectiveRanges
-     where
-      -- Get the package name of the current group.
-      pn :: PackageName
-      pn = packageName $ sndOf3 $ NE.head packageGroup
-      -- Collect and sort the deprecation changes for the package group, turning them into a action on VersionRange
-      deprecationChanges :: [(UTCTime, VersionRange -> VersionRange)]
-      deprecationChanges =
-        packageGroup
-          & foldMap
-            ( \(_metaFile, pkgId, pkgSpec) ->
-                [ (deprecationTimestamp, rangeAct)
-                | DeprecationSpec{deprecationTimestamp, deprecationIsDeprecated} <- packageVersionDeprecations pkgSpec
-                , let rangeAct =
-                        if deprecationIsDeprecated
-                          then intersectVersionRanges (notThisVersion (pkgVersion pkgId))
-                          else unionVersionRanges (thisVersion (pkgVersion pkgId))
-                ]
-            )
+-- All versions of a given package together form a list of entries
+-- The list of entries might be empty (in case no version has been deprecated)
+generateEntriesForGroup :: PackageName -> NE.NonEmpty (Version, PackageVersionSpec) -> [Tar.Entry]
+generateEntriesForGroup pkgName packageGroup =
+  map createTarEntry effectiveRanges
+ where
+  -- Collect and sort the deprecation changes for the package group, turning them into a action on VersionRange
+  deprecationChanges :: [(UTCTime, VersionRange -> VersionRange)]
+  deprecationChanges =
+    packageGroup
+      & foldMap
+        ( \(pkgVersion, pkgSpec) ->
+            [ (deprecationTimestamp, rangeAct)
+            | DeprecationSpec{deprecationTimestamp, deprecationIsDeprecated} <- packageVersionDeprecations pkgSpec
+            , let rangeAct =
+                    if deprecationIsDeprecated
+                      then intersectVersionRanges (notThisVersion pkgVersion)
+                      else unionVersionRanges (thisVersion pkgVersion)
+            ]
+        )
 
-      -- Calculate (by applying them chronologically) the effective `VersionRange` for the package group.
-      effectiveRanges :: [(UTCTime, VersionRange)]
-      effectiveRanges = NE.tail $ NE.scanl applyChangeToRange (posixSecondsToUTCTime 0, anyVersion) (sortOn fst deprecationChanges)
+  -- Calculate (by applying them chronologically) the effective `VersionRange` for the package group.
+  effectiveRanges :: [(UTCTime, VersionRange)]
+  effectiveRanges =
+    NE.tail $
+      NE.scanl
+        applyChangeToRange
+        (posixSecondsToUTCTime 0, anyVersion)
+        (sortOn fst deprecationChanges)
 
-      -- Apply a given change (`VersionRange -> VersionRange`) to a `VersionRange` and
-      -- return the simplified the result with a new timestamp.
-      applyChangeToRange
-        :: (UTCTime, VersionRange)
-        -> (UTCTime, VersionRange -> VersionRange)
-        -> (UTCTime, VersionRange)
-      applyChangeToRange (_, range) (ts, change) = (ts, simplifyVersionRange $ change range)
+  -- Apply a given change (`VersionRange -> VersionRange`) to a `VersionRange` and
+  -- return the simplified the result with a new timestamp.
+  applyChangeToRange
+    :: (UTCTime, VersionRange)
+    -> (UTCTime, VersionRange -> VersionRange)
+    -> (UTCTime, VersionRange)
+  applyChangeToRange (_, range) (ts, change) = (ts, simplifyVersionRange $ change range)
 
-      -- Create a `Tar.Entry` for the package group, its computed `VersionRange` and a timestamp.
-      createTarEntry (ts, effectiveRange) = mkTarEntry (C8L.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
-    foldMap generateEntriesForGroup groupedPackageVersions
+  -- Create a `Tar.Entry` for the package group, its computed `VersionRange` and a timestamp.
+  createTarEntry (ts, effectiveRange) = mkTarEntry (C8L.pack $ prettyShow dep) (IndexPkgPrefs pkgName) ts
+   where
+    -- Cabal uses `Dependency` to represent preferred versions, cf.
+    -- `parsePreferredVersions`. The (sub)libraries part is ignored.
+    dep = mkDependency pkgName effectiveRange mainLibSet
 
 makeIndexPkgCabal :: PackageId -> UTCTime -> FilePath -> Action Tar.Entry
 makeIndexPkgCabal pkgId timestamp filePath = do

app/Foliage/Rules/HackageExtra.hs

@@ -2,27 +2,25 @@ module Foliage.Rules.HackageExtra (
   hackageExtraRules,
 ) where
 
-import Development.Shake (Action, Rules, action, copyFileChanged, filePattern, need, (%>))
+import Text.Read (readMaybe)
+
+import Data.Map.Strict qualified as M
+import Development.Shake (Action, Rules, action, askOracle, copyFileChanged, filePattern, need, (%>))
 import Development.Shake.FilePath
 import Distribution.Parsec (simpleParsec)
 import Distribution.Pretty (prettyShow)
 import Distribution.Simple (PackageIdentifier (..), unPackageName)
-import Foliage.Meta (PackageVersionSpec (packageVersionRevisions), RevisionSpec (RevisionSpec, revisionNumber), latestRevisionNumber)
-import Text.Read (readMaybe)
 
-hackageExtraRules
-  :: FilePath
-  -> (PackageIdentifier -> FilePath)
-  -> (PackageIdentifier -> Int -> FilePath)
-  -> (PackageIdentifier -> Action PackageVersionSpec)
-  -> Action [(FilePath, PackageIdentifier, PackageVersionSpec)]
-  -> Rules ()
-hackageExtraRules outputDir cabalFileForPkgId cabalFileRevisionForPkgId pkgSpecForPkgId getPkgSpecs = do
-  action $ do
-    getPkgSpecs
+import Foliage.Meta (PackageVersionSpec (..), RevisionSpec (..), latestRevisionNumber)
+import Foliage.Rules.Utils
+
+hackageExtraRules :: FilePath -> Rules ()
+hackageExtraRules outputDir = do
+  action $
+    askOracle PkgSpecs
       >>= need
-        . concatMap
-          ( \(_, pkgId@PackageIdentifier{pkgName}, pkgSpec) ->
+        . M.foldMapWithKey
+          ( \pkgId@PackageIdentifier{pkgName} (_, pkgSpec) ->
               let baseDir = outputDir </> "package" </> prettyShow pkgId
                in (baseDir </> unPackageName pkgName <.> "cabal")
                     : (baseDir </> "revision" </> "0.cabal")

app/Foliage/Rules/Pages.hs

@@ -7,17 +7,16 @@ module Foliage.Rules.Pages (
   websitePagesRules,
 ) where
 
-import Data.Foldable1 (minimumBy)
-import Data.Function (on, (&))
+import Data.Foldable1 qualified as F1
 import Data.List (sortOn)
-import Data.List.NonEmpty qualified as NE
 import Data.Maybe (fromMaybe, listToMaybe)
 import Data.Ord (Down (Down), comparing)
 import GHC.Generics (Generic)
 
 import Data.Aeson (KeyValue ((.=)), ToJSON, object)
+import Data.Map qualified as M
+import Data.Map.Strict (Map)
 import Data.Text.Lazy.IO.Utf8 qualified as TL
-import Data.Time (UTCTime)
 import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
 import Development.Shake
 import Development.Shake.FilePath
@@ -27,54 +26,47 @@ import Distribution.Parsec (simpleParsec)
 import Distribution.Pretty (prettyShow)
 import Distribution.Simple (PackageId, PackageIdentifier (..))
 import Distribution.Simple.PackageDescription (readGenericPackageDescription)
-import Distribution.Utils.Generic (sndOf3)
 import Distribution.Verbosity qualified as Verbosity
 import Text.Mustache (Template)
 import Text.Mustache.Compile.TH (compileMustacheDir)
 import Text.Mustache.Render (renderMustache)
 
-import Foliage.Meta (
-  PackageVersionSource,
-  PackageVersionSpec (..),
-  RevisionSpec (..),
-  packageVersionIsDeprecated,
- )
+import Foliage.Meta
 import Foliage.Meta.Aeson ()
-import Foliage.Utils.Aeson (MyAesonEncoding (..))
+import Foliage.Rules.Utils
+import Foliage.Utils.Aeson
 
 websitePagesRules
   :: FilePath
   -> UTCTime
-  -> Action [(FilePath, PackageId, PackageVersionSpec)]
-  -> (PackageId -> Action PackageVersionSpec)
   -> (PackageId -> FilePath)
   -> Rules ()
-websitePagesRules outputDir currentTime getPkgSpecs pkgSpecForPkgId cabalFileForPkgId = do
+websitePagesRules outputDir currentTime cabalFileForPkgId = do
   action $ do
     need
       [ outputDir </> "index.html"
       , outputDir </> "all-packages/index.html"
       , outputDir </> "all-package-versions/index.html"
       ]
-    getPkgSpecs >>= \pkgSpecs ->
+    askOracle PkgSpecs >>= \pkgSpecs ->
       need
         [ outputDir </> "package" </> prettyShow pkgId </> "index.html"
-        | (_, pkgId, _) <- pkgSpecs
+        | pkgId <- M.keys pkgSpecs
         ]
 
   outputDir </> "index.html"
     %> makeIndexPage
 
   outputDir </> "all-packages/index.html" %> \path ->
-    getPkgSpecs >>= makeAllPackagesPage currentTime path
+    askOracle PkgSpecs >>= makeAllPackagesPage currentTime path
 
   outputDir </> "all-package-versions/index.html" %> \path ->
-    getPkgSpecs >>= makeAllPackageVersionsPage currentTime path
+    askOracle PkgSpecs >>= makeAllPackageVersionsPage currentTime path
 
   outputDir </> "package/*/index.html" %> \path ->
     case filePattern (outputDir </> "package/*/index.html") path of
       Just [pkgIdStr] | Just pkgId <- simpleParsec pkgIdStr -> do
-        pkgSpec <- pkgSpecForPkgId pkgId
+        pkgSpec <- askOracle (PkgSpecFor pkgId)
         let cabalFile = cabalFileForPkgId pkgId
         need [cabalFile]
         pkgDesc <- liftIO $ readGenericPackageDescription Verbosity.silent cabalFile
@@ -98,36 +90,28 @@ data AllPackagesPageEntry = AllPackagesPageEntry
   deriving stock (Generic)
   deriving (ToJSON) via MyAesonEncoding AllPackagesPageEntry
 
-makeAllPackagesPage :: UTCTime -> FilePath -> [(FilePath, PackageId, PackageVersionSpec)] -> Action ()
-makeAllPackagesPage currentTime path allPkgSpecs = do
-  let packages :: [AllPackagesPageEntry]
-      packages =
-        allPkgSpecs
-          -- group package versions by package name
-          & NE.groupBy ((==) `on` sndOf3)
-          -- for each package name pick the most recent version
-          & map
-            ( \group ->
-                -- pick the most recent version
-                minimumBy (comparing $ Down . pkgVersion . sndOf3) group
-                  -- turn it into the template data
-                  & ( \(_metaFile, pkgId, PackageVersionSpec{packageVersionTimestamp, packageVersionRevisions, packageVersionSource}) ->
-                        AllPackagesPageEntry
-                          { allPackagesPageEntryPkgId = pkgId
-                          , allPackagesPageEntryTimestamp = fromMaybe currentTime packageVersionTimestamp
-                          , allPackagesPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime packageVersionTimestamp)
-                          , allPackagesPageEntrySource = packageVersionSource
-                          , allPackagesPageEntryLatestRevisionTimestamp = revisionTimestamp <$> listToMaybe packageVersionRevisions
-                          }
-                    )
-            )
-          -- sort packages by pkgId
-          & sortOn allPackagesPageEntryPkgId
-
+makeAllPackagesPage :: UTCTime -> FilePath -> Map PackageId (FilePath, PackageVersionSpec) -> Action ()
+makeAllPackagesPage currentTime path pkgSpecs =
   liftIO $
     TL.writeFile path $
       renderMustache allPackagesPageTemplate $
         object ["packages" .= packages]
+ where
+  packages =
+    sortOn
+      allPackagesPageEntryPkgId
+      [ AllPackagesPageEntry
+        { allPackagesPageEntryPkgId = pkgId
+        , allPackagesPageEntryTimestamp = fromMaybe currentTime packageVersionTimestamp
+        , allPackagesPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime packageVersionTimestamp)
+        , allPackagesPageEntrySource = packageVersionSource
+        , allPackagesPageEntryLatestRevisionTimestamp = revisionTimestamp <$> listToMaybe packageVersionRevisions
+        }
+      | (pkgName, pvs) <- M.toList (groupByPackageName pkgSpecs)
+      , let (pkgVersion, pkgSpec) = F1.minimumBy (comparing $ Down . fst) pvs
+      , let PackageVersionSpec{packageVersionTimestamp, packageVersionRevisions, packageVersionSource} = pkgSpec
+      , let pkgId = PackageIdentifier pkgName pkgVersion
+      ]
 
 -- FIXME: refactor this
 data AllPackageVersionsPageEntry
@@ -147,55 +131,51 @@ data AllPackageVersionsPageEntry
   deriving stock (Generic)
   deriving (ToJSON) via MyAesonEncoding AllPackageVersionsPageEntry
 
-makeAllPackageVersionsPage :: UTCTime -> FilePath -> [(FilePath, PackageId, PackageVersionSpec)] -> Action ()
-makeAllPackageVersionsPage currentTime path allPkgSpecs = do
-  let entries =
-        allPkgSpecs
-          -- collect all cabal file revisions including the original cabal file
-          & foldMap
-            ( \(_metaFile, pkgId, pkgSpec@PackageVersionSpec{packageVersionSource, packageVersionTimestamp, packageVersionRevisions}) ->
-                -- original cabal file
-                AllPackageVersionsPageEntryPackage
-                  { allPackageVersionsPageEntryPkgId = pkgId
-                  , allPackageVersionsPageEntryTimestamp = fromMaybe currentTime packageVersionTimestamp
-                  , allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime packageVersionTimestamp)
-                  , allPackageVersionsPageEntrySource = packageVersionSource
-                  , allPackageVersionsPageEntryDeprecated = packageVersionIsDeprecated pkgSpec
-                  }
-                  -- list of revisions
-                  : [ AllPackageVersionsPageEntryRevision
-                      { allPackageVersionsPageEntryPkgId = pkgId
-                      , allPackageVersionsPageEntryTimestamp = revisionTimestamp
-                      , allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp
-                      , allPackageVersionsPageEntryDeprecated = packageVersionIsDeprecated pkgSpec
-                      }
-                    | RevisionSpec{revisionTimestamp} <- packageVersionRevisions
-                    ]
-            )
-          -- sort them by timestamp
-          & sortOn (Down . allPackageVersionsPageEntryTimestamp)
-
+makeAllPackageVersionsPage :: UTCTime -> FilePath -> Map PackageId (FilePath, PackageVersionSpec) -> Action ()
+makeAllPackageVersionsPage currentTime path pkgSpecs =
   liftIO $
     TL.writeFile path $
       renderMustache allPackageVersionsPageTemplate $
         object ["entries" .= entries]
+ where
+  entries =
+    sortOn (Down . allPackageVersionsPageEntryTimestamp)
+      -- collect all cabal file revisions including the original cabal file
+      . M.foldMapWithKey
+        ( \pkgId (_, pkgSpec) ->
+            -- original cabal file
+            AllPackageVersionsPageEntryPackage
+              { allPackageVersionsPageEntryPkgId = pkgId
+              , allPackageVersionsPageEntryTimestamp = fromMaybe currentTime $ packageVersionTimestamp pkgSpec
+              , allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds $ fromMaybe currentTime $ packageVersionTimestamp pkgSpec
+              , allPackageVersionsPageEntrySource = packageVersionSource pkgSpec
+              , allPackageVersionsPageEntryDeprecated = packageVersionIsDeprecated pkgSpec
+              --
+              }
+              -- list of revisions
+              : [ AllPackageVersionsPageEntryRevision
+                  { allPackageVersionsPageEntryPkgId = pkgId
+                  , allPackageVersionsPageEntryTimestamp = revisionTimestamp
+                  , allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp
+                  , allPackageVersionsPageEntryDeprecated = packageVersionIsDeprecated pkgSpec
+                  }
+                | RevisionSpec{revisionTimestamp} <- packageVersionRevisions pkgSpec
+                ]
+        )
+      $ pkgSpecs
 
 makePackageVersionPage :: FilePath -> GenericPackageDescription -> PackageVersionSpec -> Action ()
-makePackageVersionPage
-  path
-  pkgDesc
-  pkgSpec@PackageVersionSpec{packageVersionSource, packageVersionRevisions, packageVersionTimestamp} =
-    let
-     in liftIO $
-          TL.writeFile path $
-            renderMustache packageVersionPageTemplate $
-              object
-                [ "pkgVersionSource" .= packageVersionSource
-                , "cabalFileRevisions" .= map revisionTimestamp packageVersionRevisions
-                , "pkgDesc" .= jsonGenericPackageDescription pkgDesc
-                , "pkgTimestamp" .= packageVersionTimestamp
-                , "pkgVersionDeprecated" .= packageVersionIsDeprecated pkgSpec
-                ]
+makePackageVersionPage path pkgDesc pkgSpec =
+  liftIO $
+    TL.writeFile path $
+      renderMustache packageVersionPageTemplate $
+        object
+          [ "pkgVersionSource" .= packageVersionSource pkgSpec
+          , "cabalFileRevisions" .= map revisionTimestamp (packageVersionRevisions pkgSpec)
+          , "pkgDesc" .= jsonGenericPackageDescription pkgDesc
+          , "pkgTimestamp" .= packageVersionTimestamp pkgSpec
+          , "pkgVersionDeprecated" .= packageVersionIsDeprecated pkgSpec
+          ]
 
 indexPageTemplate :: Template
 indexPageTemplate = $(compileMustacheDir "index" "templates")

app/Foliage/Rules/Utils.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Foliage.Rules.Utils where
+
+import Data.List.NonEmpty qualified as NE
+import Data.Map
+import Data.Map.Strict qualified as M
+import Development.Shake
+import Development.Shake.Classes
+import Distribution.Package (PackageId)
+import Distribution.PackageDescription (PackageIdentifier (..), PackageName)
+import Distribution.Version (Version)
+import Foliage.Meta
+import GHC.Generics (Generic)
+
+groupByPackageName :: Map PackageId (FilePath, PackageVersionSpec) -> Map PackageName (NE.NonEmpty (Version, PackageVersionSpec))
+groupByPackageName pkgSpecs =
+  M.fromListWith
+    (<>)
+    [ (pkgName pkgId, NE.singleton (pkgVersion pkgId, pkgSpec))
+    | (pkgId, (_metaFile, pkgSpec)) <- M.toList pkgSpecs
+    ]
+
+newtype PkgSpecFor = PkgSpecFor PackageId
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (Hashable, Binary, NFData)
+
+type instance RuleResult PkgSpecFor = PackageVersionSpec
+
+data PkgSpecs = PkgSpecs
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (Hashable, Binary, NFData)
+
+type instance RuleResult PkgSpecs = Map PackageId (FilePath, PackageVersionSpec)

app/Foliage/SourceDist.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -18,6 +19,8 @@ import Data.List (dropWhileEnd)
 import Development.Shake (
   Action,
   CmdOption (..),
+  RuleResult,
+  Rules,
   cmd_,
   getDirectoryFiles,
   liftIO,
@@ -32,16 +35,50 @@ import Development.Shake.FilePath (
  )
 import Distribution.Compat.Lens (set)
 import Distribution.PackageDescription.PrettyPrint (writeGenericPackageDescription)
-import Distribution.Simple (Version)
+import Distribution.Simple (PackageId, Version)
 import Distribution.Simple.PackageDescription (readGenericPackageDescription)
 import Distribution.Types.Lens qualified as L
 import Distribution.Verbosity qualified as Verbosity
-import Network.URI (URI (..), URIAuth (..))
+import Network.URI (URI (..), URIAuth (..), pathSegments)
 import System.Directory qualified as IO
 
+import Development.Shake.Classes
+import Development.Shake.Rule
+import Distribution.Pretty (prettyShow)
 import Foliage.FetchURL (fetchURL)
 import Foliage.Meta (PackageVersionSource (..))
 import Foliage.Utils.GitHub (githubRepoTarballUrl)
+import GHC.Generics (Generic)
+import Hackage.Security.Util.Path (joinFragments)
+
+data FetchSource = FetchSource PackageId PackageVersionSource
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (Hashable, Binary, NFData)
+
+type instance RuleResult FetchSource = FilePath
+
+fetchSource :: PackageId -> PackageVersionSource -> Action FilePath
+fetchSource pkgId pvs = apply1 $ FetchSource pkgId pvs
+
+addFetchSourceRule :: Rules ()
+addFetchSourceRule = addBuiltinRule noLint noIdentity run
+ where
+  run (FetchSource pkgId pvs) oldETag _mode = do
+    let dstDir = "_cache/packages" </> prettyShow pkgId
+
+    case pvs of
+      (URISource (URI{uriScheme, uriPath}) mSubdir) | uriScheme == "file:" -> do
+        tarballPath <- liftIO $ IO.makeAbsolute uriPath
+        extractFromTarball tarballPath mSubdir
+      (URISource uri mSubdir) -> do
+        tarballPath <- cachePathForURL cacheDir uri
+        fetchURL uri tarballPath
+        extractFromTarball tarballPath mSubdir
+      (GitHubSource repo rev mSubdir) -> do
+        let uri = githubRepoTarballUrl repo rev
+        tarballPath <- cachePathForURL cacheDir uri
+        fetchURL uri tarballPath
+        extractFromTarball tarballPath mSubdir
 
 applyPatches :: FilePath -> FilePath -> Action ()
 applyPatches metaFile pkgDir = do
@@ -75,10 +112,9 @@ updateCabalFileVersion path pkgVersion = do
   liftIO $ writeGenericPackageDescription path pkgDesc'
 
 cachePathForURL :: FilePath -> URI -> Action FilePath
-cachePathForURL cacheDir uri = do
+cachePathForURL uri = do
   let scheme = dropWhileEnd (not . isAlpha) $ uriScheme uri
       host = maybe (error $ "invalid uri " ++ show uri) uriRegName (uriAuthority uri)
-  return $ cacheDir </> scheme </> host <//> uriPath uri
 
 extractFromTarball :: FilePath -> Maybe FilePath -> FilePath -> Action ()
 extractFromTarball tarballPath mSubdir destDir = do

foliage.cabal

@@ -34,6 +34,7 @@ executable foliage
         Foliage.Rules.Core
         Foliage.Rules.HackageExtra
         Foliage.Rules.Pages
+        Foliage.Rules.Utils
         Foliage.SourceDist
         Foliage.Time
         Foliage.Utils.Aeson