aboutsummaryrefslogtreecommitdiff
path: root/tprint
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-03-01 11:05:34 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2016-03-01 11:05:34 +0100
commit336ae3a2843f3e764f41f650ef6d1361698ae359 (patch)
tree1512496d43262ed763b9411fdb1d9fb252422ec5 /tprint
parent5fea1efa7b276134750920f4d8da317422a21d83 (diff)
downloadthermoprint-336ae3a2843f3e764f41f650ef6d1361698ae359.tar
thermoprint-336ae3a2843f3e764f41f650ef6d1361698ae359.tar.gz
thermoprint-336ae3a2843f3e764f41f650ef6d1361698ae359.tar.bz2
thermoprint-336ae3a2843f3e764f41f650ef6d1361698ae359.tar.xz
thermoprint-336ae3a2843f3e764f41f650ef6d1361698ae359.zip
cleanup
Diffstat (limited to 'tprint')
-rw-r--r--tprint/src/Main.hs27
1 files changed, 15 insertions, 12 deletions
diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs
index 708fa4c..7c60d0d 100644
--- a/tprint/src/Main.hs
+++ b/tprint/src/Main.hs
@@ -17,6 +17,7 @@ import Data.List
17import Data.Monoid 17import Data.Monoid
18import Data.Maybe 18import Data.Maybe
19import Data.Either 19import Data.Either
20import Data.Bool
20 21
21import Control.Monad 22import Control.Monad
22import Control.Monad.Catch 23import Control.Monad.Catch
@@ -58,6 +59,15 @@ humanJobStatus (Printing _) _ = "printing"
58humanJobStatus (Done) _ = "finished successfully" 59humanJobStatus (Done) _ = "finished successfully"
59humanJobStatus (Failed err) _ = "failed: " ++ show err 60humanJobStatus (Failed err) _ = "failed: " ++ show err
60 61
62blockLoop :: Client IO -> JobId -> IO ()
63blockLoop client@Client{..} jId = do
64 threadDelay (10^6)
65 status <- jobStatus jId
66 case status of
67 Done -> return ()
68 Failed err -> throwM err
69 _ -> blockLoop client jId
70
61tprint :: TPrint -> Client IO -> Handle -> IO () 71tprint :: TPrint -> Client IO -> Handle -> IO ()
62 72
63tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format 73tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format
@@ -92,22 +102,15 @@ tprint TPrint{ operation = Job{..}, ..} Client{..} out = job jobId >>= format
92 | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty p 102 | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty p
93 | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p) 103 | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p)
94 104
95tprint TPrint{ operation = JobCreate{..}, ..} Client{..} out = withInput input $ \inH -> do 105tprint TPrint{ operation = JobCreate{..}, ..} client@Client{..} out = withInput input $ \inH -> do
96 let 106 let
97 p' 107 p'
98 | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH 108 | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH
99 | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH 109 | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH
100 blockLoop =<< jobCreate printer . force =<< p' 110 block'
101 where 111 | block = blockLoop client
102 blockLoop jId 112 | otherwise = const $ return ()
103 | block = do 113 block' =<< jobCreate printer . force =<< p'
104 threadDelay (10^6)
105 status <- jobStatus jId
106 case status of
107 Done -> return ()
108 Failed err -> throwM err
109 _ -> blockLoop jId
110 | otherwise = return ()
111 114
112 115
113tprint _ _ _ = undefined 116tprint _ _ _ = undefined