haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-11 19:58:28 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Don't error if hoogle inputs are missing

Browse Source
This commit is contained in:
Bryan Richter 2025-03-18 14:01:29 +02:00
parent 9523039dee
commit cbe4038c12
No known key found for this signature in database
GPG Key ID: B202264020068BFB
1 changed files with 26 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
src/Stackage/Database/Cron.hs
View File

@ -836,11 +836,12 @@ buildAndUploadHoogleDBs doNotUpload = do
Nothing -> do Nothing -> do
logInfo $ "Current hoogle database does not yet exist in the bucket for: " <> display snapName logInfo $ "Current hoogle database does not yet exist in the bucket for: " <> display snapName
-- NB: createHoogleDB will fail if something goes wrong. -- NB: createHoogleDB will fail if something goes wrong.
fp <- createHoogleDB tmpdir snapshotId snapName mhdb <- createHoogleDB tmpdir snapshotId snapName
let key = hoogleKey snapName for_ mhdb $ \hdb -> do
unless doNotUpload $ do let key = hoogleKey snapName
uploadHoogleDB fp (ObjectKey key) unless doNotUpload $ do
void $ insertH snapshotId uploadHoogleDB hdb (ObjectKey key)
void $ insertH snapshotId
-- | Create a hoogle db from haddocks for the given snapshot. -- | Create a hoogle db from haddocks for the given snapshot.
-- --
@ -849,7 +850,7 @@ buildAndUploadHoogleDBs doNotUpload = do
-- --
-- Returns the path to the .hoo database, which will be found in the first -- Returns the path to the .hoo database, which will be found in the first
-- argument. It will look like @<rootDir>/hoogle-gen/output.hoo@. -- argument. It will look like @<rootDir>/hoogle-gen/output.hoo@.
createHoogleDB :: FilePath -> SnapshotId -> SnapName -> RIO StackageCron FilePath createHoogleDB :: FilePath -> SnapshotId -> SnapName -> RIO StackageCron (Maybe FilePath)
createHoogleDB rootDir snapshotId snapName = do createHoogleDB rootDir snapshotId snapName = do
logInfo $ "Creating Hoogle DB for " <> display snapName logInfo $ "Creating Hoogle DB for " <> display snapName
downloadBucketUrl <- scDownloadBucketUrl <$> ask downloadBucketUrl <- scDownloadBucketUrl <$> ask
@ -863,6 +864,7 @@ createHoogleDB rootDir snapshotId snapName = do
env <- asks scEnvAWS env <- asks scEnvAWS
let man = env ^. env_manager let man = env ^. env_manager
withResponseUnliftIO req {decompress = const True} man $ \res -> do withResponseUnliftIO req {decompress = const True} man $ \res -> do
-- FIXME: Catch HttpExceptionRequest and give up on this snapshot?
throwErrorStatusCodes req res throwErrorStatusCodes req res
createDirectoryIfMissing True $ takeDirectory outputTarFP createDirectoryIfMissing True $ takeDirectory outputTarFP
withBinaryFileDurableAtomic outputTarFP WriteMode $ \tarHandle -> withBinaryFileDurableAtomic outputTarFP WriteMode $ \tarHandle ->
@ -876,20 +878,24 @@ createHoogleDB rootDir snapshotId snapName = do
untar (restoreHoogleTxtFileWithCabal tmpdir snapshotId snapName) .| untar (restoreHoogleTxtFileWithCabal tmpdir snapshotId snapName) .|
foldMapC Any foldMapC Any
-- We just check if we have any Hoogle .txt file at all. -- We just check if we have any Hoogle .txt file at all.
unless hasRestored $ error "No Hoogle .txt files found" -- If there are none, we just give up
-- Generate the hoogle database if hasRestored then do
let args = ["generate", "--database=" ++ outname, "--local=" ++ tmpdir] -- Generate the hoogle database
logInfo $ let args = ["generate", "--database=" ++ outname, "--local=" ++ tmpdir]
mconcat logInfo $
[ "Merging databases... (" mconcat
, foldMap fromString $ L.intersperse " " ("hoogle" : args) [ "Merging databases... ("
, ")" , foldMap fromString $ L.intersperse " " ("hoogle" : args)
] , ")"
-- 'Hoogle.hoogle' expects to run as an app, and crashes if something ]
-- goes wrong. That's good. -- 'Hoogle.hoogle' expects to run as an app, and crashes if something
liftIO $ Hoogle.hoogle args -- goes wrong. That's good.
logInfo "Merge done" liftIO $ Hoogle.hoogle args
pure outname logInfo "Merge done"
pure $ Just outname
else do
logWarn $ "No Hoogle.txt files found for " <> display snapName <> ", skipping Hoogle DB creation."
pure Nothing
-- | Grabs hoogle txt file from the tarball and a matching cabal file from pantry. Writes -- | Grabs hoogle txt file from the tarball and a matching cabal file from pantry. Writes