diff options
Diffstat (limited to 'server')
-rw-r--r-- | server/src/Thermoprint/Server/API.hs | 3 |
1 files changed, 3 insertions, 0 deletions
diff --git a/server/src/Thermoprint/Server/API.hs b/server/src/Thermoprint/Server/API.hs index bff8eed..2aa9cb8 100644 --- a/server/src/Thermoprint/Server/API.hs +++ b/server/src/Thermoprint/Server/API.hs | |||
@@ -88,6 +88,7 @@ thermoprintServer = listPrinters | |||
88 | infixr 9 <||> | 88 | infixr 9 <||> |
89 | 89 | ||
90 | lookupPrinter :: Maybe PrinterId -> Handler (PrinterId, Printer) | 90 | lookupPrinter :: Maybe PrinterId -> Handler (PrinterId, Printer) |
91 | -- ^ Make sure a printer exists | ||
91 | lookupPrinter pId = asks printers >>= maybePrinter' pId | 92 | lookupPrinter pId = asks printers >>= maybePrinter' pId |
92 | where | 93 | where |
93 | maybePrinter' Nothing printerMap | 94 | maybePrinter' Nothing printerMap |
@@ -98,9 +99,11 @@ lookupPrinter pId = asks printers >>= maybePrinter' pId | |||
98 | | otherwise = left $ err404 { errBody = "No such printer" } | 99 | | otherwise = left $ err404 { errBody = "No such printer" } |
99 | 100 | ||
100 | queue' :: MonadIO m => Printer -> m Queue | 101 | queue' :: MonadIO m => Printer -> m Queue |
102 | -- ^ Call 'queue' and handle concurrency | ||
101 | queue' = liftIO . readTVarIO . queue | 103 | queue' = liftIO . readTVarIO . queue |
102 | 104 | ||
103 | extractJobs :: (PrinterId, Queue) -> Seq (API.JobId, JobStatus) | 105 | extractJobs :: (PrinterId, Queue) -> Seq (API.JobId, JobStatus) |
106 | -- ^ Get an API-compatible list of all jobs from a 'Printer' 'Queue' | ||
104 | 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' | 107 | 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' |
105 | where | 108 | where |
106 | pending' = fmap (castId' . unJobKey) pending | 109 | pending' = fmap (castId' . unJobKey) pending |