1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
{-# LANGUAGE TypeOperators, DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
-- | A specification of an API for interacting with a set of printers
module Thermoprint.API
( PrinterStatus(..)
, JobStatus(..)
, PrintingError(..)
, DraftTitle
, ThermoprintAPI
, thermoprintAPI
, module Thermoprint.Identifiers
, module Thermoprint.Printout
) where
import Thermoprint.Printout
import Thermoprint.Identifiers
import Servant.API
import Data.Aeson
import Data.Set (Set)
import Data.Map (Map)
import qualified Data.Map as Map (foldMapWithKey, singleton)
import Data.Sequence (Seq)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap (foldMapWithKey, singleton)
import Data.Text (Text)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Data.Proxy (Proxy(..))
import Control.Exception (Exception)
instance (Integral k, Ord k, ToJSON v) => ToJSON (Map k v) where
toJSON = toJSON . Map.foldMapWithKey (IntMap.singleton . castId)
instance (Enum k, Ord k, FromJSON v) => FromJSON (Map k v) where
parseJSON = fmap (IntMap.foldMapWithKey $ Map.singleton . castId) . parseJSON
data PrinterStatus = Busy JobId
| Available
deriving (Generic, Show, FromJSON, ToJSON)
data JobStatus = Queued PrinterId
| Printing PrinterId
| Done
| Failed PrintingError
deriving (Generic, Show, Read, FromJSON, ToJSON)
data PrintingError = UnknownError
deriving (Typeable, Generic, NFData, Show, Read, FromJSON, ToJSON, Exception)
type DraftTitle = Text
type ThermoprintAPI = "printers" :> Get '[JSON] (Map PrinterId PrinterStatus)
:<|> "jobs" :> (
QueryParam "printer" PrinterId :> QueryParam "min" JobId :> QueryParam "max" JobId :> Get '[JSON] (Seq (JobId, JobStatus))
:<|> QueryParam "printer" PrinterId :> ReqBody '[JSON] Printout :> Post '[JSON] JobId
)
:<|> "job" :> Capture "jobId" JobId :> (
Get '[JSON] Printout
:<|> "status" :> Get '[JSON] JobStatus
:<|> Delete '[] ()
)
:<|> "drafts" :> (
Get '[JSON] (Map DraftId (Maybe DraftTitle))
:<|> QueryParam "title" DraftTitle :> ReqBody '[JSON] Printout :> Post '[JSON] DraftId
)
:<|> "draft" :> Capture "draftId" DraftId :> (
QueryParam "title" DraftTitle :> ReqBody '[JSON] Printout :> Put '[] ()
:<|> Get '[JSON] (Maybe DraftTitle, Printout)
:<|> Delete '[] ()
:<|> QueryParam "printer" PrinterId :> Post '[JSON] JobId
)
thermoprintAPI :: Proxy ThermoprintAPI
-- ^ Servant occasionally needs an object of this type
thermoprintAPI = Proxy
|
