haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-12 04:08:29 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Better compressor-status termination messages

Browse Source
This commit is contained in:
Michael Snoyman 2014-11-18 18:37:20 +02:00
parent cce7fb3ddf
commit 894f428a5b
1 changed files with 7 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Handler/Haddock.hs
View File

@ -94,13 +94,19 @@ createCompressor
createCompressor dirs = do
baton <- newMVar ()
status <- newIORef "Compressor is idle"
mask_ $ void $ forkIO $ (`finally` writeIORef status "Compressor thread exited") $ forever $ do
mask_ $ void $ forkIO $ (finallyE $ \e -> writeIORef status $ "Compressor thread exited: " ++ tshow e) $ forever $ do
writeIORef status "Waiting for signal to start compressing"
takeMVar baton
writeIORef status "Received signal, traversing directories"
runResourceT $ goDir status (dirRawRoot dirs)
return (status, void $ tryPutMVar baton ())
where
finallyE f g = mask $ \restore -> do
restore g `catch` \e -> do
() <- f $ Just (e :: SomeException)
() <- throwIO e
return ()
f Nothing
goDir status dir = do
writeIORef status $ "Compressing directory: " ++ fpToText dir
sourceDirectory dir $$ mapM_C (goFP status)