From 6ccd52b68848b24ed9936f560a1a1047650d6e90 Mon Sep 17 00:00:00 2001
From: "(cdep)illabout" <cdep.illabout@gmail.com>
Date: Fri, 19 Aug 2016 22:00:31 +0900
Subject: [PATCH] Add in clientWithCTs function.

---
 servant-client/src/Servant/Client.hs | 34 ++++++++++++++++++++++++++--
 1 file changed, 32 insertions(+), 2 deletions(-)

diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs
index 35e05aad..5a78e64e 100644
--- a/servant-client/src/Servant/Client.hs
+++ b/servant-client/src/Servant/Client.hs
@@ -45,6 +45,16 @@ import           Servant.Common.BaseUrl
 import           Servant.Common.BasicAuth
 import           Servant.Common.Req
 
+type family FirstCT cts :: [*] where
+    FirstCT '[] = '[]
+    FirstCT (ct ': cts) = '[ct]
+
+type family FirstCTVerb x :: * where
+    FirstCTVerb (Verb method statusCode cts r) = (Verb method statusCode (FirstCT cts) r)
+    FirstCTVerb (a :> b) = (a :> FirstCTVerb b)
+    FirstCTVerb (a :<|> b) = (FirstCTVerb a :<|> FirstCTVerb b)
+    FirstCTVerb a = a
+
 -- * Accessing APIs as a Client
 
 -- | 'client' allows you to produce operations to query an API from a client.
@@ -58,8 +68,28 @@ import           Servant.Common.Req
 -- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
 -- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
 -- > (getAllBooks :<|> postNewBook) = client myApi
-client :: HasClient api => Proxy api -> Client api
-client p = clientWithRoute p defReq
+
+client
+    :: forall api . HasClient (FirstCTVerb api)
+    => Proxy api -> Client (FirstCTVerb api)
+client _ = clientWithRoute apiWithOnlyFirstCT defReq
+  where
+    apiWithOnlyFirstCT :: Proxy (FirstCTVerb api)
+    apiWithOnlyFirstCT = Proxy
+
+type family ReplaceCTs api (newCTs :: [*]) :: * where
+    ReplaceCTs (Verb method statusCode oldCTs r) newCTs = (Verb method statusCode newCTs r)
+    ReplaceCTs (a :> b) newCTs = (a :> ReplaceCTs b newCTs)
+    ReplaceCTs (a :<|> b) newCTs = (ReplaceCTs a newCTs :<|> ReplaceCTs b newCTs)
+    ReplaceCTs a newCTs = a
+
+clientWithCTs
+    :: forall api cts . (HasClient (ReplaceCTs api cts))
+    => Proxy cts -> Proxy api -> Client (ReplaceCTs api cts)
+clientWithCTs _ _ = clientWithRoute replacedCTs defReq
+  where
+    replacedCTs :: Proxy (ReplaceCTs api cts)
+    replacedCTs = Proxy
 
 -- | This class lets us define how each API combinator
 -- influences the creation of an HTTP request. It's mostly