aboutsummaryrefslogtreecommitdiff
path: root/tprint/src
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-03-01 10:58:08 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2016-03-01 10:58:08 +0100
commit5fea1efa7b276134750920f4d8da317422a21d83 (patch)
treee59496875fb131280ed4e9f976e488d7c9824ec9 /tprint/src
parent8d811536eb1b45e2be3eb6be1e2f1a3feef04336 (diff)
downloadthermoprint-5fea1efa7b276134750920f4d8da317422a21d83.tar
thermoprint-5fea1efa7b276134750920f4d8da317422a21d83.tar.gz
thermoprint-5fea1efa7b276134750920f4d8da317422a21d83.tar.bz2
thermoprint-5fea1efa7b276134750920f4d8da317422a21d83.tar.xz
thermoprint-5fea1efa7b276134750920f4d8da317422a21d83.zip
jobCreate
Diffstat (limited to 'tprint/src')
-rw-r--r--tprint/src/Main.hs20
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
21import Control.Monad 21import Control.Monad
22import Control.Monad.Catch 22import Control.Monad.Catch
23import Control.DeepSeq
24import Control.Concurrent (threadDelay)
23 25
24import Text.Show.Pretty (dumpStr) 26import Text.Show.Pretty (dumpStr)
25import Data.Aeson.Encode.Pretty (encodePretty) 27import Data.Aeson.Encode.Pretty (encodePretty)
28import Data.Aeson (eitherDecode')
26 29
27import System.IO 30import 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
95tprint 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
93tprint _ _ _ = undefined 113tprint _ _ _ = undefined