diff options
Diffstat (limited to 'spec/src/Thermoprint/Printout.hs')
-rw-r--r-- | spec/src/Thermoprint/Printout.hs | 42 |
1 files changed, 35 insertions, 7 deletions
diff --git a/spec/src/Thermoprint/Printout.hs b/spec/src/Thermoprint/Printout.hs index 2be0a83..8c33e07 100644 --- a/spec/src/Thermoprint/Printout.hs +++ b/spec/src/Thermoprint/Printout.hs | |||
@@ -1,6 +1,6 @@ | |||
1 | {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} | 1 | {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} |
2 | {-# LANGUAGE OverloadedStrings #-} | 2 | {-# LANGUAGE OverloadedStrings #-} |
3 | {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} | 3 | {-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-} |
4 | {-# OPTIONS_HADDOCK show-extensions #-} | 4 | {-# OPTIONS_HADDOCK show-extensions #-} |
5 | 5 | ||
6 | -- | This module contains the definition of the structure -- 'Printout' -- used to represent the content of a job | 6 | -- | This module contains the definition of the structure -- 'Printout' -- used to represent the content of a job |
@@ -63,19 +63,47 @@ import Prelude hiding (fold) | |||
63 | 63 | ||
64 | 64 | ||
65 | -- | A 'Printout' is a sequence of visually seperated 'Paragraph's | 65 | -- | A 'Printout' is a sequence of visually seperated 'Paragraph's |
66 | type Printout = Seq Paragraph | 66 | newtype Printout = Printout { getParagraphs :: Seq Paragraph } |
67 | deriving (Show, Generic, NFData) | ||
68 | |||
69 | instance Eq Paragraph => Eq Printout where | ||
70 | (==) = (==) `on` getParagraphs | ||
71 | |||
72 | instance Monoid Printout where | ||
73 | mempty = Printout mempty | ||
74 | mappend a b = Printout $ (mappend `on` getParagraphs) a b | ||
75 | |||
76 | instance FromJSON Printout where | ||
77 | parseJSON = fmap Printout . parseJSON | ||
78 | |||
79 | instance ToJSON Printout where | ||
80 | toJSON = toJSON . getParagraphs | ||
81 | |||
82 | instance Arbitrary Printout where | ||
83 | arbitrary = Printout <$> arbitrary | ||
67 | 84 | ||
68 | -- | A 'Paragraph' is a non-seperated sequence of 'Chunk's | 85 | -- | A 'Paragraph' is a non-seperated sequence of 'Chunk's |
69 | type Paragraph = Seq Chunk | 86 | newtype Paragraph = Paragraph { getChunks :: Seq Chunk } |
87 | deriving (Show, Generic, NFData) | ||
88 | |||
89 | instance Eq Chunk => Eq Paragraph where | ||
90 | (==) = (==) `on` getChunks | ||
91 | |||
92 | instance Monoid Paragraph where | ||
93 | mempty = Paragraph mempty | ||
94 | mappend a b = Paragraph $ (mappend `on` getChunks) a b | ||
95 | |||
96 | instance Arbitrary Paragraph where | ||
97 | arbitrary = Paragraph <$> arbitrary | ||
70 | 98 | ||
71 | instance FromJSON Paragraph where | 99 | instance FromJSON Paragraph where |
72 | parseJSON o@(Array _) = Seq.fromList <$> parseJSON o | 100 | parseJSON o@(Array _) = Paragraph . Seq.fromList <$> parseJSON o |
73 | parseJSON o@(Object _) = Seq.singleton <$> parseJSON o | 101 | parseJSON o@(Object _) = Paragraph . Seq.singleton <$> parseJSON o |
74 | parseJSON o@(String _) = Seq.singleton <$> parseJSON o | 102 | parseJSON o@(String _) = Paragraph . Seq.singleton <$> parseJSON o |
75 | parseJSON v = typeMismatch "Paragraph" v | 103 | parseJSON v = typeMismatch "Paragraph" v |
76 | 104 | ||
77 | instance ToJSON Paragraph where | 105 | instance ToJSON Paragraph where |
78 | toJSON cs | 106 | toJSON (Paragraph cs) |
79 | | (a :< as) <- viewl cs | 107 | | (a :< as) <- viewl cs |
80 | , Seq.null as = toJSON a | 108 | , Seq.null as = toJSON a |
81 | | otherwise = toJSON $ toList cs | 109 | | otherwise = toJSON $ toList cs |