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 /tprint/src/Main.hs | |
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
Diffstat (limited to 'tprint/src/Main.hs')
-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 |