{-# 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, FromJSON, ToJSON) data PrintingError = UnknownError deriving (Typeable, Generic, NFData, Show, 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