diff options
| -rw-r--r-- | server/src/Thermoprint/Server/Printer/Generic.hs | 29 |
1 files changed, 19 insertions, 10 deletions
diff --git a/server/src/Thermoprint/Server/Printer/Generic.hs b/server/src/Thermoprint/Server/Printer/Generic.hs index 33172ef..f37be21 100644 --- a/server/src/Thermoprint/Server/Printer/Generic.hs +++ b/server/src/Thermoprint/Server/Printer/Generic.hs | |||
| @@ -40,7 +40,7 @@ import Control.Monad.Catch | |||
| 40 | 40 | ||
| 41 | import Data.Foldable | 41 | import Data.Foldable |
| 42 | 42 | ||
| 43 | import Data.List (intersperse, genericReplicate, intercalate) | 43 | import Data.List (genericReplicate, intercalate) |
| 44 | 44 | ||
| 45 | import Data.Int (Int64) | 45 | import Data.Int (Int64) |
| 46 | 46 | ||
| @@ -78,16 +78,25 @@ escSequence = mapM_ pushWord8 . (esc:) | |||
| 78 | initialize :: Render | 78 | initialize :: Render |
| 79 | initialize = replicateM_ 2 $ escSequence [64] | 79 | initialize = replicateM_ 2 $ escSequence [64] |
| 80 | 80 | ||
| 81 | newl :: Lazy.ByteString | ||
| 82 | newl = "\r\n" | ||
| 83 | |||
| 84 | newls :: Integer -> Lazy.ByteString | ||
| 85 | newls i = mconcat $ genericReplicate i newl | ||
| 86 | |||
| 81 | finalize :: Render -- TODO: adjust this to produce proper padding | 87 | finalize :: Render -- TODO: adjust this to produce proper padding |
| 82 | finalize = encode' "\n\n\n" | 88 | finalize = encode' $ newls 2 |
| 89 | |||
| 90 | intersperse :: b -> (a -> b) -> Seq a -> Seq b | ||
| 91 | intersperse _ _ (viewl -> EmptyL) = Seq.empty | ||
| 92 | intersperse _ f (viewl -> x :< (viewl -> EmptyL)) = Seq.singleton $ f x | ||
| 93 | intersperse b f (viewl -> x :< xs) = f x <| b <| intersperse' b f xs | ||
| 83 | 94 | ||
| 84 | intersperse' :: b -> (a -> b) -> Seq a -> Seq b | 95 | intersperse' :: Monad m => m b -> (a -> m b) -> Seq a -> m () |
| 85 | intersperse' _ _ (viewl -> EmptyL) = Seq.empty | 96 | intersperse' b f = sequence_ . intersperse b f |
| 86 | intersperse' _ f (viewl -> x :< (viewl -> EmptyL)) = Seq.singleton $ f x | ||
| 87 | intersperse' b f (viewl -> x :< xs) = f x <| b <| intersperse' b f xs | ||
| 88 | 97 | ||
| 89 | render :: Printout -> Render | 98 | render :: Printout -> Render |
| 90 | render = sequence_ . intersperse' (encode' "\n\n") renderPar | 99 | render = intersperse' (encode' newl) renderPar |
| 91 | 100 | ||
| 92 | renderPar :: Paragraph -> Render | 101 | renderPar :: Paragraph -> Render |
| 93 | renderPar = mapM_ renderChunk | 102 | renderPar = mapM_ renderChunk |
| @@ -96,6 +105,6 @@ renderPar = mapM_ renderChunk | |||
| 96 | renderChunk (Cooked block) = renderBlock block | 105 | renderChunk (Cooked block) = renderBlock block |
| 97 | 106 | ||
| 98 | renderBlock :: Block -> Render | 107 | renderBlock :: Block -> Render |
| 99 | renderBlock (VSpace n) = encode' $ genericReplicate n '\n' | 108 | renderBlock (VSpace n) = encode' $ newls n |
| 100 | renderBlock (NewlSep xs) = sequence_ intercalate (encode' "\n") . map renderBlock . toList $ xs | 109 | renderBlock (NewlSep xs) = intersperse' (encode' newl) . fmap renderBlock $ xs |
| 101 | renderBlock (Line x) = undefined | 110 | renderBlock (Line x) = undefined |
