diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-25 17:50:00 +0000 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-25 17:50:00 +0000 |
| commit | 6e2883f57decbdcc8cbfefb8cdd9b118212811d5 (patch) | |
| tree | 27c3a0ff1ef9287fa36a1edb004adfd18ac7c412 /server/src/Thermoprint/Server/API.hs | |
| parent | 9d9bad89241bfa14255361dd8452ad40291a9684 (diff) | |
| download | thermoprint-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.hs | 22 |
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 | ||
| 107 | extractJobs :: (PrinterId, Queue) -> Seq (API.JobId, JobStatus) | 107 | extractJobs :: (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' |
| 109 | extractJobs (pId, Queue pending current history) = mconcat [ fmap (, Queued pId) pending' | 109 | extractJobs (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 | ||
| 118 | listPrinters :: Handler (Map PrinterId PrinterStatus) | 114 | listPrinters :: Handler (Map PrinterId PrinterStatus) |
| 119 | listPrinters = fmap toStatus <$> (mapM (liftIO . readTVarIO . queue) . printers =<< ask) | 115 | listPrinters = 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 | ||
| 124 | queueJob :: Maybe PrinterId -> Printout -> Handler API.JobId | 120 | queueJob :: Maybe PrinterId -> Printout -> Handler API.JobId |
| 125 | queueJob pId printout = lift . fmap (castId' . unJobKey) . withReaderT sqlPool . addToQueue printout . snd =<< lookupPrinter pId | 121 | queueJob pId printout = lift . fmap castId . withReaderT sqlPool . addToQueue printout . snd =<< lookupPrinter pId |
| 126 | 122 | ||
| 127 | printerStatus :: PrinterId -> Handler PrinterStatus | 123 | printerStatus :: PrinterId -> Handler PrinterStatus |
| 128 | printerStatus = fmap queueToStatus . queue' . snd <=< lookupPrinter . Just | 124 | printerStatus = 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 | ||
| 133 | listJobs :: Maybe PrinterId -> Maybe API.JobId -> Maybe API.JobId -> Handler (Seq (API.JobId, JobStatus)) | 129 | listJobs :: Maybe PrinterId -> Maybe API.JobId -> Maybe API.JobId -> Handler (Seq (API.JobId, JobStatus)) |
| 134 | listJobs Nothing minId maxId = fmap mconcat . mapM (\pId -> listJobs (Just pId) minId maxId) =<< asks (Map.keys . printers) | 130 | listJobs 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 | ||
| 139 | getJob :: API.JobId -> Handler Printout | 135 | getJob :: API.JobId -> Handler Printout |
| 140 | getJob jobId = fmap jobContent . maybe (left err404) return =<< runSqlPool (get . JobKey . SqlBackendKey $ castId jobId) =<< asks sqlPool | 136 | getJob jobId = fmap jobContent . maybe (left err404) return =<< runSqlPool (get $ castId jobId) =<< asks sqlPool |
| 141 | 137 | ||
| 142 | jobStatus :: API.JobId -> Handler JobStatus | 138 | jobStatus :: API.JobId -> Handler JobStatus |
| 143 | jobStatus jobId = maybe (left err404) return . lookup jobId . toList =<< listJobs Nothing Nothing Nothing | 139 | jobStatus 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 | ||
| 155 | listDrafts :: Handler (Map API.DraftId (Maybe DraftTitle)) | 151 | listDrafts :: Handler (Map API.DraftId (Maybe DraftTitle)) |
| 156 | listDrafts = return undefined | 152 | listDrafts = return undefined |
