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 ++++++++++++++++++++
 tprint/tprint.cabal |  2 ++
 tprint/tprint.nix   |  8 ++++----
 3 files changed, 26 insertions(+), 4 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
 
 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
diff --git a/tprint/tprint.cabal b/tprint/tprint.cabal
index 03d6352..d6fc422 100644
--- a/tprint/tprint.cabal
+++ b/tprint/tprint.cabal
@@ -31,8 +31,10 @@ executable tprint
                      , pretty-show >=1.6.9 && <2
                      , text >=1.2.2 && <2
                      , aeson-pretty >=0.7.2 && <1
+                     , aeson >=0.9.0 && <1
                      , bytestring >=0.10.6 && <1
                      , exceptions >=0.8.2 && <1
+                     , deepseq >=1.4.1 && <2
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall
\ No newline at end of file
diff --git a/tprint/tprint.nix b/tprint/tprint.nix
index ace6210..3a23af2 100644
--- a/tprint/tprint.nix
+++ b/tprint/tprint.nix
@@ -1,6 +1,6 @@
-{ mkDerivation, aeson-pretty, base, bytestring, containers
-, exceptions, optparse-applicative, pretty-show, stdenv, text
-, thermoprint-bbcode, thermoprint-client, time
+{ mkDerivation, aeson, aeson-pretty, base, bytestring, containers
+, deepseq, exceptions, optparse-applicative, pretty-show, stdenv
+, text, thermoprint-bbcode, thermoprint-client, time
 }:
 mkDerivation {
   pname = "tprint";
@@ -9,7 +9,7 @@ mkDerivation {
   isLibrary = false;
   isExecutable = true;
   executableHaskellDepends = [
-    aeson-pretty base bytestring containers exceptions
+    aeson aeson-pretty base bytestring containers deepseq exceptions
     optparse-applicative pretty-show text thermoprint-bbcode
     thermoprint-client time
   ];
-- 
cgit v1.2.3