b45ac07 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

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

b45ac07Brandon Martin11 years ago

servant-client/CHANGELOG.md+4

compare with master

unifiedsplit

@@ -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.

10.4

50.4

2---

6---

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

7* `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 @@

7{-# LANGUAGE ScopedTypeVariables #-}

8{-# LANGUAGE TypeFamilies #-}

9{-# LANGUAGE TypeOperators #-}

10+{-# LANGUAGE UndecidableInstances #-}

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

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

11{-# LANGUAGE OverlappingInstances #-}

12{-# LANGUAGE OverlappingInstances #-}

12#endif

13#endif

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

126#if MIN_VERSION_base(4,8,0)

127#if MIN_VERSION_base(4,8,0)

127 {-# OVERLAPPABLE #-}

128 {-# OVERLAPPABLE #-}

128#endif

129#endif

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

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

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

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

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

131 clientWithRoute Proxy req baseurl =

133 clientWithRoute Proxy req baseurl =

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

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

133

135

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

137#if MIN_VERSION_base(4,8,0)

139#if MIN_VERSION_base(4,8,0)

138 {-# OVERLAPPING #-}

140 {-# OVERLAPPING #-}

139#endif

141#endif

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

142+ HasClient (Delete cts ()) where

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

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

142 clientWithRoute Proxy req baseurl =

144 clientWithRoute Proxy req baseurl =

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

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

144

146

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

148#if MIN_VERSION_base(4,8,0)

150#if MIN_VERSION_base(4,8,0)

149 {-# OVERLAPPING #-}

151 {-# OVERLAPPING #-}

150#endif

152#endif

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

151− ( MimeUnrender ct a, BuildHeadersTo ls

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

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

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

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

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

154 clientWithRoute Proxy req baseurl = do

157 clientWithRoute Proxy req baseurl = do

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

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

156 return $ Headers { getResponse = resp

159 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]

81type Api =

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

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

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

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

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

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

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

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

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

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

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

101api :: Proxy Api

102api :: Proxy Api

102api = Proxy

103api = Proxy

103

104

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

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

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

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

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

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

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

127+ :<|> return ()

126 )

128 )

127

129

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

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

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

148spec :: IO ()

150spec :: IO ()

149spec = withServer $ \ baseUrl -> do

151spec = withServer $ \ baseUrl -> do

150 let getGet :: EitherT ServantError IO Person

152 let getGet :: EitherT ServantError IO Person

151− getDelete :: EitherT ServantError IO ()

153+ getDeleteEmpty :: EitherT ServantError IO ()

152 getCapture :: String -> EitherT ServantError IO Person

154 getCapture :: String -> EitherT ServantError IO Person

153 getBody :: Person -> EitherT ServantError IO Person

155 getBody :: Person -> EitherT ServantError IO Person

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

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

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

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

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

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

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

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

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

166+ getDeleteContentType :: EitherT ServantError IO ()

164 ( getGet

167 ( getGet

165− :<|> getDelete

168+ :<|> getDeleteEmpty

166 :<|> getCapture

169 :<|> getCapture

167 :<|> getBody

170 :<|> getBody

168 :<|> getQueryParam

171 :<|> getQueryParam

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

174 :<|> getRawSuccess

177 :<|> getRawSuccess

175 :<|> getRawFailure

178 :<|> getRawFailure

176 :<|> getMultiple

179 :<|> getMultiple

177− :<|> getRespHeaders)

180+ :<|> getRespHeaders

181+ :<|> getDeleteContentType)

178 = client api baseUrl

182 = client api baseUrl

179

183

180 hspec $ do

184 hspec $ do

181 it "Servant.API.Get" $ do

185 it "Servant.API.Get" $ do

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

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

183

187

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

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

189+ it "allows empty content type" $ do

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

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

191+

192+ it "allows content type" $ do

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

186

194

187 it "Servant.API.Capture" $ do

195 it "Servant.API.Capture" $ do

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

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

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

274failSpec :: IO ()

282failSpec :: IO ()

275failSpec = withFailServer $ \ baseUrl -> do

283failSpec = withFailServer $ \ baseUrl -> do

276 let getGet :: EitherT ServantError IO Person

284 let getGet :: EitherT ServantError IO Person

277− getDelete :: EitherT ServantError IO ()

285+ getDeleteEmpty :: EitherT ServantError IO ()

278 getCapture :: String -> EitherT ServantError IO Person

286 getCapture :: String -> EitherT ServantError IO Person

279 getBody :: Person -> EitherT ServantError IO Person

287 getBody :: Person -> EitherT ServantError IO Person

280 ( getGet

288 ( getGet

281− :<|> getDelete

289+ :<|> getDeleteEmpty

282 :<|> getCapture

290 :<|> getCapture

283 :<|> getBody

291 :<|> getBody

284 :<|> _ )

292 :<|> _ )

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

289 hspec $ do

297 hspec $ do

290 context "client returns errors appropriately" $ do

298 context "client returns errors appropriately" $ do

291 it "reports FailureResponse" $ do

299 it "reports FailureResponse" $ do

292− Left res <- runEitherT getDelete

300+ Left res <- runEitherT getDeleteEmpty

293 case res of

301 case res of

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

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

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

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