From 6ec3c805ea2cd629a75641530de30ab39a191409 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 10 Jan 2016 04:43:42 +0000
Subject: First stab at API

---
 spec/src/Thermoprint/API.hs      | 21 +++++++++++++++++++++
 spec/src/Thermoprint/Printout.hs | 28 +++++++++++++++++++++++++---
 2 files changed, 46 insertions(+), 3 deletions(-)
 create mode 100644 spec/src/Thermoprint/API.hs

(limited to 'spec/src')

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 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, NoDeriveAnyClass #-}
+{-# LANGUAGE TypeOperators, DataKinds #-}
+
+module Thermoprint.API
+       ( PrinterId(..)
+       , JobId(..)
+       , ThermoprintAPI
+       ) where
+
+import Thermoprint.Printout
+
+import Servant.API
+import Data.Aeson
+
+newtype PrinterId = PrinterId Integer
+                  deriving (Show, Eq, FromText, ToText, FromJSON, ToJSON)
+
+newtype JobId = JobId Integer
+              deriving (Show, Eq, FromText, ToText, FromJSON, ToJSON)
+
+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)
 
 import GHC.Generics (Generic)
 import Control.DeepSeq (NFData)
+import Data.Aeson (FromJSON(..), ToJSON(..), Value(..))
+import qualified Data.Aeson as JSON (encode, decode)
+import Data.Aeson.Types (typeMismatch)
 
 import Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary, genericShrink)
 import Test.QuickCheck.Modifiers (NonNegative(..))
@@ -32,6 +35,7 @@ import Test.QuickCheck (forAll, Property)
 
 
 import qualified Data.Text.Lazy as TL (split, null, pack, filter, intercalate, map)
+import qualified Data.Text as T (pack)
 import Data.Char (isSpace)
 
 import Data.Monoid (Monoid(..), (<>))
@@ -42,7 +46,13 @@ import Data.Sequence as Seq (fromList, null, singleton)
 
 import Data.Function (on)
 
-import Data.Foldable (toList)
+import Data.Foldable (toList, fold)
+
+import Data.Encoding (encodeLazyByteStringExplicit, decodeLazyByteString)
+import Data.Encoding.UTF8
+import qualified Data.ByteString.Base64.Lazy as Base64 (encode, decode)
+
+import Prelude hiding (fold)
 
 
 -- | 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
            | Raw ByteString -- ^ direct instructions to the printer
            deriving (Generic, NFData, Show, CoArbitrary)
 
+instance FromJSON Chunk where
+  parseJSON s@(String _) = Raw <$> ((either fail return . decodeBase64) =<< parseJSON s)
+    where
+      decodeBase64 :: String -> Either String ByteString
+      decodeBase64 s = (either (Left . show) Right . encodeLazyByteStringExplicit UTF8Strict $ s) >>= Base64.decode
+  parseJSON o@(Object _) = Cooked <$> parseJSON o
+  parseJSON v = typeMismatch "Chunk" v
+
+instance ToJSON Chunk where
+  toJSON (Raw bs) = String . T.pack . decodeLazyByteString UTF8Strict . Base64.encode $ bs
+  toJSON (Cooked block) = toJSON block
+
 -- | 'Block' is the entry point for our structured document format
 data Block = Line Line -- ^ a single 'Line' of text
            | VSpace Integer -- ^ vertical space of height equivalent to 'Integer' lines
            | NewlSep (Seq Block) -- ^ A sequence of 'Block's seperated by newlines
-           deriving (Generic, NFData, Show, CoArbitrary)
+           deriving (Generic, NFData, Show, CoArbitrary, FromJSON, ToJSON)
 
 {- | A 'Line' is one of:
 
@@ -75,7 +97,7 @@ We don't export all constructors and instead encourage the use of 'text'.
 data Line = Word Text
           | HSpace Integer
           | SpaceSep (Seq Line)
-          deriving (Generic, NFData, Show, CoArbitrary)
+          deriving (Generic, NFData, Show, CoArbitrary, FromJSON, ToJSON)
 
 instance Monoid Block where
   mempty = NewlSep mempty
-- 
cgit v1.2.3