From 5fea1efa7b276134750920f4d8da317422a21d83 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 1 Mar 2016 10:58:08 +0100
Subject: jobCreate

---
 tprint/src/Main.hs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

(limited to 'tprint/src/Main.hs')

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
 
 import Control.Monad
 import Control.Monad.Catch
+import Control.DeepSeq
+import Control.Concurrent (threadDelay)
 
 import Text.Show.Pretty (dumpStr)
 import Data.Aeson.Encode.Pretty (encodePretty)
+import Data.Aeson (eitherDecode')
 
 import System.IO
 
@@ -89,5 +92,22 @@ tprint TPrint{ operation = Job{..}, ..} Client{..} out = job jobId >>= format
           | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty p
           | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p)
 
+tprint TPrint{ operation = JobCreate{..}, ..} Client{..} out = withInput input $ \inH -> do
+  let
+    p'
+      | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH
+      | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH
+  blockLoop =<< jobCreate printer . force =<< p'
+  where
+    blockLoop jId
+      | block = do
+          threadDelay (10^6)
+          status <- jobStatus jId
+          case status of
+            Done -> return ()
+            Failed err -> throwM err
+            _ -> blockLoop jId
+      | otherwise = return ()
+
 
 tprint _ _ _ = undefined
-- 
cgit v1.2.3