aboutsummaryrefslogtreecommitdiff
path: root/server/src/Thermoprint/Server/API.hs
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-01-25 17:50:00 +0000
committerGregor Kleen <gkleen@yggdrasil.li>2016-01-25 17:50:00 +0000
commit6e2883f57decbdcc8cbfefb8cdd9b118212811d5 (patch)
tree27c3a0ff1ef9287fa36a1edb004adfd18ac7c412 /server/src/Thermoprint/Server/API.hs
parent9d9bad89241bfa14255361dd8452ad40291a9684 (diff)
downloadthermoprint-6e2883f57decbdcc8cbfefb8cdd9b118212811d5.tar
thermoprint-6e2883f57decbdcc8cbfefb8cdd9b118212811d5.tar.gz
thermoprint-6e2883f57decbdcc8cbfefb8cdd9b118212811d5.tar.bz2
thermoprint-6e2883f57decbdcc8cbfefb8cdd9b118212811d5.tar.xz
thermoprint-6e2883f57decbdcc8cbfefb8cdd9b118212811d5.zip
cleaned up castId
Diffstat (limited to 'server/src/Thermoprint/Server/API.hs')
-rw-r--r--server/src/Thermoprint/Server/API.hs22
1 files changed, 9 insertions, 13 deletions
diff --git a/server/src/Thermoprint/Server/API.hs b/server/src/Thermoprint/Server/API.hs
index 9e28d58..66a594b 100644
--- a/server/src/Thermoprint/Server/API.hs
+++ b/server/src/Thermoprint/Server/API.hs
@@ -106,14 +106,10 @@ queue' = fmap force . liftIO . readTVarIO . queue
106 106
107extractJobs :: (PrinterId, Queue) -> Seq (API.JobId, JobStatus) 107extractJobs :: (PrinterId, Queue) -> Seq (API.JobId, JobStatus)
108-- ^ Get an API-compatible list of all jobs from a 'Printer' 'Queue' 108-- ^ Get an API-compatible list of all jobs from a 'Printer' 'Queue'
109extractJobs (pId, Queue pending current history) = mconcat [ fmap (, Queued pId) pending' 109extractJobs (pId, Queue pending current history) = mconcat [ fmap ((, Queued pId) . castId) pending
110 , maybe Seq.empty Seq.singleton (fmap (, Printing pId) current') 110 , maybe Seq.empty Seq.singleton $ fmap ((, Printing pId) . castId) current
111 , fmap (second $ maybe Done Failed) history' 111 , fmap (bimap castId $ maybe Done Failed) history
112 ] 112 ]
113 where
114 pending' = fmap (castId' . unJobKey) pending
115 current' = fmap (castId' . unJobKey) current
116 history' = fmap (first $ castId' . unJobKey) history
117 113
118listPrinters :: Handler (Map PrinterId PrinterStatus) 114listPrinters :: Handler (Map PrinterId PrinterStatus)
119listPrinters = fmap toStatus <$> (mapM (liftIO . readTVarIO . queue) . printers =<< ask) 115listPrinters = fmap toStatus <$> (mapM (liftIO . readTVarIO . queue) . printers =<< ask)
@@ -122,13 +118,13 @@ listPrinters = fmap toStatus <$> (mapM (liftIO . readTVarIO . queue) . printers
122 toStatus (Queue _ (Just id) _) = Busy . castId $ fromSqlKey id 118 toStatus (Queue _ (Just id) _) = Busy . castId $ fromSqlKey id
123 119
124queueJob :: Maybe PrinterId -> Printout -> Handler API.JobId 120queueJob :: Maybe PrinterId -> Printout -> Handler API.JobId
125queueJob pId printout = lift . fmap (castId' . unJobKey) . withReaderT sqlPool . addToQueue printout . snd =<< lookupPrinter pId 121queueJob pId printout = lift . fmap castId . withReaderT sqlPool . addToQueue printout . snd =<< lookupPrinter pId
126 122
127printerStatus :: PrinterId -> Handler PrinterStatus 123printerStatus :: PrinterId -> Handler PrinterStatus
128printerStatus = fmap queueToStatus . queue' . snd <=< lookupPrinter . Just 124printerStatus = fmap queueToStatus . queue' . snd <=< lookupPrinter . Just
129 where 125 where
130 queueToStatus (Queue _ Nothing _) = Available 126 queueToStatus (Queue _ Nothing _) = Available
131 queueToStatus (Queue _ (Just id) _) = Busy . castId' $ unJobKey id 127 queueToStatus (Queue _ (Just id) _) = Busy $ castId id
132 128
133listJobs :: Maybe PrinterId -> Maybe API.JobId -> Maybe API.JobId -> Handler (Seq (API.JobId, JobStatus)) 129listJobs :: Maybe PrinterId -> Maybe API.JobId -> Maybe API.JobId -> Handler (Seq (API.JobId, JobStatus))
134listJobs Nothing minId maxId = fmap mconcat . mapM (\pId -> listJobs (Just pId) minId maxId) =<< asks (Map.keys . printers) 130listJobs Nothing minId maxId = fmap mconcat . mapM (\pId -> listJobs (Just pId) minId maxId) =<< asks (Map.keys . printers)
@@ -137,7 +133,7 @@ listJobs pId minId maxId = fmap (filterJobs . extractJobs) . (\(a, b) -> (,)
137 filterJobs = Seq.filter (\(id, _) -> maybe True (< id) minId && maybe True (> id) maxId) 133 filterJobs = Seq.filter (\(id, _) -> maybe True (< id) minId && maybe True (> id) maxId)
138 134
139getJob :: API.JobId -> Handler Printout 135getJob :: API.JobId -> Handler Printout
140getJob jobId = fmap jobContent . maybe (left err404) return =<< runSqlPool (get . JobKey . SqlBackendKey $ castId jobId) =<< asks sqlPool 136getJob jobId = fmap jobContent . maybe (left err404) return =<< runSqlPool (get $ castId jobId) =<< asks sqlPool
141 137
142jobStatus :: API.JobId -> Handler JobStatus 138jobStatus :: API.JobId -> Handler JobStatus
143jobStatus jobId = maybe (left err404) return . lookup jobId . toList =<< listJobs Nothing Nothing Nothing 139jobStatus jobId = maybe (left err404) return . lookup jobId . toList =<< listJobs Nothing Nothing Nothing
@@ -147,10 +143,10 @@ deleteJob jobId = do
147 printerIds <- asks (Map.keys . printers) 143 printerIds <- asks (Map.keys . printers)
148 forM_ printerIds $ \pId -> do 144 forM_ printerIds $ \pId -> do
149 (pId', p) <- lookupPrinter $ Just pId 145 (pId', p) <- lookupPrinter $ Just pId
150 -- liftIO . atomically . modifyTVar' (queue p) $ force . removeNeedle 146 found <- liftIO . atomically $ do
147 current <- readTVar $ queue p
148 modifyTVar' (queue p) $ force . (\q@(Queue pending _ _) -> q { pending = Seq.filter (/= castId jobId) pending })
151 undefined 149 undefined
152 where
153 needle = JobKey . SqlBackendKey $ castId jobId
154 150
155listDrafts :: Handler (Map API.DraftId (Maybe DraftTitle)) 151listDrafts :: Handler (Map API.DraftId (Maybe DraftTitle))
156listDrafts = return undefined 152listDrafts = return undefined