add a test for hoistClient

This commit is contained in:
Alp Mestanogullari 2018-04-04 01:14:18 +02:00
parent 200311ee26
commit 9eb57a6119
3 changed files with 25 additions and 1 deletions

View file

@ -1,5 +1,5 @@
{ pkgs ? import <nixpkgs> {}
, compiler ? "ghc821"
, compiler ? "ghc822"
, tutorial ? false
}:

View file

@ -9,6 +9,7 @@ module Servant.Client
, runClientM
, ClientEnv(..)
, mkClientEnv
, hoistClient
, module Servant.Client.Core.Reexport
) where

View file

@ -89,6 +89,7 @@ spec = describe "Servant.Client" $ do
basicAuthSpec
genAuthSpec
genericClientSpec
hoistClientSpec
-- * test data types
@ -491,6 +492,28 @@ genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWa
left show <$> runClient (getSum 3 4) baseUrl `shouldReturn` Right 7
left show <$> runClient doNothing baseUrl `shouldReturn` Right ()
-- * hoistClient
type HoistClientAPI = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int
hoistClientAPI :: Proxy HoistClientAPI
hoistClientAPI = Proxy
hoistClientServer :: Application -- implements HoistClientAPI
hoistClientServer = serve hoistClientAPI $ return 5 :<|> (\n -> return n)
hoistClientSpec :: Spec
hoistClientSpec = beforeAll (startWaiApp hoistClientServer) $ afterAll endWaiApp $ do
describe "Servant.Client.hoistClient" $ do
it "allows us to GET/POST/... requests in IO instead of ClientM" $ \(_, baseUrl) -> do
let (getInt :<|> postInt)
= hoistClient hoistClientAPI
(fmap (either (error . show) id) . flip runClient baseUrl)
(client hoistClientAPI)
getInt `shouldReturn` 5
postInt 5 `shouldReturn` 5
-- * utils
startWaiApp :: Application -> IO (ThreadId, BaseUrl)