diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-24 16:10:48 +0000 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-24 16:10:48 +0000 |
| commit | c3a6d0657eb2987aa13b53419269274d848d9e0c (patch) | |
| tree | fcf161b74fffad2294efc0b558a0dfd1bc27d49b /server/src/Thermoprint/Server/Printer | |
| parent | 7d3df6adce65e8840ef651a8a02a34a1a02083aa (diff) | |
| download | thermoprint-c3a6d0657eb2987aa13b53419269274d848d9e0c.tar thermoprint-c3a6d0657eb2987aa13b53419269274d848d9e0c.tar.gz thermoprint-c3a6d0657eb2987aa13b53419269274d848d9e0c.tar.bz2 thermoprint-c3a6d0657eb2987aa13b53419269274d848d9e0c.tar.xz thermoprint-c3a6d0657eb2987aa13b53419269274d848d9e0c.zip | |
Working printer config & debug printer
Diffstat (limited to 'server/src/Thermoprint/Server/Printer')
| -rw-r--r-- | server/src/Thermoprint/Server/Printer/Debug.hs | 39 |
1 files changed, 39 insertions, 0 deletions
diff --git a/server/src/Thermoprint/Server/Printer/Debug.hs b/server/src/Thermoprint/Server/Printer/Debug.hs new file mode 100644 index 0000000..b8c1430 --- /dev/null +++ b/server/src/Thermoprint/Server/Printer/Debug.hs | |||
| @@ -0,0 +1,39 @@ | |||
| 1 | {-# LANGUAGE OverloadedStrings #-} | ||
| 2 | {-# LANGUAGE RankNTypes #-} | ||
| 3 | {-# LANGUAGE TemplateHaskell #-} | ||
| 4 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
| 5 | {-# LANGUAGE FlexibleInstances #-} | ||
| 6 | |||
| 7 | module Thermoprint.Server.Printer.Debug | ||
| 8 | ( Debug(..) | ||
| 9 | ) where | ||
| 10 | |||
| 11 | import Control.Monad.IO.Class | ||
| 12 | import Control.Monad.Trans.Resource | ||
| 13 | import Control.Monad.Logger | ||
| 14 | |||
| 15 | import Data.Text.Lazy (Text) | ||
| 16 | import qualified Data.Text.Lazy as TL | ||
| 17 | |||
| 18 | import qualified Data.Text as T | ||
| 19 | |||
| 20 | import Thermoprint.Printout | ||
| 21 | import Thermoprint.Server.Printer | ||
| 22 | |||
| 23 | import Data.List (intersperse) | ||
| 24 | import Data.Foldable (toList) | ||
| 25 | import Data.Monoid | ||
| 26 | |||
| 27 | data Debug = Debug | ||
| 28 | |||
| 29 | instance Applicative m => IsPrinter Debug m where | ||
| 30 | printMethod _ = printMethod debugPrinter | ||
| 31 | |||
| 32 | debugPrinter :: PrinterMethod | ||
| 33 | debugPrinter = PM $ (>> return Nothing) . $(logDebugS) "Printer.Debug" . T.pack . show . cotext' | ||
| 34 | |||
| 35 | cotext' :: Printout -> Text | ||
| 36 | cotext' = mconcat . intersperse "\n\n" . map (mconcat . map cotext'' . toList) . toList | ||
| 37 | where | ||
| 38 | cotext'' (Cooked b) = cotext b | ||
| 39 | cotext'' (Raw _) = "[Raw]" | ||
