b45ac07 · typeable/servant

git.iko.soy/typeable/servant

HasClient instance for Delete cts' () now does not care at all about content types provided

commitb45ac07ecea3374c920f2c14dbbba13fc1af09a0 authorBrandon Martin <zmbmartin@gmail.com> dateSun 17 May 2015, 07:51 (11 years ago) parent09e525f

3 files changed+31−16

compare with master

unifiedsplit

servant-client/CHANGELOG.md+4 servant-client/src/Servant/Client.hs+10−7 servant-client/test/Servant/ClientSpec.hs+17−9

servant-client/CHANGELOG.md+4

@@ -1,3 +1,7 @@

1+0.4.1

2+-----

3+* The `HasClient` instance for `Delete cts ()` now does not care at all about content types provided.

150.4

26---

37* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body

servant-client/src/Servant/Client.hs+10−7

@@ -7,6 +7,7 @@

77{-# LANGUAGE ScopedTypeVariables #-}

88{-# LANGUAGE TypeFamilies #-}

99{-# LANGUAGE TypeOperators #-}

10+{-# LANGUAGE UndecidableInstances #-}

1011#if !MIN_VERSION_base(4,8,0)

1112{-# LANGUAGE OverlappingInstances #-}

1213#endif

@@ -126,8 +127,9 @@ instance

126127#if MIN_VERSION_base(4,8,0)

127128 {-# OVERLAPPABLE #-}

128129#endif

129− (MimeUnrender ct a) => HasClient (Delete (ct ': cts) a) where

130− type Client (Delete (ct ': cts) a) = EitherT ServantError IO a

130+ -- See https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/type-class-extensions.html#undecidable-instances

131+ (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where

132+ type Client (Delete cts' a) = EitherT ServantError IO a

131133 clientWithRoute Proxy req baseurl =

132134 snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl

133135

@@ -137,8 +139,8 @@ instance

137139#if MIN_VERSION_base(4,8,0)

138140 {-# OVERLAPPING #-}

139141#endif

140− HasClient (Delete (ct ': cts) ()) where

141− type Client (Delete (ct ': cts) ()) = EitherT ServantError IO ()

142+ HasClient (Delete cts ()) where

143+ type Client (Delete cts ()) = EitherT ServantError IO ()

142144 clientWithRoute Proxy req baseurl =

143145 void $ performRequestNoBody H.methodDelete req [204] baseurl

144146

@@ -148,9 +150,10 @@ instance

148150#if MIN_VERSION_base(4,8,0)

149151 {-# OVERLAPPING #-}

150152#endif

151− ( MimeUnrender ct a, BuildHeadersTo ls

152− ) => HasClient (Delete (ct ': cts) (Headers ls a)) where

153− type Client (Delete (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)

153+ -- See https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/type-class-extensions.html#undecidable-instances

154+ ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)

155+ ) => HasClient (Delete cts' (Headers ls a)) where

156+ type Client (Delete cts' (Headers ls a)) = EitherT ServantError IO (Headers ls a)

154157 clientWithRoute Proxy req baseurl = do

155158 (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl

156159 return $ Headers { getResponse = resp

servant-client/test/Servant/ClientSpec.hs+17−9

@@ -80,7 +80,7 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]

8080

8181type Api =

8282 "get" :> Get '[JSON] Person

83− :<|> "delete" :> Delete '[JSON] ()

83+ :<|> "deleteEmpty" :> Delete '[] ()

8484 :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person

8585 :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person

8686 :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person

@@ -98,6 +98,7 @@ type Api =

9898 ReqBody '[JSON] [(String, [Rational])] :>

9999 Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])

100100 :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)

101+ :<|> "deleteContentType" :> Delete '[JSON] ()

101102api :: Proxy Api

102103api = Proxy

103104

@@ -123,6 +124,7 @@ server = serve api (

123124 :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")

124125 :<|> (\ a b c d -> return (a, b, c, d))

125126 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)

127+ :<|> return ()

126128 )

127129

128130withServer :: (BaseUrl -> IO a) -> IO a

@@ -148,7 +150,7 @@ withFailServer action = withWaiDaemon (return failServer) action

148150spec :: IO ()

149151spec = withServer $ \ baseUrl -> do

150152 let getGet :: EitherT ServantError IO Person

151− getDelete :: EitherT ServantError IO ()

153+ getDeleteEmpty :: EitherT ServantError IO ()

152154 getCapture :: String -> EitherT ServantError IO Person

153155 getBody :: Person -> EitherT ServantError IO Person

154156 getQueryParam :: Maybe String -> EitherT ServantError IO Person

@@ -161,8 +163,9 @@ spec = withServer $ \ baseUrl -> do

161163 getRawFailure :: Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)

162164 getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])

163165 getRespHeaders :: EitherT ServantError IO (Headers TestHeaders Bool)

166+ getDeleteContentType :: EitherT ServantError IO ()

164167 ( getGet

165− :<|> getDelete

168+ :<|> getDeleteEmpty

166169 :<|> getCapture

167170 :<|> getBody

168171 :<|> getQueryParam

@@ -174,15 +177,20 @@ spec = withServer $ \ baseUrl -> do

174177 :<|> getRawSuccess

175178 :<|> getRawFailure

176179 :<|> getMultiple

177− :<|> getRespHeaders)

180+ :<|> getRespHeaders

181+ :<|> getDeleteContentType)

178182 = client api baseUrl

179183

180184 hspec $ do

181185 it "Servant.API.Get" $ do

182186 (Arrow.left show <$> runEitherT getGet) `shouldReturn` Right alice

183187

184− it "Servant.API.Delete" $ do

185− (Arrow.left show <$> runEitherT getDelete) `shouldReturn` Right ()

188+ describe "Servant.API.Delete" $ do

189+ it "allows empty content type" $ do

190+ (Arrow.left show <$> runEitherT getDeleteEmpty) `shouldReturn` Right ()

191+

192+ it "allows content type" $ do

193+ (Arrow.left show <$> runEitherT getDeleteContentType) `shouldReturn` Right ()

186194

187195 it "Servant.API.Capture" $ do

188196 (Arrow.left show <$> runEitherT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)

@@ -274,11 +282,11 @@ spec = withServer $ \ baseUrl -> do

274282failSpec :: IO ()

275283failSpec = withFailServer $ \ baseUrl -> do

276284 let getGet :: EitherT ServantError IO Person

277− getDelete :: EitherT ServantError IO ()

285+ getDeleteEmpty :: EitherT ServantError IO ()

278286 getCapture :: String -> EitherT ServantError IO Person

279287 getBody :: Person -> EitherT ServantError IO Person

280288 ( getGet

281− :<|> getDelete

289+ :<|> getDeleteEmpty

282290 :<|> getCapture

283291 :<|> getBody

284292 :<|> _ )

@@ -289,7 +297,7 @@ failSpec = withFailServer $ \ baseUrl -> do

289297 hspec $ do

290298 context "client returns errors appropriately" $ do

291299 it "reports FailureResponse" $ do

292− Left res <- runEitherT getDelete

300+ Left res <- runEitherT getDeleteEmpty

293301 case res of

294302 FailureResponse (Status 404 "Not Found") _ _ -> return ()

295303 _ -> fail $ "expected 404 response, but got " <> show res