From 336ae3a2843f3e764f41f650ef6d1361698ae359 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 1 Mar 2016 11:05:34 +0100 Subject: cleanup --- tprint/src/Main.hs | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) (limited to 'tprint/src/Main.hs') 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 import Data.Monoid import Data.Maybe import Data.Either +import Data.Bool import Control.Monad import Control.Monad.Catch @@ -58,6 +59,15 @@ humanJobStatus (Printing _) _ = "printing" humanJobStatus (Done) _ = "finished successfully" humanJobStatus (Failed err) _ = "failed: " ++ show err +blockLoop :: Client IO -> JobId -> IO () +blockLoop client@Client{..} jId = do + threadDelay (10^6) + status <- jobStatus jId + case status of + Done -> return () + Failed err -> throwM err + _ -> blockLoop client jId + tprint :: TPrint -> Client IO -> Handle -> IO () tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format @@ -92,22 +102,15 @@ 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 +tprint TPrint{ operation = JobCreate{..}, ..} client@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 () + block' + | block = blockLoop client + | otherwise = const $ return () + block' =<< jobCreate printer . force =<< p' tprint _ _ _ = undefined -- cgit v1.2.3