diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-02-18 14:57:41 +0100 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-02-18 14:57:41 +0100 |
commit | c88197535f7a4c13b7464a785881a91a67ebd15b (patch) | |
tree | 4c5ba828566207560f941c58252519e140ba67e7 | |
parent | 072d7ad172d114121ae0d50f8c7841ace9699965 (diff) | |
download | thermoprint-c88197535f7a4c13b7464a785881a91a67ebd15b.tar thermoprint-c88197535f7a4c13b7464a785881a91a67ebd15b.tar.gz thermoprint-c88197535f7a4c13b7464a785881a91a67ebd15b.tar.bz2 thermoprint-c88197535f7a4c13b7464a785881a91a67ebd15b.tar.xz thermoprint-c88197535f7a4c13b7464a785881a91a67ebd15b.zip |
Full client & doc fixes
-rw-r--r-- | client/src/Thermoprint/Client.hs | 57 |
1 files changed, 39 insertions, 18 deletions
diff --git a/client/src/Thermoprint/Client.hs b/client/src/Thermoprint/Client.hs index 8299821..80045dd 100644 --- a/client/src/Thermoprint/Client.hs +++ b/client/src/Thermoprint/Client.hs | |||
@@ -35,31 +35,51 @@ import Prelude hiding (id, (.)) | |||
35 | -- | 35 | -- |
36 | -- > import Control.Category | 36 | -- > import Control.Category |
37 | -- > import Prelude hiding (id, (.)) | 37 | -- > import Prelude hiding (id, (.)) |
38 | -- > import Data.Either | ||
38 | -- > | 39 | -- > |
39 | -- > main :: IO () | 40 | -- > main :: IO () |
40 | -- > main = do | 41 | -- > -- ^ Display a list of printers with their status |
41 | -- > Client{..} <- mkClient id $ Http "localhost" 3000 | 42 | -- > main = either print print =<< runEitherT printers |
42 | -- > | 43 | -- > where Client{..} = mkClient id $ Http "localhost" 3000 |
43 | -- > print =<< runEitherT printers -- Display a list of printers with their status | ||
44 | data Client m = Client | 44 | data Client m = Client |
45 | { printers :: EitherT ServantError m (Map PrinterId PrinterStatus) | 45 | { printers :: EitherT ServantError m (Map PrinterId PrinterStatus) |
46 | -- ^ List all printers | 46 | -- ^ List all printers |
47 | , jobs :: Maybe PrinterId | 47 | , jobs :: Maybe PrinterId |
48 | -> Maybe JobId | 48 | -> Maybe JobId |
49 | -> Maybe JobId | 49 | -> Maybe JobId |
50 | -> Maybe UTCTime | 50 | -> Maybe UTCTime |
51 | -> Maybe UTCTime | 51 | -> Maybe UTCTime |
52 | -> EitherT ServantError m (Seq (JobId, UTCTime, JobStatus)) | 52 | -> EitherT ServantError m (Seq (JobId, UTCTime, JobStatus)) |
53 | -- ^ @jobs p minId maxId minTime maxTime@ lists a selection of jobs | 53 | -- ^ @jobs p minId maxId minTime maxTime@ lists a selection of jobs |
54 | , print :: Maybe PrinterId -> Printout -> EitherT ServantError m JobId | 54 | , jobCreate :: Maybe PrinterId -> Printout -> EitherT ServantError m JobId |
55 | -- ^ Send a 'Printout' to be queued | 55 | -- ^ Send a 'Printout' to be queued |
56 | , jobContents :: JobId -> EitherT ServantError m Printout | 56 | , job :: JobId -> EitherT ServantError m Printout |
57 | -- ^ Retrieve the contents of a job | ||
57 | , jobStatus :: JobId -> EitherT ServantError m JobStatus | 58 | , jobStatus :: JobId -> EitherT ServantError m JobStatus |
59 | -- ^ Query a jobs status | ||
58 | , jobDelete :: JobId -> EitherT ServantError m () | 60 | , jobDelete :: JobId -> EitherT ServantError m () |
61 | -- ^ Delete a job from the queue (not from history or while it is being printed) | ||
62 | , drafts :: EitherT ServantError m (Map DraftId (Maybe DraftTitle)) | ||
63 | -- ^ List all saved drafts | ||
64 | , draftCreate :: Maybe DraftTitle | ||
65 | -> Printout | ||
66 | -> EitherT ServantError m DraftId | ||
67 | -- ^ Create a new draft | ||
68 | , draftReplace :: DraftId | ||
69 | -> Maybe DraftTitle | ||
70 | -> Printout | ||
71 | -> EitherT ServantError m () | ||
72 | -- ^ Replace the contents and title of an existing draft | ||
73 | , draft :: DraftId -> EitherT ServantError m (Maybe DraftTitle, Printout) | ||
74 | -- ^ Retrieve the contents and title of a draft | ||
75 | , draftDelete :: DraftId -> EitherT ServantError m () | ||
76 | -- ^ Delete a draft | ||
77 | , draftPrint :: DraftId -> Maybe PrinterId -> EitherT ServantError m JobId | ||
78 | -- ^ Send a draft to be printed | ||
59 | } | 79 | } |
60 | 80 | ||
61 | withArg :: (a -> layoutA :<|> layoutB) -> (a -> layoutA) :<|> (a -> layoutB) | 81 | withArgs :: (x -> a :<|> b) -> ((x -> a) :<|> (x -> b)) |
62 | withArg outer = (\(a :<|> _) -> a) . outer :<|> (\(_ :<|> b) -> b) . outer | 82 | withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI |
63 | 83 | ||
64 | mkClient :: (IO :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can be constructed from 'IO' | 84 | mkClient :: (IO :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can be constructed from 'IO' |
65 | -> BaseUrl | 85 | -> BaseUrl |
@@ -68,7 +88,8 @@ mkClient :: (IO :~> m) -- ^ A monad functor ('Nat') used to make the api functio | |||
68 | mkClient n url = Client{..} | 88 | mkClient n url = Client{..} |
69 | where | 89 | where |
70 | printers | 90 | printers |
71 | :<|> (jobs :<|> print) | 91 | :<|> (jobs :<|> jobCreate) |
72 | :<|> (withArg -> jobContents :<|> (withArg -> jobStatus :<|> jobDelete)) | 92 | :<|> (withArgs -> job :<|> (withArgs -> jobStatus :<|> jobDelete)) |
73 | :<|> _ | 93 | :<|> (drafts :<|> draftCreate) |
94 | :<|> (withArgs -> draftReplace :<|> (withArgs -> draft :<|> (withArgs -> draftDelete :<|> draftPrint))) | ||
74 | = enter (hoistNat n) $ client thermoprintAPI url | 95 | = enter (hoistNat n) $ client thermoprintAPI url |