Don't error if hoogle inputs are missing

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

View File

@ -836,10 +836,11 @@ 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
for_ mhdb $ \hdb -> do
let key = hoogleKey snapName let key = hoogleKey snapName
unless doNotUpload $ do unless doNotUpload $ do
uploadHoogleDB fp (ObjectKey key) uploadHoogleDB hdb (ObjectKey key)
void $ insertH snapshotId 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,7 +878,8 @@ 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
if hasRestored then do
-- Generate the hoogle database -- Generate the hoogle database
let args = ["generate", "--database=" ++ outname, "--local=" ++ tmpdir] let args = ["generate", "--database=" ++ outname, "--local=" ++ tmpdir]
logInfo $ logInfo $
@ -889,7 +892,10 @@ createHoogleDB rootDir snapshotId snapName = do
-- goes wrong. That's good. -- goes wrong. That's good.
liftIO $ Hoogle.hoogle args liftIO $ Hoogle.hoogle args
logInfo "Merge done" logInfo "Merge done"
pure outname 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