diff options
| -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 | 
