add a test for hoistClient

Author: alpmestan

nix/shell.nix

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

servant-client/src/Servant/Client.hs

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

servant-client/test/Servant/ClientSpec.hs

@@ -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)