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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
---
title: Deriving a Client Library for Interacting with Character-Oriented Printers
tags: Thermoprint
published: 2016-02-18
repo: https://git.yggdrasil.li/thermoprint?h=rewrite
---
> {-# 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
We encapsulate all api operations in a single record parametrized over the monad we intend to use
them in.
Construction of such a record is pure since all we require to do so is a `BaseUrl`{.haskell}.
Using RecordWildCards we can bring all operations into scope with extreme ease.
> -- | 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
> }
[servant documentation](https://haskell-servant.github.io/tutorial/server.html#nested-apis)
advises factoring out apis to make the specification more concise.
We are rightly advised that doing so has an effect on the types of the
corresponding `Server`{.haskell}s and `Client`{.haskell}s.
To cope with this we introduce a helper function that allows us, when
used with ViewPatterns, to nontheless simply pattern match on `client`{.haskell}.
> withArgs :: (x -> a :<|> b) -> ((x -> a) :<|> (x -> b))
> -- ^ Undo factoring of APIs
> withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI
`withArgs`{.haskell} as presented here does not recurse and thus
doesn't handle more than one occurence of `:<|>`{.haskell}.
We have to to so ourselves using nested ViewPatterns (see
`mkClient`{.haskell}).
> 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'
RecordWildCards also allows us to construct a record from components
in scope.
> 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
We also provide some additional convenience functions so the user
doesn't have to construct their own `Nat`{.haskell}ural
transformations.
> 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
|
