From c88197535f7a4c13b7464a785881a91a67ebd15b Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 18 Feb 2016 14:57:41 +0100
Subject: Full client & doc fixes

---
 client/src/Thermoprint/Client.hs | 57 +++++++++++++++++++++++++++-------------
 1 file changed, 39 insertions(+), 18 deletions(-)

(limited to 'client')

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, (.))
 --
 -- > import Control.Category
 -- > import Prelude hiding (id, (.))
+-- > import Data.Either
 -- >
 -- > main :: IO ()
--- > main = do
--- >   Client{..} <- mkClient id $ Http "localhost" 3000
--- >
--- >   print =<< runEitherT printers -- Display a list of printers with their status
+-- > -- ^ Display a list of printers with their status
+-- > main = either print print =<< runEitherT printers
+-- >   where Client{..} = mkClient id $ Http "localhost" 3000
 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
+            -> 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
+  , jobCreate :: Maybe PrinterId -> Printout -> EitherT ServantError m JobId
+                 -- ^ Send a 'Printout' to be queued
+  , job :: JobId -> EitherT ServantError m Printout
+           -- ^ Retrieve the contents of a job
   , jobStatus :: JobId -> EitherT ServantError m JobStatus
+                 -- ^ Query a jobs status
   , jobDelete :: JobId -> EitherT ServantError m ()
+                 -- ^ Delete a job from the queue (not from history or while it is being printed)
+  , drafts :: EitherT ServantError m (Map DraftId (Maybe DraftTitle))
+              -- ^ List all saved drafts
+  , draftCreate :: Maybe DraftTitle
+                -> Printout
+                -> EitherT ServantError m DraftId
+                -- ^ Create a new draft
+  , draftReplace :: DraftId
+                 -> Maybe DraftTitle
+                 -> Printout
+                 -> EitherT ServantError m ()
+                 -- ^ Replace the contents and title of an existing draft
+  , draft :: DraftId -> EitherT ServantError m (Maybe DraftTitle, Printout)
+             -- ^ Retrieve the contents and title of a draft
+  , draftDelete :: DraftId -> EitherT ServantError m ()
+                   -- ^ Delete a draft
+  , draftPrint :: DraftId -> Maybe PrinterId -> EitherT ServantError m JobId
+                  -- ^ Send a draft to be printed
   }
 
-withArg :: (a -> layoutA :<|> layoutB) -> (a -> layoutA) :<|> (a -> layoutB)
-withArg outer = (\(a :<|> _) -> a) . outer :<|> (\(_ :<|> b) -> b) . outer
+withArgs :: (x -> a :<|> b) -> ((x -> a) :<|> (x -> b))
+withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI
 
 mkClient :: (IO :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can be constructed from 'IO'
          -> BaseUrl
@@ -68,7 +88,8 @@ mkClient :: (IO :~> m) -- ^ A monad functor ('Nat') used to make the api functio
 mkClient n url = Client{..}
   where
     printers
-      :<|> (jobs :<|> print)
-      :<|> (withArg -> jobContents :<|> (withArg -> jobStatus :<|> jobDelete))
-      :<|> _
+      :<|> (jobs :<|> jobCreate)
+      :<|> (withArgs -> job :<|> (withArgs -> jobStatus :<|> jobDelete))
+      :<|> (drafts :<|> draftCreate)
+      :<|> (withArgs -> draftReplace :<|> (withArgs -> draft :<|> (withArgs -> draftDelete :<|> draftPrint)))
       = enter (hoistNat n) $ client thermoprintAPI url
-- 
cgit v1.2.3