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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
{-# 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 qualified Data.Text as T
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Data.Proxy (Proxy(..))
import Control.Exception (Exception)
import Data.Time (UTCTime)
import Data.Time.Format
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
instance FromText UTCTime where
fromText = parseTimeM True defaultTimeLocale "%F_%T%Q" . T.unpack
instance ToText UTCTime where
toText = T.pack . formatTime defaultTimeLocale "%F_%T%Q"
type ThermoprintAPI = "printers" :> Get '[JSON] (Map PrinterId PrinterStatus)
:<|> "jobs" :> (
QueryParam "printer" PrinterId
:> QueryParam "min" JobId
:> QueryParam "max" JobId
:> QueryParam "minTime" UTCTime
:> QueryParam "maxTime" UTCTime
:> Get '[JSON] (Seq (JobId, UTCTime, 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
|
