From 33869e26481060ec7d5fa65ab1c7e67d96de2a8c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 14 Feb 2016 23:18:42 +0000
Subject: Fixed build & minor code cleanup

---
 server/src/Thermoprint/Server/Printer/Generic.hs | 32 ++++++++++++++----------
 1 file changed, 19 insertions(+), 13 deletions(-)

(limited to 'server/src/Thermoprint/Server')

diff --git a/server/src/Thermoprint/Server/Printer/Generic.hs b/server/src/Thermoprint/Server/Printer/Generic.hs
index f37be21..b993eaf 100644
--- a/server/src/Thermoprint/Server/Printer/Generic.hs
+++ b/server/src/Thermoprint/Server/Printer/Generic.hs
@@ -7,7 +7,7 @@ module Thermoprint.Server.Printer.Generic
        ) where
 
 import Thermoprint.Printout
-import Thermoprint.API (PrintingError(IOError))
+import Thermoprint.API (PrintingError(..))
 import Thermoprint.Server.Printer
 
 import System.FileLock
@@ -46,14 +46,11 @@ 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
+genericPrint path = PM $ genericPrint' path
+
+genericPrint' :: (MonadIO m, MonadMask m) => FilePath -> Printout -> m (Maybe PrintingError)
+genericPrint' path = 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)
@@ -61,6 +58,12 @@ genericPrint path = PM $ flip catches handlers . withLockedFile path . print
                , Handler $ return . Just
                ]
 
+withLockedFile :: (MonadIO m, MonadMask m) => FilePath -> (Handle -> m a) -> m a
+withLockedFile path f = withEx (lockedFile path) (f . snd)
+
+lockedFile :: FilePath -> Acquire (FileLock, Handle)
+lockedFile f = mkAcquire ((,) <$> lockFile f Exclusive <*> openFile f WriteMode) (\(lock, h) -> () <$ hClose h <* unlockFile lock)
+
 type Render = ReaderT Handle IO ()
 
 encode' :: ByteSink m => String -> m ()
@@ -84,19 +87,22 @@ newl = "\r\n"
 newls :: Integer -> Lazy.ByteString
 newls i = mconcat $ genericReplicate i newl
 
+newls' :: Integer -> Render
+newls' = mapM_ pushWord8 . LBS.unpack . newls
+
 finalize :: Render -- TODO: adjust this to produce proper padding
-finalize = encode' $ newls 2
+finalize = 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 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
+render = intersperse' (newls' 1) renderPar
 
 renderPar :: Paragraph -> Render
 renderPar = mapM_ renderChunk
@@ -105,6 +111,6 @@ renderPar = mapM_ renderChunk
     renderChunk (Cooked block) = renderBlock block
 
 renderBlock :: Block -> Render
-renderBlock (VSpace n)   = encode' $ newls n
-renderBlock (NewlSep xs) = intersperse' (encode' newl) . fmap renderBlock $ xs
+renderBlock (VSpace n)   = newls' n
+renderBlock (NewlSep xs) = intersperse' (newls' 1) renderBlock xs
 renderBlock (Line x)     = undefined
-- 
cgit v1.2.3