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
102
103
104
105
106
107
108
109
110
111
112
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
{-# LANGUAGE TypeOperators, DataKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# 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
import Data.Encoding.Exception (EncodingException(..))
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, FromJSON, ToJSON)
deriving instance Generic EncodingException
deriving instance NFData EncodingException
deriving instance FromJSON EncodingException
deriving instance ToJSON EncodingException
data PrintingError = IOError String -- ^ Not the actual error because we can't marshal that to JSON
| EncError EncodingException -- ^ Could not encode some part of the 'Printout'
deriving (Typeable, Generic, NFData, Show, FromJSON, ToJSON)
instance Exception PrintingError
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
|
