refactor(cabal-install): refactor IndexUtils.hs

This PR refactors getSourcePackagesAtIndexState into smaller functions.
haskell · Jun 10, 2024 · 7c14292 · 7c14292
1 parent 2140c0f
commit 7c14292
Showing 1 changed file with 141 additions and 77 deletions.
diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs
@@ -271,84 +271,14 @@ getSourcePackagesAtIndexState verbosity repoCtxt _ _
         , ActiveRepos []
         )
 getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do
-  let describeState IndexStateHead = "most recent state"
-      describeState (IndexStateTime time) = "historical state as of " ++ prettyShow time
-
   pkgss <- for (repoContextRepos repoCtxt) $ \r -> do
-    let rname :: RepoName
-        rname = repoName r
-
-    info verbosity ("Reading available packages of " ++ unRepoName rname ++ "...")
-
-    idxState <- case mb_idxState of
-      Just totalIdxState -> do
-        let idxState = lookupIndexState rname totalIdxState
-        info verbosity $
-          "Using "
-            ++ describeState idxState
-            ++ " as explicitly requested (via command line / project configuration)"
-        return idxState
-      Nothing -> do
-        mb_idxState' <- readIndexTimestamp verbosity (RepoIndex repoCtxt r)
-        case mb_idxState' of
-          Nothing -> do
-            info verbosity "Using most recent state (could not read timestamp file)"
-            return IndexStateHead
-          Just idxState -> do
-            info verbosity $
-              "Using "
-                ++ describeState idxState
-                ++ " specified from most recent cabal update"
-            return idxState
-
-    unless (idxState == IndexStateHead) $
-      case r of
-        RepoLocalNoIndex{} -> warn verbosity "index-state ignored for file+noindex repositories"
-        RepoRemote{} -> warn verbosity ("index-state ignored for old-format (remote repository '" ++ unRepoName rname ++ "')")
-        RepoSecure{} -> pure ()
-
-    let idxState' = case r of
-          RepoSecure{} -> idxState
-          _ -> IndexStateHead
-
-    (pis, deps, isi) <- readRepoIndex verbosity repoCtxt r idxState'
-
-    case idxState' of
-      IndexStateHead -> do
-        info verbosity ("index-state(" ++ unRepoName rname ++ ") = " ++ prettyShow (isiHeadTime isi))
-        return ()
-      IndexStateTime ts0 ->
-        -- isiMaxTime is the latest timestamp in the filtered view returned by
-        -- `readRepoIndex` above. It is always true that isiMaxTime is less or
-        -- equal to a requested IndexStateTime. When `isiMaxTime isi /= ts0` (or
-        -- equivalently `isiMaxTime isi < ts0`) it means that ts0 falls between
-        -- two timestamps in the index.
-        when (isiMaxTime isi /= ts0) $
-          let commonMsg =
-                "There is no index-state for '"
-                  ++ unRepoName rname
-                  ++ "' exactly at the requested timestamp ("
-                  ++ prettyShow ts0
-                  ++ "). "
-           in if isNothing $ timestampToUTCTime (isiMaxTime isi)
-                then
-                  warn verbosity $
-                    commonMsg
-                      ++ "Also, there are no index-states before the one requested, so the repository '"
-                      ++ unRepoName rname
-                      ++ "' will be empty."
-                else
-                  info verbosity $
-                    commonMsg
-                      ++ "Falling back to the previous index-state that exists: "
-                      ++ prettyShow (isiMaxTime isi)
-    pure
-      RepoData
-        { rdRepoName = rname
-        , rdTimeStamp = isiMaxTime isi
-        , rdIndex = pis
-        , rdPreferences = deps
-        }
+    let RepoName rname = repoName r
+    info verbosity ("Reading available packages of " ++ rname ++ "...")
+
+    case r of
+      RepoLocalNoIndex{} -> getRepoLocalNoIndexDataAtIndexState verbosity mb_idxState repoCtxt r
+      RepoRemote{} -> getRepoRemoteDataAtIndexState verbosity mb_idxState repoCtxt r
+      RepoSecure{} -> getRepoSecureDataAtIndexState verbosity mb_idxState repoCtxt r
 
   let activeRepos :: ActiveRepos
       activeRepos = fromMaybe defaultActiveRepos mb_activeRepos
@@ -407,6 +337,140 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do
     , activeRepos'
     )
 
