From 7065a8cc1b8b01cd32d4b1d5317b323fec5238bd Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 7 Mar 2017 14:16:21 +0100
Subject: Bump versions

---
 client/src/Thermoprint/Client.hs | 55 ++++++++++------------------------------
 1 file changed, 14 insertions(+), 41 deletions(-)

(limited to 'client/src')

diff --git a/client/src/Thermoprint/Client.hs b/client/src/Thermoprint/Client.hs
index 448a912..46f6073 100644
--- a/client/src/Thermoprint/Client.hs
+++ b/client/src/Thermoprint/Client.hs
@@ -5,12 +5,12 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RankNTypes #-}
 
 -- | A client library for 'Thermoprint.API'
 module Thermoprint.Client
        ( Client(..)
        , mkClient, mkClient'
-       , throwNat, ioNat
        -- = Reexports
        , ServantError(..)
        , module Thermoprint.API
@@ -27,10 +27,11 @@ import Data.Time (UTCTime)
 import Servant.Client hiding (HasClient(..))
 import qualified Servant.Client as S
 import Servant.Common.BaseUrl
+import Servant.Common.Req
 import Network.HTTP.Client (Manager, ManagerSettings, newManager, defaultManagerSettings)
 import Servant.API
 import Servant.Utils.Enter
-import Control.Monad.Except (ExceptT, runExceptT)
+import Control.Monad.Except (ExceptT(..), runExceptT)
 
 import Control.Monad.Reader (ReaderT, runReaderT, ask)
 import Control.Monad.Catch (Exception, MonadThrow(..))
@@ -92,29 +93,10 @@ withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI
 
 mkClientS :: Monad m
           => (ClientM :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can do 'IO' and handle errors
-          -> ManagerSettings
-          -> BaseUrl
           -> Client m
 -- ^ Generate a 'Client'
-mkClientS n mgrS url = Client
-                       { printers = clientF n printers
-                       , jobs = \a b c -> clientF n $ jobs a b c
-                       , jobCreate = \a b -> clientF n $ jobCreate a b
-                       , job = \a -> clientF n $ job a
-                       , jobStatus = \a -> clientF n $ jobStatus a
-                       , jobDelete = \a -> clientF n $ jobDelete a
-                       , drafts = clientF n drafts
-                       , draftCreate = \a b -> clientF n $ draftCreate a b
-                       , draftReplace = \a b c -> clientF n $ draftReplace a b c
-                       , draft = \a -> clientF n $ draft a
-                       , draftDelete = \a -> clientF n $ draftDelete a
-                       , draftPrint = \a b -> clientF n $ draftPrint a b
-                       }
+mkClientS n = Client{..}
   where
-    clientF :: Monad m => (ClientM :~> m) -> (Manager -> BaseUrl -> m a) -> m a
-    clientF n f = do
-      mgr <- unNat n $ (liftIO $ newManager mgrS :: ClientM Manager)
-      f mgr url
     printers
       :<|> (jobs :<|> jobCreate)
       :<|> (withArgs -> job :<|> (withArgs -> jobStatus :<|> jobDelete))
@@ -122,23 +104,14 @@ mkClientS n mgrS url = Client
       :<|> (withArgs -> draftReplace :<|> (withArgs -> draft :<|> (withArgs -> draftDelete :<|> draftPrint)))
       = enter n $ client thermoprintAPI
 
-mkClient :: Monad m
-         => (ClientM :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can do 'IO' and handle errors
-         -> BaseUrl
-         -> Client m
-mkClient n url = mkClientS n defaultManagerSettings url
-  
-mkClient' :: (MonadThrow m, MonadIO m) => BaseUrl -> Client m
--- ^ @mkClient' = mkClient $ ioNat . throwNat@
-mkClient' = mkClient $ ioNat . throwNat
-
-throwNat :: (Exception e, MonadThrow m) => ExceptT e m :~> m
--- ^ Squash a layer of 'EitherT' into the underlying monad supporting 'throwM'
-throwNat = Nat $ either throwM return <=< runExceptT
-
-ioNat :: MonadIO m => IO :~> m
--- ^ @ioNat = Nat liftIO@
-ioNat = Nat liftIO
+mkClient :: (MonadThrow m, MonadIO m) => ManagerSettings -> BaseUrl -> Client m
+mkClient mSettings url = mkClientS $ Nat clientNat
+  where
+    clientNat :: forall m a. (MonadThrow m, MonadIO m) => ClientM a -> m a
+    clientNat cAct = do
+      mgr <- liftIO $ newManager mSettings
+      either throwM return =<< liftIO (runClientM cAct $ ClientEnv mgr url)
 
-readerNat :: a -> ReaderT a m :~> m
-readerNat a = Nat $ flip runReaderT a
+mkClient' :: (MonadThrow m, MonadIO m) => BaseUrl -> Client m
+-- ^ @mkClient' = mkClient defaultManagerSettings
+mkClient' = mkClient defaultManagerSettings
-- 
cgit v1.2.3