Add support for ESC/POS text decoration

1 files changed, 15 insertions, 0 deletions

diff --git a/spec/src/Thermoprint/Printout.hs b/spec/src/Thermoprint/Printout.hs
index 8c33e07..752ccb5 100644
--- a/spec/src/Thermoprint/Printout.hs
+++ b/spec/src/Thermoprint/Printout.hs
@@ -11,7 +11,9 @@ module Thermoprint.Printout
        , Block(..)
        , Line( HSpace
              , JuxtaPos
+             , Markup
              )
+       , MarkupMode(..)
        , text, cotext
        , prop_text
        ) where
@@ -48,6 +50,9 @@ import Data.Monoid (Monoid(..), (<>))
 
 import Data.List (dropWhile, dropWhileEnd, groupBy, genericLength, genericReplicate)
 
+import Data.Set (Set)
+import qualified Data.Set as Set
+
 import Data.Sequence as Seq (fromList, null, singleton)
 import Data.Sequence (ViewL(..), viewl)
 
@@ -143,6 +148,7 @@ We don't export all constructors and instead encourage the use of 'text'.
 -} 
 data Line = Word Text
           | HSpace Integer
+          | Markup (Set MarkupMode) Line
           | JuxtaPos (Seq Line)
           deriving (Generic, NFData, Show, CoArbitrary, FromJSON, ToJSON)
 
@@ -215,6 +221,7 @@ cotext (Line x) = cotext' x
   where            
     cotext' (Word x) = x
     cotext' (HSpace n) = TL.pack . genericReplicate n $ ' '
+    cotext' (Markup _ l) = cotext' l
     cotext' (JuxtaPos xs) = mconcat . map cotext' . toList $ xs
 
 prop_text :: Text -> Bool
@@ -231,6 +238,14 @@ prop_text x = (cotext . either id Line . text $ x') == x'
       | otherwise = c
     keep = [' ', '\n'] :: [Char]
 
+data MarkupMode = Bold
+                | Underline
+                | DoubleHeight
+                | DoubleWidth
+  deriving (Generic, NFData, Show, Arbitrary, CoArbitrary, FromJSON, ToJSON
+           , Eq, Ord, Enum
+           )
+
 -- | We don't test 'Raw' 'Chunk's
 instance Arbitrary Chunk where
   shrink = genericShrink