First stab at API

5 files changed, 82 insertions, 6 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 @@
+{-# 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
diff --git a/spec/test/Thermoprint/PrintoutSpec.hs b/spec/test/Thermoprint/PrintoutSpec.hs
index 5a48496..b92d76a 100644
--- a/spec/test/Thermoprint/PrintoutSpec.hs
+++ b/spec/test/Thermoprint/PrintoutSpec.hs
@@ -1,9 +1,26 @@
+{-# LANGUAGE StandaloneDeriving #-}
+
 module Thermoprint.PrintoutSpec (spec) where
 
 import Test.Hspec
 import Test.Hspec.QuickCheck (prop)
 import Thermoprint.Printout
 
+import Data.Aeson (fromJSON, ToJSON(..), Result(..))
+import Data.Function (on)
+
+import Control.DeepSeq (($!!), force)
+
+-- Equality via cotext on Block
+instance Eq Block where
+  (==) = (==) `on` cotext
+-- Structural equality for Chunk 
+deriving instance Eq Chunk
+
 spec :: Spec
 spec = do
   prop "prop_text" prop_text
+  prop "json" prop_json
+  where
+    prop_json :: Printout -> Bool
+    prop_json p = force $ (== Success p) . fromJSON . toJSON $!! p
diff --git a/spec/thermoprint-spec.cabal b/spec/thermoprint-spec.cabal
index c4599c8..426244e 100644
--- a/spec/thermoprint-spec.cabal
+++ b/spec/thermoprint-spec.cabal
@@ -19,6 +19,7 @@ cabal-version:       >=1.10
 library
   hs-source-dirs:      src
   exposed-modules:     Thermoprint.Printout
+                     , Thermoprint.API
   -- other-modules:       
   -- other-extensions:    
   extensions:          DeriveGeneric
@@ -33,6 +34,10 @@ library
                      , quickcheck-instances >=0.3.11 && <4
                      , Cabal >=1.22.4 && <2
                      , cabal-test-quickcheck >=0.1.6 && <1
+                     , servant >=0.4.4 && <1
+                     , aeson >=0.9.0 && <1
+                     , base64-bytestring >=1.0.0 && <2
+                     , encoding >=0.8 && <1
   -- hs-source-dirs:      
   default-language:    Haskell2010
 
@@ -44,4 +49,5 @@ Test-Suite tests
                      , thermoprint-spec -any
                      , hspec >=2.2.1 && <3
                      , QuickCheck >=2.8.1 && <3
-                     , quickcheck-instances >=0.3.11 && <4
\ No newline at end of file
+                     , quickcheck-instances >=0.3.11 && <4
+                     , aeson >=0.9.0 && <1
\ No newline at end of file
diff --git a/spec/thermoprint-spec.nix b/spec/thermoprint-spec.nix
index 82f018a..ea903ba 100644
--- a/spec/thermoprint-spec.nix
+++ b/spec/thermoprint-spec.nix
@@ -1,9 +1,19 @@
-{ mkDerivation, base, bytestring, containers, stdenv, text, QuickCheck, quickcheck-instances, cabal-test-quickcheck, hspec }:
+{ mkDerivation, aeson, base, base64-bytestring, bytestring, Cabal
+, cabal-test-quickcheck, containers, deepseq, encoding, hspec
+, QuickCheck, quickcheck-instances, servant, stdenv, text
+}:
 mkDerivation {
   pname = "thermoprint-spec";
   version = "1.0.0";
   src = ./.;
-  libraryHaskellDepends = [ base bytestring containers text QuickCheck quickcheck-instances cabal-test-quickcheck hspec ];
+  libraryHaskellDepends = [
+    aeson base base64-bytestring bytestring Cabal cabal-test-quickcheck
+    containers deepseq encoding QuickCheck quickcheck-instances servant
+    text
+  ];
+  testHaskellDepends = [
+    base hspec QuickCheck quickcheck-instances
+  ];
   homepage = "http://dirty-haskell.org/tags/thermoprint.html";
   description = "A specification of the API and the payload datatypes and associated utilities";
   license = stdenv.lib.licenses.publicDomain;