I have no idea what I am doing

2024-11-25 18:38:15 +03:00 · 2023-11-15 22:50:38 +08:00 · 2023-11-15 22:50:38 +08:00 · 6971a8cf82
commit 6971a8cf82
parent e5c01022fe
8 changed files with 244 additions and 195 deletions
--- a/app/Foliage/CmdBuild.hs
+++ b/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,8 +193,7 @@ cmdBuild buildOptions = do
    -- Index creation
    --

-    getPkgSpecs <- do
-      getPkgSpecs' <- addOracleCache $ \PkgSpecs{} -> do
+    getPkgSpecs <- addOracleCache $ \PkgSpecs -> do
      metaFiles <- getDirectoryFiles inputDir ["*/*/meta.toml"]
      when (null metaFiles) $ do
        error $
@ -199,22 +202,22 @@ cmdBuild buildOptions = do
            , "Make sure you are passing the right input directory. The default input directory is _sources"
            ]

-        forP metaFiles $ \path ->
+      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 (inputDir </> path, pkgId, pkgSpec)
+            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)]
--- a/app/Foliage/Meta.hs
+++ b/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
--- a/app/Foliage/Rules/Core.hs
+++ b/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,52 +126,51 @@ 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
+generateEntriesForGroup :: PackageName -> NE.NonEmpty (Version, PackageVersionSpec) -> [Tar.Entry]
+generateEntriesForGroup pkgName 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) ->
+        ( \(pkgVersion, pkgSpec) ->
            [ (deprecationTimestamp, rangeAct)
            | DeprecationSpec{deprecationTimestamp, deprecationIsDeprecated} <- packageVersionDeprecations pkgSpec
            , let rangeAct =
                    if deprecationIsDeprecated
-                          then intersectVersionRanges (notThisVersion (pkgVersion pkgId))
-                          else unionVersionRanges (thisVersion (pkgVersion pkgId))
+                      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)
+  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.
@ -181,13 +181,11 @@ makeExtraEntries allPkgSpecs =
  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
+  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 pn effectiveRange mainLibSet
-   in
-    foldMap generateEntriesForGroup groupedPackageVersions
+    dep = mkDependency pkgName effectiveRange mainLibSet

 makeIndexPkgCabal :: PackageId -> UTCTime -> FilePath -> Action Tar.Entry
 makeIndexPkgCabal pkgId timestamp filePath = do
--- a/app/Foliage/Rules/HackageExtra.hs
+++ b/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")
--- a/app/Foliage/Rules/Pages.hs
+++ b/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]
+makeAllPackagesPage :: UTCTime -> FilePath -> Map PackageId (FilePath, PackageVersionSpec) -> Action ()
+makeAllPackagesPage currentTime path pkgSpecs =
+  liftIO $
+    TL.writeFile path $
+      renderMustache allPackagesPageTemplate $
+        object ["packages" .= packages]
+ where
  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
+    sortOn
+      allPackagesPageEntryPkgId
+      [ AllPackagesPageEntry
        { allPackagesPageEntryPkgId = pkgId
        , allPackagesPageEntryTimestamp = fromMaybe currentTime packageVersionTimestamp
        , allPackagesPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime packageVersionTimestamp)
        , allPackagesPageEntrySource = packageVersionSource
        , allPackagesPageEntryLatestRevisionTimestamp = revisionTimestamp <$> listToMaybe packageVersionRevisions
        }
-                    )
-            )
-          -- sort packages by pkgId
-          & sortOn allPackagesPageEntryPkgId
-
-  liftIO $
-    TL.writeFile path $
-      renderMustache allPackagesPageTemplate $
-        object ["packages" .= packages]
+      | (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,20 +131,26 @@ 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
+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
-          & foldMap
-            ( \(_metaFile, pkgId, pkgSpec@PackageVersionSpec{packageVersionSource, packageVersionTimestamp, packageVersionRevisions}) ->
+      . M.foldMapWithKey
+        ( \pkgId (_, pkgSpec) ->
            -- original cabal file
            AllPackageVersionsPageEntryPackage
              { allPackageVersionsPageEntryPkgId = pkgId
-                  , allPackageVersionsPageEntryTimestamp = fromMaybe currentTime packageVersionTimestamp
-                  , allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime packageVersionTimestamp)
-                  , allPackageVersionsPageEntrySource = packageVersionSource
+              , allPackageVersionsPageEntryTimestamp = fromMaybe currentTime $ packageVersionTimestamp pkgSpec
+              , allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds $ fromMaybe currentTime $ packageVersionTimestamp pkgSpec
+              , allPackageVersionsPageEntrySource = packageVersionSource pkgSpec
              , allPackageVersionsPageEntryDeprecated = packageVersionIsDeprecated pkgSpec
+              --
              }
              -- list of revisions
              : [ AllPackageVersionsPageEntryRevision
@ -169,31 +159,21 @@ makeAllPackageVersionsPage currentTime path allPkgSpecs = do
                  , allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp
                  , allPackageVersionsPageEntryDeprecated = packageVersionIsDeprecated pkgSpec
                  }
-                    | RevisionSpec{revisionTimestamp} <- packageVersionRevisions
+                | RevisionSpec{revisionTimestamp} <- packageVersionRevisions pkgSpec
                ]
        )
-          -- sort them by timestamp
-          & sortOn (Down . allPackageVersionsPageEntryTimestamp)
-
-  liftIO $
-    TL.writeFile path $
-      renderMustache allPackageVersionsPageTemplate $
-        object ["entries" .= entries]
+      $ pkgSpecs

 makePackageVersionPage :: FilePath -> GenericPackageDescription -> PackageVersionSpec -> Action ()
-makePackageVersionPage
-  path
-  pkgDesc
-  pkgSpec@PackageVersionSpec{packageVersionSource, packageVersionRevisions, packageVersionTimestamp} =
-    let
-     in liftIO $
+makePackageVersionPage path pkgDesc pkgSpec =
+  liftIO $
    TL.writeFile path $
      renderMustache packageVersionPageTemplate $
        object
-                [ "pkgVersionSource" .= packageVersionSource
-                , "cabalFileRevisions" .= map revisionTimestamp packageVersionRevisions
+          [ "pkgVersionSource" .= packageVersionSource pkgSpec
+          , "cabalFileRevisions" .= map revisionTimestamp (packageVersionRevisions pkgSpec)
          , "pkgDesc" .= jsonGenericPackageDescription pkgDesc
-                , "pkgTimestamp" .= packageVersionTimestamp
+          , "pkgTimestamp" .= packageVersionTimestamp pkgSpec
          , "pkgVersionDeprecated" .= packageVersionIsDeprecated pkgSpec
          ]

--- a/app/Foliage/Rules/Utils.hs
+++ b/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)
--- a/app/Foliage/SourceDist.hs
+++ b/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
--- a/foliage.cabal
+++ b/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