aboutsummaryrefslogtreecommitdiff
path: root/client
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-02-18 14:57:41 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2016-02-18 14:57:41 +0100
commitc88197535f7a4c13b7464a785881a91a67ebd15b (patch)
tree4c5ba828566207560f941c58252519e140ba67e7 /client
parent072d7ad172d114121ae0d50f8c7841ace9699965 (diff)
downloadthermoprint-c88197535f7a4c13b7464a785881a91a67ebd15b.tar
thermoprint-c88197535f7a4c13b7464a785881a91a67ebd15b.tar.gz
thermoprint-c88197535f7a4c13b7464a785881a91a67ebd15b.tar.bz2
thermoprint-c88197535f7a4c13b7464a785881a91a67ebd15b.tar.xz
thermoprint-c88197535f7a4c13b7464a785881a91a67ebd15b.zip
Full client & doc fixes
Diffstat (limited to 'client')
-rw-r--r--client/src/Thermoprint/Client.hs57
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
44data Client m = Client 44data 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
61withArg :: (a -> layoutA :<|> layoutB) -> (a -> layoutA) :<|> (a -> layoutB) 81withArgs :: (x -> a :<|> b) -> ((x -> a) :<|> (x -> b))
62withArg outer = (\(a :<|> _) -> a) . outer :<|> (\(_ :<|> b) -> b) . outer 82withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI
63 83
64mkClient :: (IO :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can be constructed from 'IO' 84mkClient :: (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
68mkClient n url = Client{..} 88mkClient 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