From 9eb57a6119f9c9045dbd49050bed6f1282611d99 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Wed, 4 Apr 2018 01:14:18 +0200
Subject: [PATCH] add a test for hoistClient

---
 nix/shell.nix                             |  2 +-
 servant-client/src/Servant/Client.hs      |  1 +
 servant-client/test/Servant/ClientSpec.hs | 23 +++++++++++++++++++++++
 3 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/nix/shell.nix b/nix/shell.nix
index 9c0cef9e..4e43c606 100644
--- a/nix/shell.nix
+++ b/nix/shell.nix
@@ -1,5 +1,5 @@
 { pkgs ? import <nixpkgs> {}
-, compiler ? "ghc821"
+, compiler ? "ghc822"
 , tutorial ? false
 }:
 
diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs
index d3243198..ee5506cd 100644
--- a/servant-client/src/Servant/Client.hs
+++ b/servant-client/src/Servant/Client.hs
@@ -9,6 +9,7 @@ module Servant.Client
   , runClientM
   , ClientEnv(..)
   , mkClientEnv
+  , hoistClient
   , module Servant.Client.Core.Reexport
   ) where
 
diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs
index 6d33cd27..a2e62be5 100644
--- a/servant-client/test/Servant/ClientSpec.hs
+++ b/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)