aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-01-25 18:03:56 +0000
committerGregor Kleen <gkleen@yggdrasil.li>2016-01-25 18:03:56 +0000
commitfb76cda22eb5d778c6f274f3129efa705c78db16 (patch)
tree568b19c7778fb612c196ad60b66ddaf19ce4bce1
parent5978ff72f2a374e991bef098555325dd95a9f509 (diff)
downloadthermoprint-fb76cda22eb5d778c6f274f3129efa705c78db16.tar
thermoprint-fb76cda22eb5d778c6f274f3129efa705c78db16.tar.gz
thermoprint-fb76cda22eb5d778c6f274f3129efa705c78db16.tar.bz2
thermoprint-fb76cda22eb5d778c6f274f3129efa705c78db16.tar.xz
thermoprint-fb76cda22eb5d778c6f274f3129efa705c78db16.zip
abortJob
-rw-r--r--server/src/Thermoprint/Server/API.hs13
1 files 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)
46import Data.Bifunctor 46import Data.Bifunctor
47import Data.Monoid 47import Data.Monoid
48import Data.Maybe 48import Data.Maybe
49import Data.Function (on)
49 50
50import Database.Persist 51import Database.Persist
51import Database.Persist.Sql 52import Database.Persist.Sql
@@ -141,12 +142,14 @@ jobStatus jobId = maybe (left err404) return . lookup jobId . toList =<< listJob
141abortJob :: API.JobId -> Handler () 142abortJob :: API.JobId -> Handler ()
142abortJob jobId = do 143abortJob jobId = do
143 printerIds <- asks (Map.keys . printers) 144 printerIds <- asks (Map.keys . printers)
144 forM_ printerIds $ \pId -> do 145 found <- fmap or . forM printerIds $ \pId -> do
145 (pId', p) <- lookupPrinter $ Just pId 146 (pId', p) <- lookupPrinter $ Just pId
146 found <- liftIO . atomically $ do 147 liftIO . atomically $ do
147 current <- readTVar $ queue p 148 current@(Queue pending _ _) <- readTVar $ queue p
148 modifyTVar' (queue p) $ force . (\q@(Queue pending _ _) -> q { pending = Seq.filter (/= castId jobId) pending }) 149 let filtered = Seq.filter (/= castId jobId) pending
149 undefined 150 writeTVar (queue p) $ current { pending = filtered }
151 return $ ((==) `on` length) pending filtered
152 when (not found) $ left err404
150 153
151listDrafts :: Handler (Map API.DraftId (Maybe DraftTitle)) 154listDrafts :: Handler (Map API.DraftId (Maybe DraftTitle))
152listDrafts = return undefined 155listDrafts = return undefined