1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Thermoprint.Server.Printer.Generic
( genericPrint
) where
import Thermoprint.Printout
import Thermoprint.API (PrintingError(IOError))
import Thermoprint.Server.Printer
import System.FileLock
import System.IO
import Data.Sequence (Seq, (|>), (<|), ViewL(..), viewl)
import qualified Data.Sequence as Seq
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as CLBS
import qualified Data.Text.Lazy as Lazy (Text)
import qualified Data.Text.Lazy as TL
import Data.Encoding
import Data.Encoding.CP437
import Data.Word
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Trans.State
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.Acquire
import Control.Exception.Base (IOException)
import Control.Monad.Catch
import Data.Foldable
import Data.List (genericReplicate, intercalate)
import Data.Int (Int64)
import Prelude hiding (mapM_, sequence_)
lockedFile :: FilePath -> Acquire (FileLock, Handle)
lockedFile f = mkAcquire ((,) <$> lockFile f Exclusive <*> openFile f AppendMode) (\(lock, h) -> () <$ hClose h <* unlockFile lock)
withLockedFile :: (MonadIO m, MonadMask m) => FilePath -> (Handle -> m a) -> m a
withLockedFile path f = withEx (lockedFile path) (f . snd)
genericPrint :: FilePath -> PrinterMethod
genericPrint path = PM $ flip catches handlers . withLockedFile path . print
where
print printout handle = liftIO $ runReaderT (bracket_ initialize (render printout) finalize) handle >> return Nothing
handlers = [ Handler $ return . Just . IOError . (show :: IOException -> String)
, Handler $ return . Just . EncError
, Handler $ return . Just
]
type Render = ReaderT Handle IO ()
encode' :: ByteSink m => String -> m ()
encode' = encode CP437
width :: Int64
width = 32
esc :: Word8
esc = 27
escSequence :: [Word8] -> Render
escSequence = mapM_ pushWord8 . (esc:)
initialize :: Render
initialize = replicateM_ 2 $ escSequence [64]
newl :: Lazy.ByteString
newl = "\r\n"
newls :: Integer -> Lazy.ByteString
newls i = mconcat $ genericReplicate i newl
finalize :: Render -- TODO: adjust this to produce proper padding
finalize = encode' $ newls 2
intersperse :: b -> (a -> b) -> Seq a -> Seq b
intersperse _ _ (viewl -> EmptyL) = Seq.empty
intersperse _ f (viewl -> x :< (viewl -> EmptyL)) = Seq.singleton $ f x
intersperse b f (viewl -> x :< xs) = f x <| b <| intersperse' b f xs
intersperse' :: Monad m => m b -> (a -> m b) -> Seq a -> m ()
intersperse' b f = sequence_ . intersperse b f
render :: Printout -> Render
render = intersperse' (encode' newl) renderPar
renderPar :: Paragraph -> Render
renderPar = mapM_ renderChunk
where
renderChunk (Raw bs) = mapM_ pushWord8 $ LBS.unpack bs
renderChunk (Cooked block) = renderBlock block
renderBlock :: Block -> Render
renderBlock (VSpace n) = encode' $ newls n
renderBlock (NewlSep xs) = intersperse' (encode' newl) . fmap renderBlock $ xs
renderBlock (Line x) = undefined
|
