aboutsummaryrefslogtreecommitdiff
path: root/tprint
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-03-01 11:13:47 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2016-03-01 11:13:47 +0100
commit368df582c97597e51ecd0bc8a8b51c41cc233778 (patch)
treeea202bdc6ef9c1336e346db324db7f67bf6524ee /tprint
parent06f2c2cc635b3598e060cb2fd88b95fc0f4c34b1 (diff)
downloadthermoprint-368df582c97597e51ecd0bc8a8b51c41cc233778.tar
thermoprint-368df582c97597e51ecd0bc8a8b51c41cc233778.tar.gz
thermoprint-368df582c97597e51ecd0bc8a8b51c41cc233778.tar.bz2
thermoprint-368df582c97597e51ecd0bc8a8b51c41cc233778.tar.xz
thermoprint-368df582c97597e51ecd0bc8a8b51c41cc233778.zip
draftCreate && reporting of jobIds
Diffstat (limited to 'tprint')
-rw-r--r--tprint/src/Main.hs24
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"
59humanJobStatus (Done) _ = "finished successfully" 59humanJobStatus (Done) _ = "finished successfully"
60humanJobStatus (Failed err) _ = "failed: " ++ show err 60humanJobStatus (Failed err) _ = "failed: " ++ show err
61 61
62blockLoop :: Client IO -> JobId -> IO () 62blockLoop :: Client IO -> Handle -> JobId -> IO ()
63blockLoop client@Client{..} jId = do 63blockLoop 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
71tprint :: TPrint -> Client IO -> Handle -> IO () 71tprint :: TPrint -> Client IO -> Handle -> IO ()
72 72
73-- Query
73tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format 74tprint 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
105tprint TPrint{ operation = JobCreate{..}, ..} client@Client{..} _ = withInput input $ \inH -> do 106-- Mutate
107tprint 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
116tprint TPrint{ operation = JobDelete{..}, ..} Client{..} _ = unless dryRun $ jobDelete jobId 118tprint TPrint{ operation = JobDelete{..}, ..} Client{..} _ = unless dryRun $ jobDelete jobId
117 119
120tprint 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
119tprint _ _ _ = undefined 129tprint _ _ _ = undefined