failing test case for static client
This commit is contained in:
parent
d37b6a12df
commit
171195010c
2 changed files with 49 additions and 11 deletions
|
@ -2,7 +2,9 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
@ -18,6 +20,7 @@ module Servant.Client
|
|||
( AuthClientData
|
||||
, AuthenticateReq(..)
|
||||
, client
|
||||
, staticClient
|
||||
, HasClient(..)
|
||||
, ClientM
|
||||
, mkAuthenticateReq
|
||||
|
@ -60,6 +63,36 @@ import Servant.Common.Req
|
|||
client :: HasClient layout => Proxy layout -> Client layout
|
||||
client p = clientWithRoute p defReq
|
||||
|
||||
|
||||
class Foo layout where
|
||||
type StaticClient layout :: *
|
||||
staticClient :: Proxy layout -> BaseUrl -> StaticClient layout
|
||||
|
||||
instance (Foo left, Foo right) => Foo (left :<|> right) where
|
||||
type StaticClient (left :<|> right) = StaticClient left :<|> StaticClient right
|
||||
staticClient p url =
|
||||
staticClient pleft url :<|>
|
||||
staticClient pright url
|
||||
where pleft = Proxy :: Proxy left
|
||||
pright = Proxy :: Proxy right
|
||||
|
||||
instance OVERLAPPABLE_ (Client (combinator :> api) ~ Client api, Foo api) => Foo (combinator :> api) where
|
||||
type StaticClient (combinator :> api) = StaticClient api
|
||||
staticClient p url = staticClient (Proxy :: Proxy api) url
|
||||
|
||||
instance OVERLAPPING_ (MimeRender ct a, Client (ReqBody (ct ': cts) a :> sublayout) ~ (a -> Client sublayout), Foo sublayout)
|
||||
=> Foo (ReqBody (ct ': cts) a :> sublayout) where
|
||||
type StaticClient (ReqBody (ct ': cts) a :> sublayout) = a -> Client sublayout
|
||||
staticClient p url = _
|
||||
|
||||
instance (Client (Verb method status ctypes result) ~ (Manager -> BaseUrl -> ClientM result), ctypes ~ (c ': ct), MimeUnrender c result, ReflectMethod method) => Foo (Verb method status ctypes result) where
|
||||
type StaticClient (Verb method status ctypes result) = Manager -> ClientM result
|
||||
staticClient p url = \ mgr -> (client p) mgr url
|
||||
|
||||
instance Foo Raw where
|
||||
type StaticClient Raw = H.Method -> Manager -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
|
||||
staticClient p url = \h m -> (client p) h m url
|
||||
|
||||
-- | 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'.
|
||||
|
|
|
@ -296,6 +296,11 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
|||
return $
|
||||
result === Right (cap, num, flag, body)
|
||||
|
||||
describe "staticClient" $ do
|
||||
it "allows to pass in the BaseUrl to staticClient" $ \(_, baseUrl) -> do
|
||||
let getGet' :: C.Manager -> ClientM Person
|
||||
getGet' :<|> _ = staticClient api baseUrl
|
||||
(left show <$> runExceptT (getGet' manager)) `shouldReturn` Right alice
|
||||
|
||||
wrappedApiSpec :: Spec
|
||||
wrappedApiSpec = describe "error status codes" $ do
|
||||
|
|
Loading…
Reference in a new issue