aboutsummaryrefslogtreecommitdiff
path: root/tprint
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-03-01 11:17:05 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2016-03-01 11:17:05 +0100
commitfdebcd98c7246c1abb84269163f47115fb84d5a5 (patch)
tree8b85c72210e50a149653cd54c34b71baf41a2d0f /tprint
parent368df582c97597e51ecd0bc8a8b51c41cc233778 (diff)
downloadthermoprint-fdebcd98c7246c1abb84269163f47115fb84d5a5.tar
thermoprint-fdebcd98c7246c1abb84269163f47115fb84d5a5.tar.gz
thermoprint-fdebcd98c7246c1abb84269163f47115fb84d5a5.tar.bz2
thermoprint-fdebcd98c7246c1abb84269163f47115fb84d5a5.tar.xz
thermoprint-fdebcd98c7246c1abb84269163f47115fb84d5a5.zip
draftReplace & cleanup
Diffstat (limited to 'tprint')
-rw-r--r--tprint/src/Main.hs24
1 files changed, 13 insertions, 11 deletions
diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs
index 71bbb2f..fa5cd26 100644
--- a/tprint/src/Main.hs
+++ b/tprint/src/Main.hs
@@ -51,6 +51,14 @@ withInput :: Input -> (Handle -> IO a) -> IO a
51withInput (_, Stdin) = ($ stdin) 51withInput (_, Stdin) = ($ stdin)
52withInput (_, ReadFile f) = withFile f ReadMode 52withInput (_, ReadFile f) = withFile f ReadMode
53 53
54withPrintout :: Input -> (Printout -> IO a) -> IO a
55withPrintout input a = withInput input $ \inH -> do
56 let
57 p'
58 | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH
59 | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH
60 a =<< (force <$> p')
61
54humanJobStatus :: JobStatus -> Maybe PrinterId -> String 62humanJobStatus :: JobStatus -> Maybe PrinterId -> String
55humanJobStatus (Queued (PrinterId n)) Nothing = "queued at printer #" ++ show n 63humanJobStatus (Queued (PrinterId n)) Nothing = "queued at printer #" ++ show n
56humanJobStatus (Queued _) _ = "queued" 64humanJobStatus (Queued _) _ = "queued"
@@ -104,26 +112,20 @@ tprint TPrint{ operation = Job{..}, ..} Client{..} out = job jobId >>= format
104 | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p) 112 | otherwise <- output = T.hPutStrLn out =<< either throwM return (cobbcode p)
105 113
106-- Mutate 114-- Mutate
107tprint TPrint{ operation = JobCreate{..}, ..} client@Client{..} out = withInput input $ \inH -> do 115tprint TPrint{ operation = JobCreate{..}, ..} client@Client{..} out = withPrintout input $ \p -> do
108 let 116 let
109 p'
110 | (BBCode, _) <- input = either throwM return . bbcode =<< T.hGetContents inH
111 | otherwise = either (throwM . userError) return . eitherDecode' =<< LCBS.hGetContents inH
112 block' 117 block'
113 | block = blockLoop client out 118 | block = blockLoop client out
114 | otherwise = hPutStrLn out . show 119 | otherwise = hPutStrLn out . show
115 p <- force <$> p'
116 unless dryRun $ block' =<< jobCreate printer p 120 unless dryRun $ block' =<< jobCreate printer p
117 121
118tprint TPrint{ operation = JobDelete{..}, ..} Client{..} _ = unless dryRun $ jobDelete jobId 122tprint TPrint{ operation = JobDelete{..}, ..} Client{..} _ = unless dryRun $ jobDelete jobId
119 123
120tprint TPrint{ operation = DraftCreate{..}, ..} Client{..} out = withInput input $ \inH -> do 124tprint TPrint{ operation = DraftCreate{..}, ..} Client{..} out = withPrintout input $ \p -> 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 125 unless dryRun $ hPutStrLn out . show =<< draftCreate draftTitle p
127 126
127tprint TPrint{ operation = DraftReplace{..}, ..} Client{..} _ = withPrintout input $ \p -> do
128 unless dryRun $ draftReplace draftId draftTitle p
129
128 130
129tprint _ _ _ = undefined 131tprint _ _ _ = undefined