aboutsummaryrefslogtreecommitdiff
path: root/spec/src/Thermoprint/Printout.hs
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-01-10 04:43:42 +0000
committerGregor Kleen <gkleen@yggdrasil.li>2016-01-10 04:43:42 +0000
commit6ec3c805ea2cd629a75641530de30ab39a191409 (patch)
tree9a63c2edbe6834a17a67b055279024b7ec31eb3a /spec/src/Thermoprint/Printout.hs
parent0bb617ff93d242d20e9e63f44664f38a653898d4 (diff)
downloadthermoprint-6ec3c805ea2cd629a75641530de30ab39a191409.tar
thermoprint-6ec3c805ea2cd629a75641530de30ab39a191409.tar.gz
thermoprint-6ec3c805ea2cd629a75641530de30ab39a191409.tar.bz2
thermoprint-6ec3c805ea2cd629a75641530de30ab39a191409.tar.xz
thermoprint-6ec3c805ea2cd629a75641530de30ab39a191409.zip
First stab at API
Diffstat (limited to 'spec/src/Thermoprint/Printout.hs')
-rw-r--r--spec/src/Thermoprint/Printout.hs28
1 files changed, 25 insertions, 3 deletions
diff --git a/spec/src/Thermoprint/Printout.hs b/spec/src/Thermoprint/Printout.hs
index 32c403c..d9d9902 100644
--- a/spec/src/Thermoprint/Printout.hs
+++ b/spec/src/Thermoprint/Printout.hs
@@ -23,6 +23,9 @@ import Data.ByteString.Lazy (ByteString)
23 23
24import GHC.Generics (Generic) 24import GHC.Generics (Generic)
25import Control.DeepSeq (NFData) 25import Control.DeepSeq (NFData)
26import Data.Aeson (FromJSON(..), ToJSON(..), Value(..))
27import qualified Data.Aeson as JSON (encode, decode)
28import Data.Aeson.Types (typeMismatch)
26 29
27import Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary, genericShrink) 30import Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary, genericShrink)
28import Test.QuickCheck.Modifiers (NonNegative(..)) 31import Test.QuickCheck.Modifiers (NonNegative(..))
@@ -32,6 +35,7 @@ import Test.QuickCheck (forAll, Property)
32 35
33 36
34import qualified Data.Text.Lazy as TL (split, null, pack, filter, intercalate, map) 37import qualified Data.Text.Lazy as TL (split, null, pack, filter, intercalate, map)
38import qualified Data.Text as T (pack)
35import Data.Char (isSpace) 39import Data.Char (isSpace)
36 40
37import Data.Monoid (Monoid(..), (<>)) 41import Data.Monoid (Monoid(..), (<>))
@@ -42,7 +46,13 @@ import Data.Sequence as Seq (fromList, null, singleton)
42 46
43import Data.Function (on) 47import Data.Function (on)
44 48
45import Data.Foldable (toList) 49import Data.Foldable (toList, fold)
50
51import Data.Encoding (encodeLazyByteStringExplicit, decodeLazyByteString)
52import Data.Encoding.UTF8
53import qualified Data.ByteString.Base64.Lazy as Base64 (encode, decode)
54
55import Prelude hiding (fold)
46 56
47 57
48-- | A 'Printout' is a sequence of visually seperated 'Paragraph's 58-- | A 'Printout' is a sequence of visually seperated 'Paragraph's
@@ -58,11 +68,23 @@ data Chunk = Cooked Block -- ^ text semantically structured to be rendered in ac
58 | Raw ByteString -- ^ direct instructions to the printer 68 | Raw ByteString -- ^ direct instructions to the printer
59 deriving (Generic, NFData, Show, CoArbitrary) 69 deriving (Generic, NFData, Show, CoArbitrary)
60 70
71instance FromJSON Chunk where
72 parseJSON s@(String _) = Raw <$> ((either fail return . decodeBase64) =<< parseJSON s)
73 where
74 decodeBase64 :: String -> Either String ByteString
75 decodeBase64 s = (either (Left . show) Right . encodeLazyByteStringExplicit UTF8Strict $ s) >>= Base64.decode
76 parseJSON o@(Object _) = Cooked <$> parseJSON o
77 parseJSON v = typeMismatch "Chunk" v
78
79instance ToJSON Chunk where
80 toJSON (Raw bs) = String . T.pack . decodeLazyByteString UTF8Strict . Base64.encode $ bs
81 toJSON (Cooked block) = toJSON block
82
61-- | 'Block' is the entry point for our structured document format 83-- | 'Block' is the entry point for our structured document format
62data Block = Line Line -- ^ a single 'Line' of text 84data Block = Line Line -- ^ a single 'Line' of text
63 | VSpace Integer -- ^ vertical space of height equivalent to 'Integer' lines 85 | VSpace Integer -- ^ vertical space of height equivalent to 'Integer' lines
64 | NewlSep (Seq Block) -- ^ A sequence of 'Block's seperated by newlines 86 | NewlSep (Seq Block) -- ^ A sequence of 'Block's seperated by newlines
65 deriving (Generic, NFData, Show, CoArbitrary) 87 deriving (Generic, NFData, Show, CoArbitrary, FromJSON, ToJSON)
66 88
67{- | A 'Line' is one of: 89{- | A 'Line' is one of:
68 90
@@ -75,7 +97,7 @@ We don't export all constructors and instead encourage the use of 'text'.
75data Line = Word Text 97data Line = Word Text
76 | HSpace Integer 98 | HSpace Integer
77 | SpaceSep (Seq Line) 99 | SpaceSep (Seq Line)
78 deriving (Generic, NFData, Show, CoArbitrary) 100 deriving (Generic, NFData, Show, CoArbitrary, FromJSON, ToJSON)
79 101
80instance Monoid Block where 102instance Monoid Block where
81 mempty = NewlSep mempty 103 mempty = NewlSep mempty