{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RecordWildCards #-} -- | A client library for 'Thermoprint.API' module Thermoprint.Client ( Client(..) , mkClient -- = 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.Category import Prelude hiding (id, (.)) -- | All 'ThermoprintAPI'-functions as a record -- -- Use like this: -- -- > import Control.Category -- > import Prelude hiding (id, (.)) -- > -- > main :: IO () -- > main = do -- > Client{..} <- mkClient id $ Http "localhost" 3000 -- > -- > print =<< runEitherT printers -- Display a list of printers with their status data Client m = Client { printers :: EitherT ServantError m (Map PrinterId PrinterStatus) -- ^ List all printers , jobs :: Maybe PrinterId -> Maybe JobId -> Maybe JobId -> Maybe UTCTime -> Maybe UTCTime -> EitherT ServantError m (Seq (JobId, UTCTime, JobStatus)) -- ^ @jobs p minId maxId minTime maxTime@ lists a selection of jobs , print :: Maybe PrinterId -> Printout -> EitherT ServantError m JobId -- ^ Send a 'Printout' to be queued , jobContents :: JobId -> EitherT ServantError m Printout , jobStatus :: JobId -> EitherT ServantError m JobStatus , jobDelete :: JobId -> EitherT ServantError m () } withArg :: (a -> layoutA :<|> layoutB) -> (a -> layoutA) :<|> (a -> layoutB) withArg outer = (\(a :<|> _) -> a) . outer :<|> (\(_ :<|> b) -> b) . outer mkClient :: (IO :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can be constructed from 'IO' -> BaseUrl -> Client m -- ^ Generate a 'Client' mkClient n url = Client{..} where printers :<|> (jobs :<|> print) :<|> (withArg -> jobContents :<|> (withArg -> jobStatus :<|> jobDelete)) :<|> _ = enter (hoistNat n) $ client thermoprintAPI url