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

Make sure compressor is run during idle times too

Browse Source
This commit is contained in:
Michael Snoyman 2015-01-05 10:40:24 +02:00
parent 52aece6557
commit 3fc4609210
1 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Data/Unpacking.hs
View File

@ -98,7 +98,12 @@ unpackWorker
-> TChan (Bool, Entity Stackage, TVar UnpackStatus) -> TChan (Bool, Entity Stackage, TVar UnpackStatus)
-> IO () -> IO ()
unpackWorker dirs runDB store messageVar workChan = do unpackWorker dirs runDB store messageVar workChan = do
atomically $ writeTVar messageVar "Waiting for new work item" let say' = atomically . writeTVar messageVar
say' "Running the compressor"
let shouldStop = fmap not $ atomically $ isEmptyTChan workChan
handleAny print $ runCompressor shouldStop say' dirs
say' "Waiting for new work item"
(forceUnpack, ent, resVar) <- atomically $ readTChan workChan (forceUnpack, ent, resVar) <- atomically $ readTChan workChan
shouldUnpack <- shouldUnpack <-
if forceUnpack if forceUnpack
@ -122,10 +127,6 @@ unpackWorker dirs runDB store messageVar workChan = do
Left e -> USFailed $ tshow e Left e -> USFailed $ tshow e
Right () -> USReady Right () -> USReady
say "Running the compressor"
let shouldStop = fmap not $ atomically $ isEmptyTChan workChan
runCompressor shouldStop say dirs
removeTreeIfExists :: FilePath -> IO () removeTreeIfExists :: FilePath -> IO ()
removeTreeIfExists fp = whenM (isDirectory fp) (removeTree fp) removeTreeIfExists fp = whenM (isDirectory fp) (removeTree fp)