diff options
Diffstat (limited to 'spec/src/Thermoprint')
| -rw-r--r-- | spec/src/Thermoprint/API.hs | 21 | ||||
| -rw-r--r-- | spec/src/Thermoprint/Printout.hs | 28 |
2 files changed, 46 insertions, 3 deletions
diff --git a/spec/src/Thermoprint/API.hs b/spec/src/Thermoprint/API.hs new file mode 100644 index 0000000..f2ffd02 --- /dev/null +++ b/spec/src/Thermoprint/API.hs | |||
| @@ -0,0 +1,21 @@ | |||
| 1 | {-# LANGUAGE GeneralizedNewtypeDeriving, NoDeriveAnyClass #-} | ||
| 2 | {-# LANGUAGE TypeOperators, DataKinds #-} | ||
| 3 | |||
| 4 | module Thermoprint.API | ||
| 5 | ( PrinterId(..) | ||
| 6 | , JobId(..) | ||
| 7 | , ThermoprintAPI | ||
| 8 | ) where | ||
| 9 | |||
| 10 | import Thermoprint.Printout | ||
| 11 | |||
| 12 | import Servant.API | ||
| 13 | import Data.Aeson | ||
| 14 | |||
| 15 | newtype PrinterId = PrinterId Integer | ||
| 16 | deriving (Show, Eq, FromText, ToText, FromJSON, ToJSON) | ||
| 17 | |||
| 18 | newtype JobId = JobId Integer | ||
| 19 | deriving (Show, Eq, FromText, ToText, FromJSON, ToJSON) | ||
| 20 | |||
| 21 | type ThermoprintAPI = "print" :> Capture "printerId" PrinterId :> ReqBody '[JSON] Printout :> Post '[JSON] JobId | ||
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 | ||
| 24 | import GHC.Generics (Generic) | 24 | import GHC.Generics (Generic) |
| 25 | import Control.DeepSeq (NFData) | 25 | import Control.DeepSeq (NFData) |
| 26 | import Data.Aeson (FromJSON(..), ToJSON(..), Value(..)) | ||
| 27 | import qualified Data.Aeson as JSON (encode, decode) | ||
| 28 | import Data.Aeson.Types (typeMismatch) | ||
| 26 | 29 | ||
| 27 | import Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary, genericShrink) | 30 | import Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary, genericShrink) |
| 28 | import Test.QuickCheck.Modifiers (NonNegative(..)) | 31 | import Test.QuickCheck.Modifiers (NonNegative(..)) |
| @@ -32,6 +35,7 @@ import Test.QuickCheck (forAll, Property) | |||
| 32 | 35 | ||
| 33 | 36 | ||
| 34 | import qualified Data.Text.Lazy as TL (split, null, pack, filter, intercalate, map) | 37 | import qualified Data.Text.Lazy as TL (split, null, pack, filter, intercalate, map) |
| 38 | import qualified Data.Text as T (pack) | ||
| 35 | import Data.Char (isSpace) | 39 | import Data.Char (isSpace) |
| 36 | 40 | ||
| 37 | import Data.Monoid (Monoid(..), (<>)) | 41 | import Data.Monoid (Monoid(..), (<>)) |
| @@ -42,7 +46,13 @@ import Data.Sequence as Seq (fromList, null, singleton) | |||
| 42 | 46 | ||
| 43 | import Data.Function (on) | 47 | import Data.Function (on) |
| 44 | 48 | ||
| 45 | import Data.Foldable (toList) | 49 | import Data.Foldable (toList, fold) |
| 50 | |||
| 51 | import Data.Encoding (encodeLazyByteStringExplicit, decodeLazyByteString) | ||
| 52 | import Data.Encoding.UTF8 | ||
| 53 | import qualified Data.ByteString.Base64.Lazy as Base64 (encode, decode) | ||
| 54 | |||
| 55 | import 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 | ||
| 71 | instance 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 | |||
| 79 | instance 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 |
| 62 | data Block = Line Line -- ^ a single 'Line' of text | 84 | data 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'. | |||
| 75 | data Line = Word Text | 97 | data 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 | ||
| 80 | instance Monoid Block where | 102 | instance Monoid Block where |
| 81 | mempty = NewlSep mempty | 103 | mempty = NewlSep mempty |
