diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-03-01 11:13:47 +0100 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-03-01 11:13:47 +0100 |
commit | 368df582c97597e51ecd0bc8a8b51c41cc233778 (patch) | |
tree | ea202bdc6ef9c1336e346db324db7f67bf6524ee | |
parent | 06f2c2cc635b3598e060cb2fd88b95fc0f4c34b1 (diff) | |
download | thermoprint-368df582c97597e51ecd0bc8a8b51c41cc233778.tar thermoprint-368df582c97597e51ecd0bc8a8b51c41cc233778.tar.gz thermoprint-368df582c97597e51ecd0bc8a8b51c41cc233778.tar.bz2 thermoprint-368df582c97597e51ecd0bc8a8b51c41cc233778.tar.xz thermoprint-368df582c97597e51ecd0bc8a8b51c41cc233778.zip |
draftCreate && reporting of jobIds
-rw-r--r-- | tprint/src/Main.hs | 24 |
1 files changed, 17 insertions, 7 deletions
diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs index f78349e..71bbb2f 100644 --- a/tprint/src/Main.hs +++ b/tprint/src/Main.hs | |||
@@ -59,17 +59,18 @@ humanJobStatus (Printing _) _ = "printing" | |||
59 | humanJobStatus (Done) _ = "finished successfully" | 59 | humanJobStatus (Done) _ = "finished successfully" |
60 | humanJobStatus (Failed err) _ = "failed: " ++ show err | 60 | humanJobStatus (Failed err) _ = "failed: " ++ show err |
61 | 61 | ||
62 | blockLoop :: Client IO -> JobId -> IO () | 62 | blockLoop :: Client IO -> Handle -> JobId -> IO () |
63 | blockLoop client@Client{..} jId = do | 63 | blockLoop client@Client{..} out jId@(JobId n) = do |
64 | threadDelay (10^6) | 64 | threadDelay (10^6) |
65 | status <- jobStatus jId | 65 | status <- jobStatus jId |
66 | case status of | 66 | case status of |
67 | Done -> return () | 67 | Done -> hPutStrLn out $ show n |
68 | Failed err -> throwM err | 68 | Failed err -> throwM err |
69 | _ -> blockLoop client jId | 69 | _ -> blockLoop client out jId |
70 | 70 | ||
71 | tprint :: TPrint -> Client IO -> Handle -> IO () | 71 | tprint :: TPrint -> Client IO -> Handle -> IO () |
72 | 72 | ||
73 | -- Query | ||
73 | tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format | 74 | tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format |
74 | where format ps | 75 | where format ps |
75 | | (Human, _) <- output = mapM_ (\(PrinterId n, st) -> hPutStrLn out $ show n ++ "\t" ++ humanStatus st) $ Map.toAscList ps | 76 | | (Human, _) <- output = mapM_ (\(PrinterId n, st) -> hPutStrLn out $ show n ++ "\t" ++ humanStatus st) $ Map.toAscList ps |
@@ -102,18 +103,27 @@ tprint TPrint{ operation = Job{..}, ..} Client{..} out = job jobId >>= format | |||
102 | | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty p | 103 | | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty p |
103 | | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p) | 104 | | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p) |
104 | 105 | ||
105 | tprint TPrint{ operation = JobCreate{..}, ..} client@Client{..} _ = withInput input $ \inH -> do | 106 | -- Mutate |
107 | tprint TPrint{ operation = JobCreate{..}, ..} client@Client{..} out = withInput input $ \inH -> do | ||
106 | let | 108 | let |
107 | p' | 109 | p' |
108 | | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH | 110 | | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH |
109 | | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH | 111 | | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH |
110 | block' | 112 | block' |
111 | | block = blockLoop client | 113 | | block = blockLoop client out |
112 | | otherwise = const $ return () | 114 | | otherwise = hPutStrLn out . show |
113 | p <- force <$> p' | 115 | p <- force <$> p' |
114 | unless dryRun $ block' =<< jobCreate printer p | 116 | unless dryRun $ block' =<< jobCreate printer p |
115 | 117 | ||
116 | tprint TPrint{ operation = JobDelete{..}, ..} Client{..} _ = unless dryRun $ jobDelete jobId | 118 | tprint TPrint{ operation = JobDelete{..}, ..} Client{..} _ = unless dryRun $ jobDelete jobId |
117 | 119 | ||
120 | tprint TPrint{ operation = DraftCreate{..}, ..} Client{..} out = withInput input $ \inH -> do | ||
121 | let | ||
122 | p' | ||
123 | | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH | ||
124 | | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH | ||
125 | p <- force <$> p' | ||
126 | unless dryRun $ hPutStrLn out . show =<< draftCreate draftTitle p | ||
127 | |||
118 | 128 | ||
119 | tprint _ _ _ = undefined | 129 | tprint _ _ _ = undefined |