diff --git a/src/Stackage/Database/Cron.hs b/src/Stackage/Database/Cron.hs index 19bfc98..02f8e49 100644 --- a/src/Stackage/Database/Cron.hs +++ b/src/Stackage/Database/Cron.hs @@ -239,29 +239,53 @@ makeCorePackageGetters :: makeCorePackageGetters = do rootDir <- scStackageRoot <$> ask contentDir <- getStackageContentDir rootDir + coreCabalFiles <- getCoreCabalFiles rootDir liftIO (decodeFileEither (contentDir "stack" "global-hints.yaml")) >>= \case Right (hints :: Map CompilerP (Map PackageNameP VersionP)) -> Map.traverseWithKey (\compiler -> - fmap Map.elems . Map.traverseMaybeWithKey (makeCorePackageGetter compiler)) + fmap Map.elems . + Map.traverseMaybeWithKey (makeCorePackageGetter compiler coreCabalFiles)) hints Left exc -> do logError $ "Error parsing 'global-hints.yaml' file: " <> fromString (displayException exc) return mempty +getCoreCabalFiles :: FilePath -> RIO StackageCron (Map PackageIdentifierP GenericPackageDescription) +getCoreCabalFiles rootDir = do + coreCabalFilesDir <- getCoreCabalFilesDir rootDir + cabalFileNames <- getDirectoryContents coreCabalFilesDir + cabalFiles <- + forM (filter (isExtensionOf ".cabal") cabalFileNames) $ \cabalFileName -> + let pidTxt = T.pack (dropExtension (takeFileName cabalFileName)) + in case fromPathPiece pidTxt of + Nothing -> do + logError $ "Invalid package identifier: " <> fromString cabalFileName + pure Nothing + Just pid@(PackageIdentifierP pname _) -> do + mgpd <- + readFileBinary (coreCabalFilesDir cabalFileName) >>= + parseCabalBlobMaybe pname + pure ((,) pid <$> mgpd) + pure $ Map.fromList $ catMaybes cabalFiles + -- | Core package info rarely changes between the snapshots, therefore it would be wasteful to -- load, parse and update all packages from gloabl-hints for each snapshot, instead we produce -- a memoized version that will do it once initiall and then return information aboat a -- package on subsequent invocations. makeCorePackageGetter :: - CompilerP -> PackageNameP -> VersionP -> RIO StackageCron (Maybe CorePackageGetter) -makeCorePackageGetter _compiler pname ver = + CompilerP + -> Map PackageIdentifierP GenericPackageDescription + -> PackageNameP + -> VersionP + -> RIO StackageCron (Maybe CorePackageGetter) +makeCorePackageGetter _compiler fallbackCabalFileMap pname ver = run (getHackageCabalByRev0 pid) >>= \case Nothing -> do logWarn $ "Core package from global-hints: '" <> display pid <> "' was not found in pantry." - pure Nothing + pure (pure . (,,,) Nothing Nothing pid <$> Map.lookup pid fallbackCabalFileMap) Just (hackageCabalId, blobId, _) -> do pkgInfoRef <- newIORef Nothing -- use for caching of pkgInfo let getMemoPackageInfo = diff --git a/src/Stackage/Database/Github.hs b/src/Stackage/Database/Github.hs index 664b2b2..8ea0deb 100644 --- a/src/Stackage/Database/Github.hs +++ b/src/Stackage/Database/Github.hs @@ -4,6 +4,7 @@ module Stackage.Database.Github ( cloneOrUpdate , lastGitFileUpdate , getStackageContentDir + , getCoreCabalFilesDir , GithubRepo(..) ) where @@ -72,3 +73,11 @@ getStackageContentDir :: -> m FilePath getStackageContentDir rootDir = cloneOrUpdate rootDir (GithubRepo "commercialhaskell" "stackage-content") + +-- | Use backup location with cabal files, hackage doesn't have all of them. +getCoreCabalFilesDir :: + (MonadReader env m, HasLogFunc env, HasProcessContext env, MonadIO m) + => FilePath + -> m FilePath +getCoreCabalFilesDir rootDir = + cloneOrUpdate rootDir (GithubRepo "commercialhaskell" "core-cabal-files") diff --git a/src/Stackage/Database/Query.hs b/src/Stackage/Database/Query.hs index 0b10d24..436b0b7 100644 --- a/src/Stackage/Database/Query.hs +++ b/src/Stackage/Database/Query.hs @@ -2,7 +2,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} module Stackage.Database.Query ( -- * Snapshot