Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api
- class RunClient m => HasClient m api where
- data EmptyClient = EmptyClient
- data AsClientT (m :: * -> *)
- (//) :: a -> (a -> b) -> b
- (/:) :: (a -> b -> c) -> b -> a -> c
- foldMapUnion :: forall c a (as :: [Type]). All c as => Proxy c -> (forall x. c x => x -> a) -> Union as -> a
- matchUnion :: forall a (as :: [Type]). IsMember a as => Union as -> Maybe a
Documentation
clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api Source #
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 myApi :: Proxy MyApi myApi = Proxy clientM :: Proxy ClientM clientM = Proxy getAllBooks :: ClientM [Book] postNewBook :: Book -> ClientM Book (getAllBooks :<|> postNewBook) = myApi `clientIn` clientM
class RunClient m => HasClient m api where Source #
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.
clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api Source #
hoistClientMonad :: Proxy m -> Proxy api -> (forall x. mon x -> mon' x) -> Client mon api -> Client mon' api Source #
Instances
(RunClient m, TypeError (NoInstanceFor (HasClient m api)) :: Constraint) => HasClient m api Source # | |
RunClient m => HasClient m Raw Source # | Pick a |
RunClient m => HasClient m EmptyAPI Source # | The client for type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books :<|> "nothing" :> EmptyAPI myApi :: Proxy MyApi myApi = Proxy getAllBooks :: ClientM [Book] (getAllBooks :<|> EmptyClient) = client myApi |
(forall (n :: Type -> Type). GClient api n, HasClient m (ToServantApi api), RunClient m) => HasClient m (NamedRoutes api) Source # | |
Defined in Servant.Client.Core.HasClient type Client m (NamedRoutes api) Source # clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api) Source # hoistClientMonad :: Proxy m -> Proxy (NamedRoutes api) -> (forall x. mon x -> mon' x) -> Client mon (NamedRoutes api) -> Client mon' (NamedRoutes api) Source # | |
(RunClient m, ReflectMethod method) => HasClient m (NoContentVerb method) Source # | |
Defined in Servant.Client.Core.HasClient type Client m (NoContentVerb method) Source # clientWithRoute :: Proxy m -> Proxy (NoContentVerb method) -> Request -> Client m (NoContentVerb method) Source # hoistClientMonad :: Proxy m -> Proxy (NoContentVerb method) -> (forall x. mon x -> mon' x) -> Client mon (NoContentVerb method) -> Client mon' (NoContentVerb method) Source # | |
(HasClient m a, HasClient m b) => HasClient m (a :<|> b) Source # | A client querying function for type MyApi = "books" :> Get '[JSON] [Book] -- GET /books :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books myApi :: Proxy MyApi myApi = Proxy getAllBooks :: ClientM [Book] postNewBook :: Book -> ClientM Book (getAllBooks :<|> postNewBook) = client myApi |
Defined in Servant.Client.Core.HasClient | |
(RunClient m, TypeError (NoInstanceForSub (HasClient m) ty) :: Constraint) => HasClient m (ty :> sub) Source # | |
Defined in Servant.Client.Core.HasClient | |
(RunClient m, TypeError (PartialApplication HasClient arr) :: Constraint) => HasClient m (arr :> sub) Source # | |
Defined in Servant.Client.Core.HasClient | |
HasClient m api => HasClient m (BasicAuth realm usr :> api) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (BasicAuth realm usr :> api) -> Request -> Client m (BasicAuth realm usr :> api) Source # hoistClientMonad :: Proxy m -> Proxy (BasicAuth realm usr :> api) -> (forall x. mon x -> mon' x) -> Client mon (BasicAuth realm usr :> api) -> Client mon' (BasicAuth realm usr :> api) Source # | |
(AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api) => HasClient m (Fragment a :> api) Source # | Ignore Example: type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book] myApi :: Proxy MyApi myApi = Proxy getBooks :: ClientM [Book] getBooks = client myApi -- then you can just use "getBooksBy" to query that endpoint. -- 'getBooks' for all books. |
Defined in Servant.Client.Core.HasClient | |
HasClient m api => HasClient m (AuthProtect tag :> api) Source # | |
Defined in Servant.Client.Core.HasClient type Client m (AuthProtect tag :> api) Source # clientWithRoute :: Proxy m -> Proxy (AuthProtect tag :> api) -> Request -> Client m (AuthProtect tag :> api) Source # hoistClientMonad :: Proxy m -> Proxy (AuthProtect tag :> api) -> (forall x. mon x -> mon' x) -> Client mon (AuthProtect tag :> api) -> Client mon' (AuthProtect tag :> api) Source # | |
HasClient m subapi => HasClient m (WithNamedContext name context subapi) Source # | |
Defined in Servant.Client.Core.HasClient type Client m (WithNamedContext name context subapi) Source # clientWithRoute :: Proxy m -> Proxy (WithNamedContext name context subapi) -> Request -> Client m (WithNamedContext name context subapi) Source # hoistClientMonad :: Proxy m -> Proxy (WithNamedContext name context subapi) -> (forall x. mon x -> mon' x) -> Client mon (WithNamedContext name context subapi) -> Client mon' (WithNamedContext name context subapi) Source # | |
HasClient m api => HasClient m (IsSecure :> api) Source # | |
Defined in Servant.Client.Core.HasClient | |
HasClient m api => HasClient m (RemoteHost :> api) Source # | |
Defined in Servant.Client.Core.HasClient type Client m (RemoteHost :> api) Source # clientWithRoute :: Proxy m -> Proxy (RemoteHost :> api) -> Request -> Client m (RemoteHost :> api) Source # hoistClientMonad :: Proxy m -> Proxy (RemoteHost :> api) -> (forall x. mon x -> mon' x) -> Client mon (RemoteHost :> api) -> Client mon' (RemoteHost :> api) Source # | |
HasClient m api => HasClient m (Vault :> api) Source # | |
Defined in Servant.Client.Core.HasClient | |
(KnownSymbol path, HasClient m api) => HasClient m (path :> api) Source # | Make the querying function append |
Defined in Servant.Client.Core.HasClient | |
(HasClient m api, MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) => HasClient m (StreamBody' mods framing ctype a :> api) Source # | |
Defined in Servant.Client.Core.HasClient type Client m (StreamBody' mods framing ctype a :> api) Source # clientWithRoute :: Proxy m -> Proxy (StreamBody' mods framing ctype a :> api) -> Request -> Client m (StreamBody' mods framing ctype a :> api) Source # hoistClientMonad :: Proxy m -> Proxy (StreamBody' mods framing ctype a :> api) -> (forall x. mon x -> mon' x) -> Client mon (StreamBody' mods framing ctype a :> api) -> Client mon' (StreamBody' mods framing ctype a :> api) Source # | |
(MimeRender ct a, HasClient m api) => HasClient m (ReqBody' mods (ct ': cts) a :> api) Source # | If you use a All you need is for your type to have a Example: type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book myApi :: Proxy MyApi myApi = Proxy addBook :: Book -> ClientM Book addBook = client myApi -- then you can just use "addBook" to query that endpoint |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (ReqBody' mods (ct ': cts) a :> api) -> Request -> Client m (ReqBody' mods (ct ': cts) a :> api) Source # hoistClientMonad :: Proxy m -> Proxy (ReqBody' mods (ct ': cts) a :> api) -> (forall x. mon x -> mon' x) -> Client mon (ReqBody' mods (ct ': cts) a :> api) -> Client mon' (ReqBody' mods (ct ': cts) a :> api) Source # | |
(KnownSymbol sym, HasClient m api) => HasClient m (QueryFlag sym :> api) Source # | If you use a If you give Otherwise, this function will insert a value-less query string
parameter under the name associated to your Example: type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book] myApi :: Proxy MyApi myApi = Proxy getBooks :: Bool -> ClientM [Book] getBooks = client myApi -- then you can just use "getBooks" to query that endpoint. -- 'getBooksBy False' for all books -- 'getBooksBy True' to only get _already published_ books |
Defined in Servant.Client.Core.HasClient | |
(KnownSymbol sym, ToHttpApiData a, HasClient m api) => HasClient m (QueryParams sym a :> api) Source # | If you use a If you give an empty list, nothing will be added to the query string. Otherwise, this function will take care of inserting a textual representation of your values in the query string, under the same query string parameter name. You can control how values for your type are turned into
text by specifying a Example: type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book] myApi :: Proxy MyApi myApi = Proxy getBooksBy :: [Text] -> ClientM [Book] getBooksBy = client myApi -- then you can just use "getBooksBy" to query that endpoint. -- 'getBooksBy []' for all books -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]' -- to get all books by Asimov and Heinlein |
Defined in Servant.Client.Core.HasClient type Client m (QueryParams sym a :> api) Source # clientWithRoute :: Proxy m -> Proxy (QueryParams sym a :> api) -> Request -> Client m (QueryParams sym a :> api) Source # hoistClientMonad :: Proxy m -> Proxy (QueryParams sym a :> api) -> (forall x. mon x -> mon' x) -> Client mon (QueryParams sym a :> api) -> Client mon' (QueryParams sym a :> api) Source # | |
(KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods)) => HasClient m (QueryParam' mods sym a :> api) Source # | If you use a If you give Nothing, nothing will be added to the query string. If you give a non- You can control how values for your type are turned into
text by specifying a Example: type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book] myApi :: Proxy MyApi myApi = Proxy getBooksBy :: Maybe Text -> ClientM [Book] getBooksBy = client myApi -- then you can just use "getBooksBy" to query that endpoint. -- 'getBooksBy Nothing' for all books -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov |
Defined in Servant.Client.Core.HasClient type Client m (QueryParam' mods sym a :> api) Source # clientWithRoute :: Proxy m -> Proxy (QueryParam' mods sym a :> api) -> Request -> Client m (QueryParam' mods sym a :> api) Source # hoistClientMonad :: Proxy m -> Proxy (QueryParam' mods sym a :> api) -> (forall x. mon x -> mon' x) -> Client mon (QueryParam' mods sym a :> api) -> Client mon' (QueryParam' mods sym a :> api) Source # | |
HasClient m api => HasClient m (Description desc :> api) Source # | Ignore |
Defined in Servant.Client.Core.HasClient type Client m (Description desc :> api) Source # clientWithRoute :: Proxy m -> Proxy (Description desc :> api) -> Request -> Client m (Description desc :> api) Source # hoistClientMonad :: Proxy m -> Proxy (Description desc :> api) -> (forall x. mon x -> mon' x) -> Client mon (Description desc :> api) -> Client mon' (Description desc :> api) Source # | |
HasClient m api => HasClient m (Summary desc :> api) Source # | Ignore |
Defined in Servant.Client.Core.HasClient | |
HasClient m api => HasClient m (HttpVersion :> api) Source # | Using a |
Defined in Servant.Client.Core.HasClient type Client m (HttpVersion :> api) Source # clientWithRoute :: Proxy m -> Proxy (HttpVersion :> api) -> Request -> Client m (HttpVersion :> api) Source # hoistClientMonad :: Proxy m -> Proxy (HttpVersion :> api) -> (forall x. mon x -> mon' x) -> Client mon (HttpVersion :> api) -> Client mon' (HttpVersion :> api) Source # | |
(KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods)) => HasClient m (Header' mods sym a :> api) Source # | If you use a That function will take care of encoding this argument as Text in the request headers. All you need is for your type to have a Example: newtype Referer = Referer { referrer :: Text } deriving (Eq, Show, Generic, ToHttpApiData) -- GET /view-my-referer type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer myApi :: Proxy MyApi myApi = Proxy viewReferer :: Maybe Referer -> ClientM Book viewReferer = client myApi -- then you can just use "viewRefer" to query that endpoint -- specifying Nothing or e.g Just "http://haskell.org/" as arguments |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (Header' mods sym a :> api) -> Request -> Client m (Header' mods sym a :> api) Source # hoistClientMonad :: Proxy m -> Proxy (Header' mods sym a :> api) -> (forall x. mon x -> mon' x) -> Client mon (Header' mods sym a :> api) -> Client mon' (Header' mods sym a :> api) Source # | |
(RunClient m, contentTypes ~ (contentType ': otherContentTypes), as ~ (a ': as'), AllMime contentTypes, ReflectMethod method, All (UnrenderResponse contentTypes) as, All HasStatus as, HasStatuses as', Unique (Statuses as)) => HasClient m (UVerb method contentTypes as) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (UVerb method contentTypes as) -> Request -> Client m (UVerb method contentTypes as) Source # hoistClientMonad :: Proxy m -> Proxy (UVerb method contentTypes as) -> (forall x. mon x -> mon' x) -> Client mon (UVerb method contentTypes as) -> Client mon' (UVerb method contentTypes as) Source # | |
(KnownSymbol capture, ToHttpApiData a, HasClient m sublayout) => HasClient m (CaptureAll capture a :> sublayout) Source # | If you use a You can control how these values are turned into text by specifying
a Example: type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile myApi :: Proxy myApi = Proxy getSourceFile :: [Text] -> ClientM SourceFile getSourceFile = client myApi -- then you can use "getSourceFile" to query that endpoint |
Defined in Servant.Client.Core.HasClient type Client m (CaptureAll capture a :> sublayout) Source # clientWithRoute :: Proxy m -> Proxy (CaptureAll capture a :> sublayout) -> Request -> Client m (CaptureAll capture a :> sublayout) Source # hoistClientMonad :: Proxy m -> Proxy (CaptureAll capture a :> sublayout) -> (forall x. mon x -> mon' x) -> Client mon (CaptureAll capture a :> sublayout) -> Client mon' (CaptureAll capture a :> sublayout) Source # | |
(KnownSymbol capture, ToHttpApiData a, HasClient m api) => HasClient m (Capture' mods capture a :> api) Source # | If you use a You can control how values for this type are turned into
text by specifying a Example: type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book myApi :: Proxy MyApi myApi = Proxy getBook :: Text -> ClientM Book getBook = client myApi -- then you can just use "getBook" to query that endpoint |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (Capture' mods capture a :> api) -> Request -> Client m (Capture' mods capture a :> api) Source # hoistClientMonad :: Proxy m -> Proxy (Capture' mods capture a :> api) -> (forall x. mon x -> mon' x) -> Client mon (Capture' mods capture a :> api) -> Client mon' (Capture' mods capture a :> api) Source # | |
(RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status) => HasClient m (Verb method status cts (Headers ls NoContent)) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (Verb method status cts (Headers ls NoContent)) -> Request -> Client m (Verb method status cts (Headers ls NoContent)) Source # hoistClientMonad :: Proxy m -> Proxy (Verb method status cts (Headers ls NoContent)) -> (forall x. mon x -> mon' x) -> Client mon (Verb method status cts (Headers ls NoContent)) -> Client mon' (Verb method status cts (Headers ls NoContent)) Source # | |
(RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status, ReflectMethod method, cts' ~ (ct ': cts)) => HasClient m (Verb method status cts' (Headers ls a)) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (Verb method status cts' (Headers ls a)) -> Request -> Client m (Verb method status cts' (Headers ls a)) Source # hoistClientMonad :: Proxy m -> Proxy (Verb method status cts' (Headers ls a)) -> (forall x. mon x -> mon' x) -> Client mon (Verb method status cts' (Headers ls a)) -> Client mon' (Verb method status cts' (Headers ls a)) Source # | |
(RunClient m, ReflectMethod method, KnownNat status) => HasClient m (Verb method status cts NoContent) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (Verb method status cts NoContent) -> Request -> Client m (Verb method status cts NoContent) Source # hoistClientMonad :: Proxy m -> Proxy (Verb method status cts NoContent) -> (forall x. mon x -> mon' x) -> Client mon (Verb method status cts NoContent) -> Client mon' (Verb method status cts NoContent) Source # | |
(RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), KnownNat status) => HasClient m (Verb method status cts' a) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (Verb method status cts' a) -> Request -> Client m (Verb method status cts' a) Source # hoistClientMonad :: Proxy m -> Proxy (Verb method status cts' a) -> (forall x. mon x -> mon' x) -> Client mon (Verb method status cts' a) -> Client mon' (Verb method status cts' a) Source # | |
(RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method, FramingUnrender framing, FromSourceIO chunk a, BuildHeadersTo hs) => HasClient m (Stream method status framing ct (Headers hs a)) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (Stream method status framing ct (Headers hs a)) -> Request -> Client m (Stream method status framing ct (Headers hs a)) Source # hoistClientMonad :: Proxy m -> Proxy (Stream method status framing ct (Headers hs a)) -> (forall x. mon x -> mon' x) -> Client mon (Stream method status framing ct (Headers hs a)) -> Client mon' (Stream method status framing ct (Headers hs a)) Source # | |
(RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method, FramingUnrender framing, FromSourceIO chunk a) => HasClient m (Stream method status framing ct a) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (Stream method status framing ct a) -> Request -> Client m (Stream method status framing ct a) Source # hoistClientMonad :: Proxy m -> Proxy (Stream method status framing ct a) -> (forall x. mon x -> mon' x) -> Client mon (Stream method status framing ct a) -> Client mon' (Stream method status framing ct a) Source # |
data EmptyClient Source #
Singleton type representing a client for an empty API.
Instances
Bounded EmptyClient Source # | |
Defined in Servant.Client.Core.HasClient minBound :: EmptyClient # maxBound :: EmptyClient # | |
Enum EmptyClient Source # | |
Defined in Servant.Client.Core.HasClient succ :: EmptyClient -> EmptyClient # pred :: EmptyClient -> EmptyClient # toEnum :: Int -> EmptyClient # fromEnum :: EmptyClient -> Int # enumFrom :: EmptyClient -> [EmptyClient] # enumFromThen :: EmptyClient -> EmptyClient -> [EmptyClient] # enumFromTo :: EmptyClient -> EmptyClient -> [EmptyClient] # enumFromThenTo :: EmptyClient -> EmptyClient -> EmptyClient -> [EmptyClient] # | |
Eq EmptyClient Source # | |
Defined in Servant.Client.Core.HasClient (==) :: EmptyClient -> EmptyClient -> Bool # (/=) :: EmptyClient -> EmptyClient -> Bool # | |
Show EmptyClient Source # | |
Defined in Servant.Client.Core.HasClient showsPrec :: Int -> EmptyClient -> ShowS # show :: EmptyClient -> String # showList :: [EmptyClient] -> ShowS # |
data AsClientT (m :: * -> *) Source #
A type that specifies that an API record contains a client implementation.
(//) :: a -> (a -> b) -> b infixl 1 Source #
Helper to make code using records of clients more readable.
Can be mixed with (/:) for supplying arguments.
Example:
@@ type Api = NamedRoutes RootApi
data RootApi mode = RootApi { subApi :: mode :- NamedRoutes SubApi , … } deriving Generic
data SubApi mode = SubApi { endpoint :: mode :- Get '[JSON] Person , … } deriving Generic
api :: Proxy API api = Proxy
rootClient :: RootApi (AsClientT ClientM) rootClient = client api
endpointClient :: ClientM Person endpointClient = client / subApi / endpoint @@
(/:) :: (a -> b -> c) -> b -> a -> c infixl 2 Source #
Convenience function for supplying arguments to client functions when working with records of clients.
Intended to be used in conjunction with (//)
.
Example:
@@ type Api = NamedRoutes RootApi
data RootApi mode = RootApi { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi , hello :: mode :- Capture "name" String :> Get '[JSON] String , … } deriving Generic
data SubApi mode = SubApi { endpoint :: mode :- Get '[JSON] Person , … } deriving Generic
api :: Proxy API api = Proxy
rootClient :: RootApi (AsClientT ClientM) rootClient = client api
hello :: String -> ClientM String hello name = rootClient / hello : name
endpointClient :: ClientM Person endpointClient = client / subApi : "foobar123" // endpoint @@
foldMapUnion :: forall c a (as :: [Type]). All c as => Proxy c -> (forall x. c x => x -> a) -> Union as -> a #
Convenience function to apply a function to an unknown union element using a type class. All elements of the union must have instances in the type class, and the function is applied unconditionally.
See also: matchUnion
.
matchUnion :: forall a (as :: [Type]). IsMember a as => Union as -> Maybe a #
Convenience function to extract a union element using cast
, ie. return the value if the
selected type happens to be the actual type of the union in this value, or Nothing
otherwise.
See also: foldMapUnion
.