+getRepoLocalNoIndexDataAtIndexState
+  :: Verbosity
+  -> Maybe TotalIndexState
+  -> RepoContext
+  -> Repo
+  -> IO RepoData
+getRepoLocalNoIndexDataAtIndexState verbosity mb_idxState repoCtxt r = do
+  let RepoName rname = repoName r
+
+  -- NOTE: This is what the code used to do. I think calling this here is wrong.
+  idxState <- resolveRepoIndexState verbosity repoCtxt r mb_idxState
+  -- NOTE: ^^^
+
+  unless (idxState == IndexStateHead) $
+    warn verbosity "index-state ignored for file+noindex repositories"
+
+  (pis, deps, isi) <- readRepoIndex verbosity repoCtxt r IndexStateHead
+  info verbosity ("index-state(" ++ rname ++ ") = " ++ prettyShow (isiHeadTime isi))
+
+  pure
+    RepoData
+      { rdRepoName = repoName r
+      , rdTimeStamp = isiMaxTime isi
+      , rdIndex = pis
+      , rdPreferences = deps
+      }
+
+getRepoRemoteDataAtIndexState
+  :: Verbosity
+  -> Maybe TotalIndexState
+  -> RepoContext
+  -> Repo
+  -> IO RepoData
+getRepoRemoteDataAtIndexState verbosity mb_idxState repoCtxt r = do
+  let RepoName rname = repoName r
+
+  -- NOTE: This is what the code used to do. I think calling this here is wrong.
+  idxState <- resolveRepoIndexState verbosity repoCtxt r mb_idxState
+  -- NOTE: ^^^
+
+  unless (idxState == IndexStateHead) $
+    warn verbosity ("index-state ignored for old-format (remote repository '" ++ rname ++ "')")
+
+  (pis, deps, isi) <- readRepoIndex verbosity repoCtxt r IndexStateHead
+  info verbosity ("index-state(" ++ rname ++ ") = " ++ prettyShow (isiHeadTime isi))
+
+  pure
+    RepoData
+      { rdRepoName = repoName r
+      , rdTimeStamp = isiMaxTime isi
+      , rdIndex = pis
+      , rdPreferences = deps
+      }
+
+getRepoSecureDataAtIndexState
+  :: Verbosity
+  -> Maybe TotalIndexState
+  -> RepoContext
+  -> Repo
+  -> IO RepoData
+getRepoSecureDataAtIndexState verbosity mb_idxState repoCtxt r = do
+  let RepoName rname = repoName r
+
+  repoIdxState <- resolveRepoIndexState verbosity repoCtxt r mb_idxState
+  (pis, deps, isi) <- readRepoIndex verbosity repoCtxt r repoIdxState
+
+  case repoIdxState of
+    IndexStateHead -> do
+      info verbosity ("index-state(" ++ rname ++ ") = " ++ prettyShow (isiHeadTime isi))
+      return ()
+    IndexStateTime ts0 ->
+      -- isiMaxTime is the latest timestamp in the filtered view returned by
+      -- `readRepoIndex` above. It is always true that isiMaxTime is less or
+      -- equal to a requested IndexStateTime. When `isiMaxTime isi /= ts0` (or
+      -- equivalently `isiMaxTime isi < ts0`) it means that ts0 falls between
+      -- two timestamps in the index.
+      when (isiMaxTime isi /= ts0) $
+        let commonMsg =
+              "There is no index-state for '"
+                ++ rname
+                ++ "' exactly at the requested timestamp ("
+                ++ prettyShow ts0
+                ++ "). "
+         in if isNothing $ timestampToUTCTime (isiMaxTime isi)
+              then
+                warn verbosity $
+                  commonMsg
+                    ++ "Also, there are no index-states before the one requested, so the repository '"
+                    ++ rname
+                    ++ "' will be empty."
+              else
+                info verbosity $
+                  commonMsg
+                    ++ "Falling back to the previous index-state that exists: "
+                    ++ prettyShow (isiMaxTime isi)
+  pure
+    RepoData
+      { rdRepoName = repoName r
+      , rdTimeStamp = isiMaxTime isi
+      , rdIndex = pis
+      , rdPreferences = deps
+      }
+
+resolveRepoIndexState
+  :: Verbosity
+  -> RepoContext
+  -> Repo
+  -> Maybe TotalIndexState
+  -> IO RepoIndexState
+resolveRepoIndexState verbosity repoCtxt r mb_idxState =
+  case mb_idxState of
+    Just totalIdxState -> do
+      let idxState = lookupIndexState (repoName r) totalIdxState
+      info verbosity $
+        "Using "
+          ++ describeState idxState
+          ++ " as explicitly requested (via command line / project configuration)"
+      return idxState
+    Nothing -> do
+      mb_idxState' <- readIndexTimestamp verbosity (RepoIndex repoCtxt r)
+      case mb_idxState' of
+        Nothing -> do
+          info verbosity "Using most recent state (could not read timestamp file)"
+          return IndexStateHead
+        Just idxState -> do
+          info verbosity $
+            "Using "
+              ++ describeState idxState
+              ++ " specified from most recent cabal update"
+          return idxState
+  where
+    describeState IndexStateHead = "most recent state"
+    describeState (IndexStateTime time) = "historical state as of " ++ prettyShow time
+
 -- auxiliary data used in getSourcePackagesAtIndexState
 data RepoData = RepoData
   { rdRepoName :: RepoName