diff --git a/servant-client-core/src/Servant/Client/Core.hs b/servant-client-core/src/Servant/Client/Core.hs index 822df161..bb078ee4 100644 --- a/servant-client-core/src/Servant/Client/Core.hs +++ b/servant-client-core/src/Servant/Client/Core.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} @@ -17,23 +16,34 @@ -- querying functions for each endpoint just from the type representing your -- API. module Servant.Client.Core - ( AuthClientData - , AuthenticateReq(..) - , clientIn + ( + -- * Client generation + clientIn , HasClient(..) + + -- * Authentication , mkAuthenticateReq - , ServantError(..) - , EmptyClient(..) - , RunClient(..) - , Request(..) - , defaultRequest - , Response(..) - , RequestBody(..) - , module Servant.Client.Core.Internal.BaseUrl + , AuthenticateReq(..) + , AuthClientData + + -- * Generic Client , ClientLike(..) , genericMkClientL , genericMkClientP - -- * Writing instances + , ServantError(..) + , EmptyClient(..) + + -- * Request + , Request(..) + , defaultRequest + , RequestBody(..) + + -- * Response + , Response(..) + , RunClient(..) + , module Servant.Client.Core.Internal.BaseUrl + + -- * Writing HasClient instances , addHeader , appendToQueryString , appendToPath @@ -84,13 +94,13 @@ import Servant.Client.Core.Internal.BaseUrl (BaseUrl (..), showBaseUrl) import Servant.Client.Core.Internal.BasicAuth import Servant.Client.Core.Internal.Class -import Servant.Client.Core.Internal.Request import Servant.Client.Core.Internal.Generic +import Servant.Client.Core.Internal.Request -- * Accessing APIs as a Client --- | 'client' allows you to produce operations to query an API from a client within --- a given monadic context `m` +-- | 'clientIn' allows you to produce operations to query an API from a client +-- within a 'RunClient' monad. -- -- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books -- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books @@ -108,9 +118,12 @@ clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api clientIn p pm = clientWithRoute pm p defaultRequest --- | This class lets us define how each API combinator --- influences the creation of an HTTP request. It's mostly --- an internal class, you can just use 'client'. +-- | This class lets us define how each API combinator influences the creation +-- of an HTTP request. +-- +-- Unless you are writing a new backend for @servant-client-core@ or new +-- combinators that you want to support client-generation, you can ignore this +-- class. class RunClient m => HasClient m api where type Client (m :: * -> *) (api :: *) :: * clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api diff --git a/servant-client-core/src/Servant/Client/Core/Internal/Class.hs b/servant-client-core/src/Servant/Client/Core/Internal/Class.hs index 37287fd9..5cf5ce1e 100644 --- a/servant-client-core/src/Servant/Client/Core/Internal/Class.hs +++ b/servant-client-core/src/Servant/Client/Core/Internal/Class.hs @@ -3,7 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} -{-| Types for possible backends to run client-side `Request` queries -} +-- | Types for possible backends to run client-side `Request` queries module Servant.Client.Core.Internal.Class where import Control.Monad (unless) diff --git a/servant-client-core/src/Servant/Client/Core/Internal/Request.hs b/servant-client-core/src/Servant/Client/Core/Internal/Request.hs index 8b9306d3..4d9475d1 100644 --- a/servant-client-core/src/Servant/Client/Core/Internal/Request.hs +++ b/servant-client-core/src/Servant/Client/Core/Internal/Request.hs @@ -28,6 +28,8 @@ import Web.HttpApiData (ToHttpApiData, toEncodedUrlPiece, toHeader) -- | A type representing possible errors in a request +-- +-- Note that this type substially change in 0.12 data ServantError = -- | The server returned an error response FailureResponse Response diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index bf03817f..5e2189c8 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -1,10 +1,13 @@ +-- | This module provides 'client' which can automatically generate +-- querying functions for each endpoint just from the type representing your +-- API. module Servant.Client - ( ClientEnv(..) + ( client , ClientM , runClientM - , client - , module X + , ClientEnv(..) + , module Servant.Client.Core ) where import Servant.Client.Internal.HttpClient -import Servant.Client.Core as X +import Servant.Client.Core diff --git a/servant-client/src/Servant/Client/Internal/HttpClient.hs b/servant-client/src/Servant/Client/Internal/HttpClient.hs index 93d831b9..b869290f 100644 --- a/servant-client/src/Servant/Client/Internal/HttpClient.hs +++ b/servant-client/src/Servant/Client/Internal/HttpClient.hs @@ -41,23 +41,36 @@ import Servant.Client.Core import qualified Network.HTTP.Client as Client +-- | The environment in which a request is run. data ClientEnv = ClientEnv { manager :: Client.Manager , baseUrl :: BaseUrl } +-- | Generates a set of client functions for an API. +-- +-- Example: +-- +-- > type API = Capture "no" Int :> Get '[JSON] Int +-- > :<|> Get '[JSON] [Bool] +-- > +-- > api :: Proxy API +-- > api = Proxy +-- > +-- > getInt :: Int -> ClientM Int +-- > getBools :: ClientM [Bool] +-- > getInt :<|> getBools = client api client :: HasClient ClientM api => Proxy api -> Client ClientM api client api = api `clientIn` (Proxy :: Proxy ClientM) -- | @ClientM@ is the monad in which client functions run. Contains the -- 'Manager' and 'BaseUrl' used for requests in the reader environment. -newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a } - deriving ( Functor, Applicative, Monad, MonadIO, Generic - , MonadReader ClientEnv - , MonadError ServantError - , MonadThrow, MonadCatch - ) +newtype ClientM a = ClientM + { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a } + deriving ( Functor, Applicative, Monad, MonadIO, Generic + , MonadReader ClientEnv, MonadError ServantError, MonadThrow + , MonadCatch) instance MonadBase IO ClientM where liftBase = ClientM . liftBase