make sure we get our queues strictly

1 files changed, 7 insertions, 2 deletions

diff --git a/server/src/Thermoprint/Server/API.hs b/server/src/Thermoprint/Server/API.hs
index 2aa9cb8..1bbefb1 100644
--- a/server/src/Thermoprint/Server/API.hs
+++ b/server/src/Thermoprint/Server/API.hs
@@ -39,6 +39,8 @@ import Control.Monad ((<=<), liftM2)
 import Prelude hiding ((.), id, mapM)
 import Control.Category
 
+import Control.DeepSeq
+
 import Data.Foldable (toList)
 import Data.Traversable (mapM)
 import Data.Bifunctor
@@ -100,11 +102,14 @@ lookupPrinter pId = asks printers >>= maybePrinter' pId
 
 queue' :: MonadIO m => Printer -> m Queue
 -- ^ Call 'queue' and handle concurrency
-queue' = liftIO . readTVarIO . queue
+queue' = fmap force . liftIO . readTVarIO . queue
 
 extractJobs :: (PrinterId, Queue) -> Seq (API.JobId, JobStatus)
 -- ^ Get an API-compatible list of all jobs from a 'Printer' 'Queue'
-extractJobs (pId, Queue pending current history) = fmap (, Queued pId) pending' <> maybe Seq.empty Seq.singleton (fmap (, Printing pId) current') <> fmap (second $ maybe Done Failed) history'
+extractJobs (pId, Queue pending current history) = mconcat [ fmap (, Queued pId) pending'
+                                                           , maybe Seq.empty Seq.singleton (fmap (, Printing pId) current')
+                                                           , fmap (second $ maybe Done Failed) history'
+                                                           ]
   where
     pending' = fmap (castId' . unJobKey) pending
     current' = fmap (castId' . unJobKey) current