Remove scary "handleAny"

Simply let the process die on exception. It's a one-shot process that
gets run on a timer, anyway.

src/Stackage/Database/Cron.hs

@@ -815,53 +815,50 @@ buildAndUploadHoogleDB doNotUpload = do
                             uploadHoogleDB dest (ObjectKey key)
                             void $ insertH snapshotId
 
--- | Create a hoogle db from haddocks for the given snapshot, and upload it to
+-- | Create a hoogle db from haddocks for the given snapshot.
--- the haddock bucket.
+--
+-- Haddocks are downloaded from the documentation bucket, where they were
+-- uploaded as a tar file.
+--
+-- Returns the path to the .hoo database.
 createHoogleDB :: SnapshotId -> SnapName -> RIO StackageCron (Maybe FilePath)
-createHoogleDB snapshotId snapName =
+createHoogleDB snapshotId snapName = do
-    -- FIXME: this handles *any* exception, which means it will swallow most
+    logInfo $ "Creating Hoogle DB for " <> display snapName
-    -- signals
+    downloadBucketUrl <- scDownloadBucketUrl <$> ask
-    handleAny logException $ do
+    let root = "hoogle-gen"
-        logInfo $ "Creating Hoogle DB for " <> display snapName
+        outname = root </> "output.hoo"
-        downloadBucketUrl <- scDownloadBucketUrl <$> ask
+        tarKey = toPathPiece snapName <> "/hoogle/orig.tar"
-        let root = "hoogle-gen"
+        tarUrl = downloadBucketUrl <> "/" <> tarKey
-            outname = root </> "output.hoo"
+        tarFP = root </> T.unpack tarKey
-            tarKey = toPathPiece snapName <> "/hoogle/orig.tar"
+    -- When tarball is downloaded it is saved with durability and atomicity, so if it
-            tarUrl = downloadBucketUrl <> "/" <> tarKey
+    -- is present it is not in a corrupted state
-            tarFP = root </> T.unpack tarKey
+    unlessM (doesFileExist tarFP) $ do
-        -- When tarball is downloaded it is saved with durability and atomicity, so if it
+        req <- parseRequest $ T.unpack tarUrl
-        -- is present it is not in a corrupted state
+        env <- asks scEnvAWS
-        unlessM (doesFileExist tarFP) $ do
+        let man = env ^. env_manager
-            req <- parseRequest $ T.unpack tarUrl
+        withResponseUnliftIO req {decompress = const True} man $ \res -> do
-            env <- asks scEnvAWS
+            throwErrorStatusCodes req res
-            let man = env ^. env_manager
+            createDirectoryIfMissing True $ takeDirectory tarFP
-            withResponseUnliftIO req {decompress = const True} man $ \res -> do
+            withBinaryFileDurableAtomic tarFP WriteMode $ \tarHandle ->
-                throwErrorStatusCodes req res
+                runConduitRes $ bodyReaderSource (responseBody res) .| sinkHandle tarHandle
-                createDirectoryIfMissing True $ takeDirectory tarFP
+    void $ tryIO $ removeFile outname
-                withBinaryFileDurableAtomic tarFP WriteMode $ \tarHandle ->
+    withSystemTempDirectory ("hoogle-" ++ T.unpack (textDisplay snapName)) $ \tmpdir -> do
-                    runConduitRes $ bodyReaderSource (responseBody res) .| sinkHandle tarHandle
+        Any hasRestored <-
-        void $ tryIO $ removeFile outname
+            runConduitRes $
-        withSystemTempDirectory ("hoogle-" ++ T.unpack (textDisplay snapName)) $ \tmpdir -> do
+            sourceFile tarFP .|
-            Any hasRestored <-
+            untar (restoreHoogleTxtFileWithCabal tmpdir snapshotId snapName) .|
-                runConduitRes $
+            foldMapC Any
-                sourceFile tarFP .|
+        unless hasRestored $ error "No Hoogle .txt files found"
-                untar (restoreHoogleTxtFileWithCabal tmpdir snapshotId snapName) .|
+        let args = ["generate", "--database=" ++ outname, "--local=" ++ tmpdir]
-                foldMapC Any
+        logInfo $
-            unless hasRestored $ error "No Hoogle .txt files found"
+            mconcat
-            let args = ["generate", "--database=" ++ outname, "--local=" ++ tmpdir]
+                [ "Merging databases... ("
-            logInfo $
+                , foldMap fromString $ L.intersperse " " ("hoogle" : args)
-                mconcat
+                , ")"
-                    [ "Merging databases... ("
+                ]
-                    , foldMap fromString $ L.intersperse " " ("hoogle" : args)
+        liftIO $ Hoogle.hoogle args
-                    , ")"
+        logInfo "Merge done"
-                    ]
+        return $ Just outname
-            liftIO $ Hoogle.hoogle args
-            logInfo "Merge done"
-            return $ Just outname
-  where
-    logException exc =
-        logError ("Problem creating hoogle db for " <> display snapName <> ": " <> displayShow exc) $>
-        Nothing
 
 
 -- | Grabs hoogle txt file from the tarball and a matching cabal file from pantry.  Writes