added ClientEnv data type and runClientM

doc/tutorial/Client.lhs

@@ -71,19 +71,13 @@ What we are going to get with **servant-client** here is 3 functions, one to que
 ``` haskell
 position :: Int -- ^ value for "x"
          -> Int -- ^ value for "y"
-         -> Manager -- ^ the HTTP client to use
+         -> ClientM Position
-         -> BaseUrl -- ^ the URL at which the API can be found
-         -> ExceptT ServantError IO Position
 
 hello :: Maybe String -- ^ an optional value for "name"
-      -> Manager -- ^ the HTTP client to use
+      -> ClientM HelloMessage
-      -> BaseUrl -- ^ the URL at which the API can be found
-      -> ExceptT ServantError IO HelloMessage
 
 marketing :: ClientInfo -- ^ value for the request body
-          -> Manager -- ^ the HTTP client to use
+          -> ClientM Email
-          -> BaseUrl -- ^ the URL at which the API can be found
-          -> ExceptT ServantError IO Email
 ```
 
 Each function makes available as an argument any value that the response may
@@ -120,17 +114,17 @@ data BaseUrl = BaseUrl
 That's it. Let's now write some code that uses our client functions.
 
 ``` haskell
-queries :: Manager -> BaseUrl -> ExceptT ServantError IO (Position, HelloMessage, Email)
+queries :: ClientM (Position, HelloMessage, Email)
-queries manager baseurl = do
+queries = do
-  pos <- position 10 10 manager baseurl
+  pos <- position 10 10 
-  message <- hello (Just "servant") manager baseurl
+  message <- hello (Just "servant") 
-  em  <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]) manager baseurl
+  em  <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"])
   return (pos, message, em)
 
 run :: IO ()
 run = do
   manager <- newManager defaultManagerSettings
-  res <- runExceptT (queries manager (BaseUrl Http "localhost" 8081 ""))
+  res <- runClientM queries (ClientEnv manager (BaseUrl Http "localhost" 8081 ""))
   case res of
     Left err -> putStrLn $ "Error: " ++ show err
     Right (pos, message, em) -> do

servant-client/src/Servant/Client.hs

@@ -20,6 +20,8 @@ module Servant.Client
   , client
   , HasClient(..)
   , ClientM
+  , runClientM
+  , ClientEnv (ClientEnv)
   , mkAuthenticateReq
   , ServantError(..)
   , module Servant.Common.BaseUrl
@@ -28,6 +30,7 @@ module Servant.Client
 #if !MIN_VERSION_base(4,8,0)
 import           Control.Applicative        ((<$>))
 #endif
+import           Control.Monad.Reader       (ask)
 import           Data.ByteString.Lazy       (ByteString)
 import           Data.List
 import           Data.Proxy
@@ -154,16 +157,16 @@ instance OVERLAPPABLE_
   -- Note [Non-Empty Content Types]
   (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
   ) => HasClient (Verb method status cts' a) where
-  type Client (Verb method status cts' a) = Manager -> BaseUrl -> ClientM a
+  type Client (Verb method status cts' a) = ClientM a
-  clientWithRoute Proxy req manager baseurl =
+  clientWithRoute Proxy req = do
     snd <$> performRequestCT (Proxy :: Proxy ct) method req
       where method = reflectMethod (Proxy :: Proxy method)
 
 instance OVERLAPPING_
   (ReflectMethod method) => HasClient (Verb method status cts NoContent) where
   type Client (Verb method status cts NoContent)
-    = Manager -> BaseUrl -> ClientM NoContent
+    = ClientM NoContent
-  clientWithRoute Proxy req manager baseurl =
+  clientWithRoute Proxy req = do
     performRequestNoBody method req >> return NoContent
       where method = reflectMethod (Proxy :: Proxy method)
 
@@ -172,8 +175,8 @@ instance OVERLAPPING_
   ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
   ) => HasClient (Verb method status cts' (Headers ls a)) where
   type Client (Verb method status cts' (Headers ls a))
-    = Manager -> BaseUrl -> ClientM (Headers ls a)
+    = ClientM (Headers ls a)
-  clientWithRoute Proxy req manager baseurl = do
+  clientWithRoute Proxy req = do
     let method = reflectMethod (Proxy :: Proxy method)
     (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req 
     return $ Headers { getResponse = resp
@@ -184,8 +187,8 @@ instance OVERLAPPING_
   ( BuildHeadersTo ls, ReflectMethod method
   ) => HasClient (Verb method status cts (Headers ls NoContent)) where
   type Client (Verb method status cts (Headers ls NoContent))
-    = Manager -> BaseUrl -> ClientM (Headers ls NoContent)
+    = ClientM (Headers ls NoContent)
-  clientWithRoute Proxy req manager baseurl = do
+  clientWithRoute Proxy req = do
     let method = reflectMethod (Proxy :: Proxy method)
     hdrs <- performRequestNoBody method req 
     return $ Headers { getResponse = NoContent

servant-client/src/Servant/Common/Req.hs

@@ -152,23 +152,31 @@ parseRequest url = liftM disableStatusCheck (parseUrl url)
 displayHttpRequest :: Method -> String
 displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
 
+-- previously: 
 --type ClientM = ExceptT ServantError IO
 
-newtype ClientM a = ClientM (ReaderT (Manager, BaseUrl) (ExceptT ServantError IO) a )
+data ClientEnv
+  = ClientEnv
+  { manager :: Manager
+  , baseUrl :: BaseUrl
+  }
+
+newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a }
                     deriving ( Functor, Applicative, Monad, MonadIO
-                             , MonadReader (Manager, BaseUrl)
+                             , MonadReader ClientEnv
                              , MonadError ServantError
                              )
 
-runClientM :: ClientM a -> (Manager, BaseUrl) -> (ExceptT ServantError IO) a
+runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
-runClientM = undefined
+runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
 
 
 performRequest :: Method -> Req 
                -> ClientM ( Int, ByteString, MediaType
                           , [HTTP.Header], Response ByteString)
 performRequest reqMethod req = do
-  (manager, reqHost) <- ask
+  manager <- asks manager
+  reqHost <- asks baseUrl
   partialRequest <- liftIO $ reqToRequest req reqHost
 
   let request = partialRequest { Client.method = reqMethod }