From 3802ef5447bcb2c22ba83c880ded4774886c6606 Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Thu, 26 Mar 2015 14:34:38 +0100
Subject: [PATCH] Add patch method, and make () response expect no content

---
 CHANGELOG.md              |  2 ++
 src/Servant/Client.hs     | 41 ++++++++++++++++++++++++++++++++++++++-
 src/Servant/Common/Req.hs |  4 ++++
 3 files changed, 46 insertions(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 2cadae97..df677a29 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,6 +5,8 @@
 * Support multiple concurrent threads
 * Use `ServantError` to report Errors instead of `String`
 * Make the clients for `Raw` endpoints return the whole `Response` value (to be able to access response headers for example)
+* Support for PATCH
+* Make () instances expect No Content status code, and not try to decode body.
 
 0.2.2
 -----
diff --git a/src/Servant/Client.hs b/src/Servant/Client.hs
index 955b96f0..7ef664d0 100644
--- a/src/Servant/Client.hs
+++ b/src/Servant/Client.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverlappingInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 -- | This module provides 'client' which can automatically generate
 -- querying functions for each endpoint just from the type representing your
@@ -123,6 +124,13 @@ instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
   clientWithRoute Proxy req host =
     performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] host
 
+-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content
+-- HTTP header.
+instance HasClient (Get (ct ': cts) ()) where
+  type Client (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
+  clientWithRoute Proxy req host =
+    performRequestNoBody H.methodGet req [204] host
+
 -- | If you use a 'Header' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take
 -- an additional argument of the type specified by your 'Header',
@@ -170,6 +178,13 @@ instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
   clientWithRoute Proxy req uri =
     performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] uri
 
+-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content
+-- HTTP header.
+instance HasClient (Post (ct ': cts) ()) where
+  type Client (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
+  clientWithRoute Proxy req host =
+    void $ performRequestNoBody H.methodPost req [204] host
+
 -- | If you have a 'Put' endpoint in your API, the client
 -- side querying function that is created when calling 'client'
 -- will just require an argument that specifies the scheme, host
@@ -180,6 +195,30 @@ instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
   clientWithRoute Proxy req host =
     performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] host
 
+-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content
+-- HTTP header.
+instance HasClient (Put (ct ': cts) ()) where
+  type Client (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
+  clientWithRoute Proxy req host =
+    void $ performRequestNoBody H.methodPut req [204] host
+
+-- | If you have a 'Patch' endpoint in your API, the client
+-- side querying function that is created when calling 'client'
+-- will just require an argument that specifies the scheme, host
+-- and port to send the request to.
+instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
+  type Client (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
+
+  clientWithRoute Proxy req host =
+    performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] host
+
+-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content
+-- HTTP header.
+instance HasClient (Patch (ct ': cts) ()) where
+  type Client (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
+  clientWithRoute Proxy req host =
+    void $ performRequestNoBody H.methodPatch req [204] host
+
 -- | If you use a 'QueryParam' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take
 -- an additional argument of the type specified by your 'QueryParam',
@@ -222,7 +261,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
 
 -- | If you use a 'QueryParams' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take
--- an additional argument, a list of values of the type specified 
+-- an additional argument, a list of values of the type specified
 -- by your 'QueryParams'.
 --
 -- If you give an empty list, nothing will be added to the query string.
diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs
index d87045cc..a0ffbc14 100644
--- a/src/Servant/Common/Req.hs
+++ b/src/Servant/Common/Req.hs
@@ -174,6 +174,10 @@ performRequestCT ct reqMethod req wantedStatus reqHost = do
     return
     (fromByteString ct respBody)
 
+performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO ()
+performRequestNoBody reqMethod req wantedStatus reqHost = do
+  _ <- performRequest reqMethod req (`elem` wantedStatus) reqHost
+  return ()
 
 catchHttpException :: IO a -> IO (Either HttpException a)
 catchHttpException action =