diff options
-rw-r--r-- | tprint/src/Main.hs | 27 |
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 | |||
17 | import Data.Monoid | 17 | import Data.Monoid |
18 | import Data.Maybe | 18 | import Data.Maybe |
19 | import Data.Either | 19 | import Data.Either |
20 | import Data.Bool | ||
20 | 21 | ||
21 | import Control.Monad | 22 | import Control.Monad |
22 | import Control.Monad.Catch | 23 | import Control.Monad.Catch |
@@ -58,6 +59,15 @@ humanJobStatus (Printing _) _ = "printing" | |||
58 | humanJobStatus (Done) _ = "finished successfully" | 59 | humanJobStatus (Done) _ = "finished successfully" |
59 | humanJobStatus (Failed err) _ = "failed: " ++ show err | 60 | humanJobStatus (Failed err) _ = "failed: " ++ show err |
60 | 61 | ||
62 | blockLoop :: Client IO -> JobId -> IO () | ||
63 | blockLoop 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 | |||
61 | tprint :: TPrint -> Client IO -> Handle -> IO () | 71 | tprint :: TPrint -> Client IO -> Handle -> IO () |
62 | 72 | ||
63 | tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format | 73 | tprint 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 | ||
95 | tprint TPrint{ operation = JobCreate{..}, ..} Client{..} out = withInput input $ \inH -> do | 105 | tprint 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 | ||
113 | tprint _ _ _ = undefined | 116 | tprint _ _ _ = undefined |