eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

failing test case for static client

Browse source
This commit is contained in:
Amar 2016-04-14 17:29:44 +08:00
parent d37b6a12df
commit 171195010c
2 changed files with 49 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
servant-client/src/Servant/Client.hs
View file

@ -2,7 +2,9 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
@ -18,6 +20,7 @@ module Servant.Client
( AuthClientData ( AuthClientData
, AuthenticateReq(..) , AuthenticateReq(..)
, client , client
, staticClient
, HasClient(..) , HasClient(..)
, ClientM , ClientM
, mkAuthenticateReq , mkAuthenticateReq
@ -60,6 +63,36 @@ import Servant.Common.Req
client :: HasClient layout => Proxy layout -> Client layout client :: HasClient layout => Proxy layout -> Client layout
client p = clientWithRoute p defReq 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 -- | This class lets us define how each API combinator
-- influences the creation of an HTTP request. It's mostly -- influences the creation of an HTTP request. It's mostly
-- an internal class, you can just use 'client'. -- an internal class, you can just use 'client'.

5
servant-client/test/Servant/ClientSpec.hs
View file

@ -296,6 +296,11 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
return $ return $
result === Right (cap, num, flag, body) 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 :: Spec
wrappedApiSpec = describe "error status codes" $ do wrappedApiSpec = describe "error status codes" $ do