From b45ac07ecea3374c920f2c14dbbba13fc1af09a0 Mon Sep 17 00:00:00 2001 From: Brandon Martin Date: Sun, 17 May 2015 07:51:49 -0600 Subject: [PATCH] HasClient instance for Delete cts' () now does not care at all about content types provided --- servant-client/CHANGELOG.md | 4 ++++ servant-client/src/Servant/Client.hs | 17 +++++++++------ servant-client/test/Servant/ClientSpec.hs | 26 +++++++++++++++-------- 3 files changed, 31 insertions(+), 16 deletions(-) diff --git a/servant-client/CHANGELOG.md b/servant-client/CHANGELOG.md index efb268b9..b68a1e0c 100644 --- a/servant-client/CHANGELOG.md +++ b/servant-client/CHANGELOG.md @@ -1,3 +1,7 @@ +0.4.1 +----- +* The `HasClient` instance for `Delete cts ()` now does not care at all about content types provided. + 0.4 --- * `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index 9505b5a0..0106318a 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -7,6 +7,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} #if !MIN_VERSION_base(4,8,0) {-# LANGUAGE OverlappingInstances #-} #endif @@ -126,8 +127,9 @@ instance #if MIN_VERSION_base(4,8,0) {-# OVERLAPPABLE #-} #endif - (MimeUnrender ct a) => HasClient (Delete (ct ': cts) a) where - type Client (Delete (ct ': cts) a) = EitherT ServantError IO a + -- See https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/type-class-extensions.html#undecidable-instances + (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where + type Client (Delete cts' a) = EitherT ServantError IO a clientWithRoute Proxy req baseurl = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl @@ -137,8 +139,8 @@ instance #if MIN_VERSION_base(4,8,0) {-# OVERLAPPING #-} #endif - HasClient (Delete (ct ': cts) ()) where - type Client (Delete (ct ': cts) ()) = EitherT ServantError IO () + HasClient (Delete cts ()) where + type Client (Delete cts ()) = EitherT ServantError IO () clientWithRoute Proxy req baseurl = void $ performRequestNoBody H.methodDelete req [204] baseurl @@ -148,9 +150,10 @@ instance #if MIN_VERSION_base(4,8,0) {-# OVERLAPPING #-} #endif - ( MimeUnrender ct a, BuildHeadersTo ls - ) => HasClient (Delete (ct ': cts) (Headers ls a)) where - type Client (Delete (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) + -- See https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/type-class-extensions.html#undecidable-instances + ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts) + ) => HasClient (Delete cts' (Headers ls a)) where + type Client (Delete cts' (Headers ls a)) = EitherT ServantError IO (Headers ls a) clientWithRoute Proxy req baseurl = do (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl return $ Headers { getResponse = resp diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 12f06a8b..242a3620 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -80,7 +80,7 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String] type Api = "get" :> Get '[JSON] Person - :<|> "delete" :> Delete '[JSON] () + :<|> "deleteEmpty" :> Delete '[] () :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person @@ -98,6 +98,7 @@ type Api = ReqBody '[JSON] [(String, [Rational])] :> Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])]) :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool) + :<|> "deleteContentType" :> Delete '[JSON] () api :: Proxy Api api = Proxy @@ -123,6 +124,7 @@ server = serve api ( :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure") :<|> (\ a b c d -> return (a, b, c, d)) :<|> (return $ addHeader 1729 $ addHeader "eg2" True) + :<|> return () ) withServer :: (BaseUrl -> IO a) -> IO a @@ -148,7 +150,7 @@ withFailServer action = withWaiDaemon (return failServer) action spec :: IO () spec = withServer $ \ baseUrl -> do let getGet :: EitherT ServantError IO Person - getDelete :: EitherT ServantError IO () + getDeleteEmpty :: EitherT ServantError IO () getCapture :: String -> EitherT ServantError IO Person getBody :: Person -> EitherT ServantError IO Person getQueryParam :: Maybe String -> EitherT ServantError IO Person @@ -161,8 +163,9 @@ spec = withServer $ \ baseUrl -> do getRawFailure :: Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString) getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])]) getRespHeaders :: EitherT ServantError IO (Headers TestHeaders Bool) + getDeleteContentType :: EitherT ServantError IO () ( getGet - :<|> getDelete + :<|> getDeleteEmpty :<|> getCapture :<|> getBody :<|> getQueryParam @@ -174,15 +177,20 @@ spec = withServer $ \ baseUrl -> do :<|> getRawSuccess :<|> getRawFailure :<|> getMultiple - :<|> getRespHeaders) + :<|> getRespHeaders + :<|> getDeleteContentType) = client api baseUrl hspec $ do it "Servant.API.Get" $ do (Arrow.left show <$> runEitherT getGet) `shouldReturn` Right alice - it "Servant.API.Delete" $ do - (Arrow.left show <$> runEitherT getDelete) `shouldReturn` Right () + describe "Servant.API.Delete" $ do + it "allows empty content type" $ do + (Arrow.left show <$> runEitherT getDeleteEmpty) `shouldReturn` Right () + + it "allows content type" $ do + (Arrow.left show <$> runEitherT getDeleteContentType) `shouldReturn` Right () it "Servant.API.Capture" $ do (Arrow.left show <$> runEitherT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0) @@ -274,11 +282,11 @@ spec = withServer $ \ baseUrl -> do failSpec :: IO () failSpec = withFailServer $ \ baseUrl -> do let getGet :: EitherT ServantError IO Person - getDelete :: EitherT ServantError IO () + getDeleteEmpty :: EitherT ServantError IO () getCapture :: String -> EitherT ServantError IO Person getBody :: Person -> EitherT ServantError IO Person ( getGet - :<|> getDelete + :<|> getDeleteEmpty :<|> getCapture :<|> getBody :<|> _ ) @@ -289,7 +297,7 @@ failSpec = withFailServer $ \ baseUrl -> do hspec $ do context "client returns errors appropriately" $ do it "reports FailureResponse" $ do - Left res <- runEitherT getDelete + Left res <- runEitherT getDeleteEmpty case res of FailureResponse (Status 404 "Not Found") _ _ -> return () _ -> fail $ "expected 404 response, but got " <> show res