From fb76cda22eb5d778c6f274f3129efa705c78db16 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 25 Jan 2016 18:03:56 +0000 Subject: abortJob --- server/src/Thermoprint/Server/API.hs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/server/src/Thermoprint/Server/API.hs b/server/src/Thermoprint/Server/API.hs index 5fbb18e..44b8402 100644 --- a/server/src/Thermoprint/Server/API.hs +++ b/server/src/Thermoprint/Server/API.hs @@ -46,6 +46,7 @@ import Data.Traversable (mapM) import Data.Bifunctor import Data.Monoid import Data.Maybe +import Data.Function (on) import Database.Persist import Database.Persist.Sql @@ -141,12 +142,14 @@ jobStatus jobId = maybe (left err404) return . lookup jobId . toList =<< listJob abortJob :: API.JobId -> Handler () abortJob jobId = do printerIds <- asks (Map.keys . printers) - forM_ printerIds $ \pId -> do + found <- fmap or . forM printerIds $ \pId -> do (pId', p) <- lookupPrinter $ Just pId - found <- liftIO . atomically $ do - current <- readTVar $ queue p - modifyTVar' (queue p) $ force . (\q@(Queue pending _ _) -> q { pending = Seq.filter (/= castId jobId) pending }) - undefined + liftIO . atomically $ do + current@(Queue pending _ _) <- readTVar $ queue p + let filtered = Seq.filter (/= castId jobId) pending + writeTVar (queue p) $ current { pending = filtered } + return $ ((==) `on` length) pending filtered + when (not found) $ left err404 listDrafts :: Handler (Map API.DraftId (Maybe DraftTitle)) listDrafts = return undefined -- cgit v1.2.3