diff options
Diffstat (limited to 'tprint/src')
-rw-r--r-- | tprint/src/Main.hs | 20 |
1 files changed, 20 insertions, 0 deletions
diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs index 6df335a..708fa4c 100644 --- a/tprint/src/Main.hs +++ b/tprint/src/Main.hs | |||
@@ -20,9 +20,12 @@ import Data.Either | |||
20 | 20 | ||
21 | import Control.Monad | 21 | import Control.Monad |
22 | import Control.Monad.Catch | 22 | import Control.Monad.Catch |
23 | import Control.DeepSeq | ||
24 | import Control.Concurrent (threadDelay) | ||
23 | 25 | ||
24 | import Text.Show.Pretty (dumpStr) | 26 | import Text.Show.Pretty (dumpStr) |
25 | import Data.Aeson.Encode.Pretty (encodePretty) | 27 | import Data.Aeson.Encode.Pretty (encodePretty) |
28 | import Data.Aeson (eitherDecode') | ||
26 | 29 | ||
27 | import System.IO | 30 | import System.IO |
28 | 31 | ||
@@ -89,5 +92,22 @@ tprint TPrint{ operation = Job{..}, ..} Client{..} out = job jobId >>= format | |||
89 | | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty p | 92 | | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty p |
90 | | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p) | 93 | | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p) |
91 | 94 | ||
95 | tprint TPrint{ operation = JobCreate{..}, ..} Client{..} out = withInput input $ \inH -> do | ||
96 | let | ||
97 | p' | ||
98 | | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH | ||
99 | | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH | ||
100 | blockLoop =<< jobCreate printer . force =<< p' | ||
101 | where | ||
102 | blockLoop jId | ||
103 | | block = do | ||
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 | |||
92 | 112 | ||
93 | tprint _ _ _ = undefined | 113 | tprint _ _ _ = undefined |