From 072d7ad172d114121ae0d50f8c7841ace9699965 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 17 Feb 2016 23:46:48 +0000
Subject: Started work on client library

---
 client/src/Thermoprint/Client.hs | 74 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 74 insertions(+)
 create mode 100644 client/src/Thermoprint/Client.hs

(limited to 'client/src/Thermoprint/Client.hs')

diff --git a/client/src/Thermoprint/Client.hs b/client/src/Thermoprint/Client.hs
new file mode 100644
index 0000000..8299821
--- /dev/null
+++ b/client/src/Thermoprint/Client.hs
@@ -0,0 +1,74 @@
+{-# 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
-- 
cgit v1.2.3