From 3fc4609210dd8b071c4ad07ece0f15456a437b1f Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 5 Jan 2015 10:40:24 +0200 Subject: [PATCH] Make sure compressor is run during idle times too --- Data/Unpacking.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/Data/Unpacking.hs b/Data/Unpacking.hs index 57721a5..aa49135 100644 --- a/Data/Unpacking.hs +++ b/Data/Unpacking.hs @@ -98,7 +98,12 @@ unpackWorker -> TChan (Bool, Entity Stackage, TVar UnpackStatus) -> IO () 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 shouldUnpack <- if forceUnpack @@ -122,10 +127,6 @@ unpackWorker dirs runDB store messageVar workChan = do Left e -> USFailed $ tshow e Right () -> USReady - say "Running the compressor" - let shouldStop = fmap not $ atomically $ isEmptyTChan workChan - runCompressor shouldStop say dirs - removeTreeIfExists :: FilePath -> IO () removeTreeIfExists fp = whenM (isDirectory fp) (removeTree fp)