From 6ec3c805ea2cd629a75641530de30ab39a191409 Mon Sep 17 00:00:00 2001 From: Gregor Kleen 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 +++++++++++++++++++++++++--- spec/test/Thermoprint/PrintoutSpec.hs | 17 +++++++++++++++++ spec/thermoprint-spec.cabal | 8 +++++++- spec/thermoprint-spec.nix | 14 ++++++++++++-- 5 files changed, 82 insertions(+), 6 deletions(-) create mode 100644 spec/src/Thermoprint/API.hs (limited to 'spec') 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; -- cgit v1.2.3