diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-03-01 09:57:25 +0100 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-03-01 09:57:25 +0100 |
commit | c2153f196c64593a252bc0fbbc3d503628fe896f (patch) | |
tree | e2218871dc70a304cd37f26c895d524f0cc6456f /tprint/src/Main.hs | |
parent | aeceaafdab661f6e0d63ef9695396bc7dfb8619d (diff) | |
download | thermoprint-c2153f196c64593a252bc0fbbc3d503628fe896f.tar thermoprint-c2153f196c64593a252bc0fbbc3d503628fe896f.tar.gz thermoprint-c2153f196c64593a252bc0fbbc3d503628fe896f.tar.bz2 thermoprint-c2153f196c64593a252bc0fbbc3d503628fe896f.tar.xz thermoprint-c2153f196c64593a252bc0fbbc3d503628fe896f.zip |
printers
Diffstat (limited to 'tprint/src/Main.hs')
-rw-r--r-- | tprint/src/Main.hs | 27 |
1 files changed, 23 insertions, 4 deletions
diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs index cd6e68b..a937181 100644 --- a/tprint/src/Main.hs +++ b/tprint/src/Main.hs | |||
@@ -1,4 +1,5 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | 1 | {-# LANGUAGE RecordWildCards #-} |
2 | {-# LANGUAGE ViewPatterns #-} | ||
2 | 3 | ||
3 | import Data.Map (Map) | 4 | import Data.Map (Map) |
4 | import qualified Data.Map as Map | 5 | import qualified Data.Map as Map |
@@ -6,10 +7,15 @@ import Data.Sequence (Seq) | |||
6 | import qualified Data.Sequence as Seq | 7 | import qualified Data.Sequence as Seq |
7 | import Data.Text (Text) | 8 | import Data.Text (Text) |
8 | import qualified Data.Text as T | 9 | import qualified Data.Text as T |
10 | import qualified Data.ByteString.Lazy.Char8 as Lazy (ByteString) | ||
11 | import qualified Data.ByteString.Lazy.Char8 as LCBS | ||
12 | |||
13 | import Control.Monad | ||
9 | 14 | ||
10 | import Control.Monad | 15 | import Control.Monad |
11 | 16 | ||
12 | import Text.Show.Pretty (dumpStr) | 17 | import Text.Show.Pretty (dumpStr) |
18 | import Data.Aeson.Encode.Pretty (encodePretty) | ||
13 | 19 | ||
14 | import System.IO | 20 | import System.IO |
15 | 21 | ||
@@ -19,9 +25,22 @@ import Options | |||
19 | import Debug.Trace | 25 | import Debug.Trace |
20 | 26 | ||
21 | main :: IO () | 27 | main :: IO () |
22 | main = withArgs (tprint <=< dumpOpts) | 28 | main = withArgs (main' <=< dumpOpts) |
23 | where | 29 | where |
24 | dumpOpts c@(TPrint{..}) = c <$ when (dumpOptions) (hPutStrLn stderr $ dumpStr c) | 30 | dumpOpts c@(TPrint{..}) = c <$ when (dumpOptions) (hPutStrLn stderr $ dumpStr c) |
25 | 31 | main' config@(TPrint{..}) = withOutput config $ tprint config (mkClient' baseUrl) | |
26 | tprint :: TPrint -> IO () | 32 | |
27 | tprint = undefined | 33 | withOutput :: TPrint -> (Handle -> IO a) -> IO a |
34 | withOutput TPrint{..} a | ||
35 | | (_, WriteFile f) <- output = withFile f WriteMode a | ||
36 | | otherwise = a stdout | ||
37 | |||
38 | tprint :: TPrint -> Client IO -> Handle -> IO () | ||
39 | tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format | ||
40 | where format ps | ||
41 | | (Human, _) <- output = mapM_ (\(PrinterId n, st) -> hPutStrLn out $ show n ++ "\t" ++ humanStatus st) $ Map.toAscList ps | ||
42 | | (JSON , _) <- output = LCBS.hPutStrLn out $ encodePretty ps | ||
43 | | otherwise = hPutStrLn out . dumpStr $ Map.toAscList ps | ||
44 | humanStatus (Busy (JobId n)) = "busy printing job #" ++ show n | ||
45 | humanStatus (Available) = "available" | ||
46 | tprint _ _ _ = undefined | ||