add a test for hoistClient
This commit is contained in:
parent
200311ee26
commit
9eb57a6119
3 changed files with 25 additions and 1 deletions
|
@ -1,5 +1,5 @@
|
||||||
{ pkgs ? import <nixpkgs> {}
|
{ pkgs ? import <nixpkgs> {}
|
||||||
, compiler ? "ghc821"
|
, compiler ? "ghc822"
|
||||||
, tutorial ? false
|
, tutorial ? false
|
||||||
}:
|
}:
|
||||||
|
|
||||||
|
|
|
@ -9,6 +9,7 @@ module Servant.Client
|
||||||
, runClientM
|
, runClientM
|
||||||
, ClientEnv(..)
|
, ClientEnv(..)
|
||||||
, mkClientEnv
|
, mkClientEnv
|
||||||
|
, hoistClient
|
||||||
, module Servant.Client.Core.Reexport
|
, module Servant.Client.Core.Reexport
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
|
@ -89,6 +89,7 @@ spec = describe "Servant.Client" $ do
|
||||||
basicAuthSpec
|
basicAuthSpec
|
||||||
genAuthSpec
|
genAuthSpec
|
||||||
genericClientSpec
|
genericClientSpec
|
||||||
|
hoistClientSpec
|
||||||
|
|
||||||
-- * test data types
|
-- * 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 (getSum 3 4) baseUrl `shouldReturn` Right 7
|
||||||
left show <$> runClient doNothing baseUrl `shouldReturn` Right ()
|
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
|
-- * utils
|
||||||
|
|
||||||
startWaiApp :: Application -> IO (ThreadId, BaseUrl)
|
startWaiApp :: Application -> IO (ThreadId, BaseUrl)
|
||||||
|
|
Loading…
Reference in a new issue