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
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
-- | A client library for 'Thermoprint.API'
module Thermoprint.Client
( Client(..)
, mkClient
-- = Reexports
, ServantError(..)
, module Servant.Common.BaseUrl
, module Control.Monad.Trans.Either
, module Servant.Server.Internal.Enter
) where
import Thermoprint.API
import Data.Map (Map)
import Data.Sequence (Seq)
import Data.Time (UTCTime)
import Servant.Client hiding (HasClient(..))
import qualified Servant.Client as S
import Servant.Common.BaseUrl
import Servant.API
import Servant.Server.Internal.Enter
import Control.Monad.Trans.Either
import Control.Category
import Prelude hiding (id, (.))
-- | All 'ThermoprintAPI'-functions as a record
--
-- Use like this:
--
-- > import Control.Category
-- > import Prelude hiding (id, (.))
-- > import Data.Either
-- >
-- > main :: IO ()
-- > -- ^ Display a list of printers with their status
-- > main = either print print =<< runEitherT printers
-- > where Client{..} = mkClient id $ Http "localhost" 3000
data Client m = Client
{ printers :: EitherT ServantError m (Map PrinterId PrinterStatus)
-- ^ List all printers
, jobs :: Maybe PrinterId
-> Maybe JobId
-> Maybe JobId
-> Maybe UTCTime
-> Maybe UTCTime
-> EitherT ServantError m (Seq (JobId, UTCTime, JobStatus))
-- ^ @jobs p minId maxId minTime maxTime@ lists a selection of jobs
, jobCreate :: Maybe PrinterId -> Printout -> EitherT ServantError m JobId
-- ^ Send a 'Printout' to be queued
, job :: JobId -> EitherT ServantError m Printout
-- ^ Retrieve the contents of a job
, jobStatus :: JobId -> EitherT ServantError m JobStatus
-- ^ Query a jobs status
, jobDelete :: JobId -> EitherT ServantError m ()
-- ^ Delete a job from the queue (not from history or while it is being printed)
, drafts :: EitherT ServantError m (Map DraftId (Maybe DraftTitle))
-- ^ List all saved drafts
, draftCreate :: Maybe DraftTitle
-> Printout
-> EitherT ServantError m DraftId
-- ^ Create a new draft
, draftReplace :: DraftId
-> Maybe DraftTitle
-> Printout
-> EitherT ServantError m ()
-- ^ Replace the contents and title of an existing draft
, draft :: DraftId -> EitherT ServantError m (Maybe DraftTitle, Printout)
-- ^ Retrieve the contents and title of a draft
, draftDelete :: DraftId -> EitherT ServantError m ()
-- ^ Delete a draft
, draftPrint :: DraftId -> Maybe PrinterId -> EitherT ServantError m JobId
-- ^ Send a draft to be printed
}
withArgs :: (x -> a :<|> b) -> ((x -> a) :<|> (x -> b))
withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI
mkClient :: (IO :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can be constructed from 'IO'
-> BaseUrl
-> Client m
-- ^ Generate a 'Client'
mkClient n url = Client{..}
where
printers
:<|> (jobs :<|> jobCreate)
:<|> (withArgs -> job :<|> (withArgs -> jobStatus :<|> jobDelete))
:<|> (drafts :<|> draftCreate)
:<|> (withArgs -> draftReplace :<|> (withArgs -> draft :<|> (withArgs -> draftDelete :<|> draftPrint)))
= enter (hoistNat n) $ client thermoprintAPI url
|
