server/src/Thermoprint/Server/Printer/Debug.hs


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

{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances     #-}

module Thermoprint.Server.Printer.Debug
       ( Debug(..)
       ) where

import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Control.Monad.Logger

import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as TL

import qualified Data.Text as T

import Thermoprint.Printout
import Thermoprint.Server.Printer

import Data.List (intersperse)
import Data.Foldable (toList)
import Data.Monoid

data Debug = Debug

instance Applicative m => IsPrinter Debug m where
  printMethod _ = printMethod debugPrinter

debugPrinter :: PrinterMethod
debugPrinter = PM $ (>> return Nothing) . $(logDebugS) "Printer.Debug" . T.pack . show . cotext' 

cotext' :: Printout -> Text
cotext' = mconcat . intersperse "\n\n" . map (mconcat . map cotext'' . toList) . toList
  where
    cotext'' (Cooked b) = cotext b
    cotext'' (Raw _)    = "[Raw]"