diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-03-01 10:34:13 +0100 | 
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-03-01 10:34:13 +0100 | 
| commit | a6d63bdae8ca93f07724a9b100a5bd2094ad6971 (patch) | |
| tree | ae958440c66fa2b2b46c358f068652578b45877a | |
| parent | 1774f95a5c658cea2850e54c7cb164f4ad62e58d (diff) | |
| download | thermoprint-a6d63bdae8ca93f07724a9b100a5bd2094ad6971.tar thermoprint-a6d63bdae8ca93f07724a9b100a5bd2094ad6971.tar.gz thermoprint-a6d63bdae8ca93f07724a9b100a5bd2094ad6971.tar.bz2 thermoprint-a6d63bdae8ca93f07724a9b100a5bd2094ad6971.tar.xz thermoprint-a6d63bdae8ca93f07724a9b100a5bd2094ad6971.zip | |
cleanup anticipating jobStatus
| -rw-r--r-- | tprint/src/Main.hs | 26 | 
1 files changed, 16 insertions, 10 deletions
| diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs index f0f0186..971e655 100644 --- a/tprint/src/Main.hs +++ b/tprint/src/Main.hs | |||
| @@ -39,9 +39,21 @@ main = withArgs (main' <=< dumpOpts) | |||
| 39 | main' config@(TPrint{..}) = withOutput config $ tprint config (mkClient' baseUrl) | 39 | main' config@(TPrint{..}) = withOutput config $ tprint config (mkClient' baseUrl) | 
| 40 | 40 | ||
| 41 | withOutput :: TPrint -> (Handle -> IO a) -> IO a | 41 | withOutput :: TPrint -> (Handle -> IO a) -> IO a | 
| 42 | withOutput TPrint{..} a | 42 | withOutput TPrint{..} | 
| 43 | | (_, WriteFile f) <- output = withFile f WriteMode a | 43 | | (_, WriteFile f) <- output = withFile f WriteMode | 
| 44 | | otherwise = a stdout | 44 | | otherwise = ($ stdout) | 
| 45 | |||
| 46 | withInput :: Input -> (Handle -> IO a) -> IO a | ||
| 47 | withInput (_, Stdin) = ($ stdin) | ||
| 48 | withInput (_, ReadFile f) = withFile f ReadMode | ||
| 49 | |||
| 50 | humanJobStatus :: JobStatus -> Maybe (Range PrinterId) -> String | ||
| 51 | humanJobStatus (Queued (PrinterId n)) Nothing = "queued at printer #" ++ show n | ||
| 52 | humanJobStatus (Queued _) _ = "queued" | ||
| 53 | humanJobStatus (Printing (PrinterId n)) Nothing = "printing on printer #" ++ show n | ||
| 54 | humanJobStatus (Printing _) _ = "printing" | ||
| 55 | humanJobStatus (Done) _ = "finished successfully" | ||
| 56 | humanJobStatus (Failed err) _ = "failed: " ++ show err | ||
| 45 | 57 | ||
| 46 | tprint :: TPrint -> Client IO -> Handle -> IO () | 58 | tprint :: TPrint -> Client IO -> Handle -> IO () | 
| 47 | 59 | ||
| @@ -55,16 +67,10 @@ tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format | |||
| 55 | 67 | ||
| 56 | tprint TPrint{ operation = Jobs{..}, ..} Client{..} out = jobs printer jobRange timeRange >>= format | 68 | tprint TPrint{ operation = Jobs{..}, ..} Client{..} out = jobs printer jobRange timeRange >>= format | 
| 57 | where format js | 69 | where format js | 
| 58 | | (Human, _) <- output = mapM_ (\((JobId n), created, status) -> hPutStrLn out $ show n ++ "\t" ++ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S %Z" created ++ "\t" ++ humanStatus status printer) . sortBy jSort $ toList js | 70 | | (Human, _) <- output = mapM_ (\((JobId n), created, status) -> hPutStrLn out $ show n ++ "\t" ++ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S %Z" created ++ "\t" ++ humanJobStatus status printer) . sortBy jSort $ toList js | 
| 59 | | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty js | 71 | | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty js | 
| 60 | | otherwise = hPutStrLn out . dumpStr $ toList js | 72 | | otherwise = hPutStrLn out . dumpStr $ toList js | 
| 61 | jSort (id, time, status) (id', time', status') = queueSort status status' <> compare time' time <> compare id id' | 73 | jSort (id, time, status) (id', time', status') = queueSort status status' <> compare time' time <> compare id id' | 
| 62 | humanStatus (Queued (PrinterId n)) Nothing = "queued at printer #" ++ show n | ||
| 63 | humanStatus (Queued _) _ = "queued" | ||
| 64 | humanStatus (Printing (PrinterId n)) Nothing = "printing on printer #" ++ show n | ||
| 65 | humanStatus (Printing _) _ = "printing" | ||
| 66 | humanStatus (Done) _ = "finished successfully" | ||
| 67 | humanStatus (Failed err) _ = "failed: " ++ show err | ||
| 68 | 74 | ||
| 69 | tprint TPrint{ operation = Drafts, ..} Client{..} out = drafts >>= format | 75 | tprint TPrint{ operation = Drafts, ..} Client{..} out = drafts >>= format | 
| 70 | where format ds | 76 | where format ds | 
