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
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
-- | A client library for 'Thermoprint.API'
module Thermoprint.Client
( Client(..)
, mkClient, mkClient'
, throwNat, ioNat
-- = 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.Monad.Catch (Exception, MonadThrow(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad
import Control.Category
import Prelude hiding (id, (.))
instance Exception ServantError
-- | All 'ThermoprintAPI'-functions as a record
--
-- Use like this:
--
-- > {-# LANGUAGE RecordWildCards #-}
-- >
-- > main :: IO ()
-- > -- ^ Display a list of printers with their status
-- > main = print =<< printers
-- > where Client{..} = mkClient' $ Http "localhost" 3000
data Client m = Client
{ printers :: m (Map PrinterId PrinterStatus)
-- ^ List all printers
, jobs :: Maybe PrinterId
-> Maybe (Range (JobId))
-> Maybe (Range (UTCTime))
-> m (Seq (JobId, UTCTime, JobStatus))
-- ^ List a selection of jobs
, jobCreate :: Maybe PrinterId -> Printout -> m JobId
-- ^ Send a 'Printout' to be queued
, job :: JobId -> m Printout
-- ^ Retrieve the contents of a job
, jobStatus :: JobId -> m JobStatus
-- ^ Query a jobs status
, jobDelete :: JobId -> m ()
-- ^ Delete a job from the queue (not from history or while it is being printed)
, drafts :: m (Map DraftId (Maybe DraftTitle))
-- ^ List all saved drafts
, draftCreate :: Maybe DraftTitle
-> Printout
-> m DraftId
-- ^ Create a new draft
, draftReplace :: DraftId
-> Maybe DraftTitle
-> Printout
-> m ()
-- ^ Replace the contents and title of an existing draft
, draft :: DraftId -> m (Maybe DraftTitle, Printout)
-- ^ Retrieve the contents and title of a draft
, draftDelete :: DraftId -> m ()
-- ^ Delete a draft
, draftPrint :: DraftId -> Maybe PrinterId -> m JobId
-- ^ Send a draft to be printed
}
withArgs :: (x -> a :<|> b) -> ((x -> a) :<|> (x -> b))
-- ^ Undo factoring of APIs
withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI
mkClient :: (EitherT ServantError IO :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can do 'IO' and handle errors
-> 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 n $ client thermoprintAPI url
mkClient' :: (MonadThrow m, MonadIO m) => BaseUrl -> Client m
-- ^ @mkClient' = mkClient $ ioNat . throwNat@
mkClient' = mkClient $ ioNat . throwNat
throwNat :: (Exception e, MonadThrow m) => EitherT e m :~> m
-- ^ Squash a layer of 'EitherT' into the underlying monad supporting 'throwM'
throwNat = Nat $ either throwM return <=< runEitherT
ioNat :: MonadIO m => IO :~> m
-- ^ @ioNat = Nat liftIO@
ioNat = Nat liftIO
|
