diff options
| -rw-r--r-- | tprint/src/Main.hs | 24 |
1 files changed, 17 insertions, 7 deletions
diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs index f78349e..71bbb2f 100644 --- a/tprint/src/Main.hs +++ b/tprint/src/Main.hs | |||
| @@ -59,17 +59,18 @@ humanJobStatus (Printing _) _ = "printing" | |||
| 59 | humanJobStatus (Done) _ = "finished successfully" | 59 | humanJobStatus (Done) _ = "finished successfully" |
| 60 | humanJobStatus (Failed err) _ = "failed: " ++ show err | 60 | humanJobStatus (Failed err) _ = "failed: " ++ show err |
| 61 | 61 | ||
| 62 | blockLoop :: Client IO -> JobId -> IO () | 62 | blockLoop :: Client IO -> Handle -> JobId -> IO () |
| 63 | blockLoop client@Client{..} jId = do | 63 | blockLoop client@Client{..} out jId@(JobId n) = do |
| 64 | threadDelay (10^6) | 64 | threadDelay (10^6) |
| 65 | status <- jobStatus jId | 65 | status <- jobStatus jId |
| 66 | case status of | 66 | case status of |
| 67 | Done -> return () | 67 | Done -> hPutStrLn out $ show n |
| 68 | Failed err -> throwM err | 68 | Failed err -> throwM err |
| 69 | _ -> blockLoop client jId | 69 | _ -> blockLoop client out jId |
| 70 | 70 | ||
| 71 | tprint :: TPrint -> Client IO -> Handle -> IO () | 71 | tprint :: TPrint -> Client IO -> Handle -> IO () |
| 72 | 72 | ||
| 73 | -- Query | ||
| 73 | tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format | 74 | tprint TPrint{ operation = Printers, ..} Client{..} out = printers >>= format |
| 74 | where format ps | 75 | where format ps |
| 75 | | (Human, _) <- output = mapM_ (\(PrinterId n, st) -> hPutStrLn out $ show n ++ "\t" ++ humanStatus st) $ Map.toAscList ps | 76 | | (Human, _) <- output = mapM_ (\(PrinterId n, st) -> hPutStrLn out $ show n ++ "\t" ++ humanStatus st) $ Map.toAscList ps |
| @@ -102,18 +103,27 @@ tprint TPrint{ operation = Job{..}, ..} Client{..} out = job jobId >>= format | |||
| 102 | | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty p | 103 | | (JSON, _) <- output = LCBS.hPutStrLn out $ encodePretty p |
| 103 | | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p) | 104 | | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p) |
| 104 | 105 | ||
| 105 | tprint TPrint{ operation = JobCreate{..}, ..} client@Client{..} _ = withInput input $ \inH -> do | 106 | -- Mutate |
| 107 | tprint TPrint{ operation = JobCreate{..}, ..} client@Client{..} out = withInput input $ \inH -> do | ||
| 106 | let | 108 | let |
| 107 | p' | 109 | p' |
| 108 | | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH | 110 | | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH |
| 109 | | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH | 111 | | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH |
| 110 | block' | 112 | block' |
| 111 | | block = blockLoop client | 113 | | block = blockLoop client out |
| 112 | | otherwise = const $ return () | 114 | | otherwise = hPutStrLn out . show |
| 113 | p <- force <$> p' | 115 | p <- force <$> p' |
| 114 | unless dryRun $ block' =<< jobCreate printer p | 116 | unless dryRun $ block' =<< jobCreate printer p |
| 115 | 117 | ||
| 116 | tprint TPrint{ operation = JobDelete{..}, ..} Client{..} _ = unless dryRun $ jobDelete jobId | 118 | tprint TPrint{ operation = JobDelete{..}, ..} Client{..} _ = unless dryRun $ jobDelete jobId |
| 117 | 119 | ||
| 120 | tprint TPrint{ operation = DraftCreate{..}, ..} Client{..} out = withInput input $ \inH -> do | ||
| 121 | let | ||
| 122 | p' | ||
| 123 | | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH | ||
| 124 | | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH | ||
| 125 | p <- force <$> p' | ||
| 126 | unless dryRun $ hPutStrLn out . show =<< draftCreate draftTitle p | ||
| 127 | |||
| 118 | 128 | ||
| 119 | tprint _ _ _ = undefined | 129 | tprint _ _ _ = undefined |
