diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-02-05 17:51:49 +0100 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-02-05 17:51:49 +0100 |
| commit | 04f1276cb0e7f95056ebb1c336b4b1debdd397da (patch) | |
| tree | 0a858472208824083d1fc5691511fd4c9c94d4df /server/src | |
| parent | 8ed465db831a534958c05c2670f618fbcef7af38 (diff) | |
| download | thermoprint-04f1276cb0e7f95056ebb1c336b4b1debdd397da.tar thermoprint-04f1276cb0e7f95056ebb1c336b4b1debdd397da.tar.gz thermoprint-04f1276cb0e7f95056ebb1c336b4b1debdd397da.tar.bz2 thermoprint-04f1276cb0e7f95056ebb1c336b4b1debdd397da.tar.xz thermoprint-04f1276cb0e7f95056ebb1c336b4b1debdd397da.zip | |
strict queue management
Diffstat (limited to 'server/src')
| -rw-r--r-- | server/src/Thermoprint/Server/Queue.hs | 4 |
1 files changed, 2 insertions, 2 deletions
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 | |||
| 26 | import Data.ExtendedReal | 26 | import Data.ExtendedReal |
| 27 | import Data.Fixed | 27 | import Data.Fixed |
| 28 | 28 | ||
| 29 | import Control.DeepSeq (NFData) | 29 | import Control.DeepSeq |
| 30 | import Data.Typeable (Typeable) | 30 | import Data.Typeable (Typeable) |
| 31 | import GHC.Generics (Generic) | 31 | import GHC.Generics (Generic) |
| 32 | 32 | ||
| @@ -133,7 +133,7 @@ runQM :: ( HasQueue q | |||
| 133 | -- ^ Periodically modify a 'Queue' | 133 | -- ^ Periodically modify a 'Queue' |
| 134 | runQM qm (extractQueue -> q) = sleep =<< qm' | 134 | runQM qm (extractQueue -> q) = sleep =<< qm' |
| 135 | where | 135 | where |
| 136 | qm' = hoist atomically $ (\(a, s) -> lift (writeTVar q s) >> return a) =<< runStateT (getComposeT qm) =<< lift (readTVar q) | 136 | qm' = hoist atomically $ (\(a, s) -> lift (writeTVar q $!! s) >> return a) =<< runStateT (getComposeT qm) =<< lift (readTVar q) |
| 137 | sleep (abs -> delay) | 137 | sleep (abs -> delay) |
| 138 | | (Finite d) <- delay = liftIO (threadDelay $ fromEnum d) >> runQM qm q | 138 | | (Finite d) <- delay = liftIO (threadDelay $ fromEnum d) >> runQM qm q |
| 139 | | otherwise = return () | 139 | | otherwise = return () |