From 04f1276cb0e7f95056ebb1c336b4b1debdd397da Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 5 Feb 2016 17:51:49 +0100 Subject: strict queue management --- server/src/Thermoprint/Server/Queue.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'server/src') diff --git a/server/src/Thermoprint/Server/Queue.hs b/server/src/Thermoprint/Server/Queue.hs index 3c7cce6..a93498e 100644 --- a/server/src/Thermoprint/Server/Queue.hs +++ b/server/src/Thermoprint/Server/Queue.hs @@ -26,7 +26,7 @@ import Data.Time import Data.ExtendedReal import Data.Fixed -import Control.DeepSeq (NFData) +import Control.DeepSeq import Data.Typeable (Typeable) import GHC.Generics (Generic) @@ -133,7 +133,7 @@ runQM :: ( HasQueue q -- ^ Periodically modify a 'Queue' runQM qm (extractQueue -> q) = sleep =<< qm' where - qm' = hoist atomically $ (\(a, s) -> lift (writeTVar q s) >> return a) =<< runStateT (getComposeT qm) =<< lift (readTVar q) + qm' = hoist atomically $ (\(a, s) -> lift (writeTVar q $!! s) >> return a) =<< runStateT (getComposeT qm) =<< lift (readTVar q) sleep (abs -> delay) | (Finite d) <- delay = liftIO (threadDelay $ fromEnum d) >> runQM qm q | otherwise = return () -- cgit v1.2.3