783a849 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Make NoContent still take an arg.

783a849Julian K. Arni11 years ago

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

compare with master

unifiedsplit

@@ -129,10 +129,10 @@ instance OVERLAPPABLE_

129 where method = reflectMethod (Proxy :: Proxy method)

130

131instance OVERLAPPING_

132− (ReflectMethod method) => HasClient (Verb method status cts ()) where

132+ (ReflectMethod method) => HasClient (Verb method status cts NoContent) where

133− type Client (Verb method status cts ()) = ExceptT ServantError IO ()

133+ type Client (Verb method status cts NoContent) = ExceptT ServantError IO NoContent

134 clientWithRoute Proxy req baseurl manager =

135− void $ performRequestNoBody method req baseurl manager

135+ performRequestNoBody method req baseurl manager >> return NoContent

136 where method = reflectMethod (Proxy :: Proxy method)

137

138instance OVERLAPPING_

@@ -150,13 +150,13 @@ instance OVERLAPPING_

150

151instance OVERLAPPING_

152 ( BuildHeadersTo ls, ReflectMethod method

153− ) => HasClient (Verb method status cts (Headers ls ())) where

153+ ) => HasClient (Verb method status cts (Headers ls NoContent)) where

154− type Client (Verb method status cts (Headers ls ()))

154+ type Client (Verb method status cts (Headers ls NoContent))

155− = ExceptT ServantError IO (Headers ls ())

155+ = ExceptT ServantError IO (Headers ls NoContent)

156 clientWithRoute Proxy req baseurl manager = do

157 let method = reflectMethod (Proxy :: Proxy method)

158 hdrs <- performRequestNoBody method req baseurl manager

159− return $ Headers { getResponse = ()

159+ return $ Headers { getResponse = NoContent

160 , getHeadersHList = buildHeadersTo hdrs

161 }

162

servant-client/test/Servant/ClientSpec.hs+6−6

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

91type Api =

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

93− :<|> "deleteEmpty" :> Delete '[JSON] ()

93+ :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent

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

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

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

@@ -105,14 +105,14 @@ type Api =

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

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

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

108− :<|> "deleteContentType" :> Delete '[JSON] ()

108+ :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent

109api :: Proxy Api

110api = Proxy

111

112server :: Application

113server = serve api (

114 return alice

115− :<|> return ()

115+ :<|> return NoContent

116 :<|> (\ name -> return $ Person name 0)

117 :<|> return

118 :<|> (\ name -> case name of

@@ -125,7 +125,7 @@ server = serve api (

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

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

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

128− :<|> return ()

128+ :<|> return NoContent

129 )

130

131

@@ -157,11 +157,11 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

157 describe "Servant.API.Delete" $ do

158 it "allows empty content type" $ \(_, baseUrl) -> do

159 let getDeleteEmpty = getNth (Proxy :: Proxy 1) $ client api baseUrl manager

160− (left show <$> runExceptT getDeleteEmpty) `shouldReturn` Right ()

160+ (left show <$> runExceptT getDeleteEmpty) `shouldReturn` Right NoContent

161

162 it "allows content type" $ \(_, baseUrl) -> do

163 let getDeleteContentType = getLast $ client api baseUrl manager

164− (left show <$> runExceptT getDeleteContentType) `shouldReturn` Right ()

164+ (left show <$> runExceptT getDeleteContentType) `shouldReturn` Right NoContent

165

166 it "Servant.API.Capture" $ \(_, baseUrl) -> do

167 let getCapture = getNth (Proxy :: Proxy 2) $ client api baseUrl manager

servant-server/test/Servant/ServerSpec.hs+12−12

@@ -38,8 +38,8 @@ import Servant.API ((:<|>) (..), (:>), Capture, Delete,

38 HttpVersion, IsSecure (..), JSON,

39 Patch, PlainText, Post, Put,

40 QueryFlag, QueryParam, QueryParams,

41− Raw, RemoteHost, ReqBody,

41+ Raw, RemoteHost, ReqBody, GetNoContent,

42− addHeader)

42+ PostNoContent, addHeader, NoContent(..))

43import Servant.Server (Server, serve, ServantErr(..), err404)

44import Test.Hspec (Spec, describe, it, shouldBe)

45import Test.Hspec.Wai (get, liftIO, matchHeaders,

@@ -130,9 +130,9 @@ captureSpec = do

130

131

132type GetApi = Get '[JSON] Person

133− :<|> "empty" :> Get '[JSON] ()

133+ :<|> "empty" :> GetNoContent '[JSON] NoContent

134− :<|> "emptyWithHeaders" :> Get '[JSON] (Headers '[Header "H" Int] ())

134+ :<|> "emptyWithHeaders" :> GetNoContent '[JSON] (Headers '[Header "H" Int] NoContent)

135− :<|> "post" :> Post '[JSON] ()

135+ :<|> "post" :> PostNoContent '[JSON] NoContent

136

137getApi :: Proxy GetApi

138getApi = Proxy

@@ -141,9 +141,9 @@ getSpec :: Spec

141getSpec = do

142 describe "Servant.API.Get" $ do

143 let server = return alice

144− :<|> return ()

144+ :<|> return NoContent

145− :<|> return (addHeader 5 ())

145+ :<|> return (addHeader 5 NoContent)

146− :<|> return ()

146+ :<|> return NoContent

147

148 with (return $ serve getApi server) $ do

149

@@ -157,7 +157,7 @@ getSpec = do

157 post "/empty" "" `shouldRespondWith` 405

158

159 it "returns headers" $ do

160− get "/emptyWithHeaders" `shouldRespondWith` 200 { matchHeaders = [ "H" <:> "5" ] }

160+ get "/emptyWithHeaders" `shouldRespondWith` 204 { matchHeaders = [ "H" <:> "5" ] }

161

162 it "returns 406 if the Accept header is not supported" $ do

163 Test.Hspec.Wai.request methodGet "" [(hAccept, "crazy/mime")] ""

@@ -168,9 +168,9 @@ headSpec :: Spec

168headSpec = do

169 describe "Servant.API.Head" $ do

170 let server = return alice

171− :<|> return ()

171+ :<|> return NoContent

172− :<|> return (addHeader 5 ())

172+ :<|> return (addHeader 5 NoContent)

173− :<|> return ()

173+ :<|> return NoContent

174 with (return $ serve getApi server) $ do

175

176 it "allows to GET a Person" $ do

servant/src/Servant/API.hs+2−2

@@ -52,7 +52,7 @@ import Servant.API.Alternative ((:<|>) (..))

52import Servant.API.Capture (Capture)

53import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,

54 FromFormUrlEncoded (..), JSON,

55− MimeRender (..),

55+ MimeRender (..), NoContent (NoContent),

56 MimeUnrender (..), OctetStream,

57 PlainText, ToFormUrlEncoded (..))

58import Servant.API.Header (Header (..))

@@ -77,7 +77,7 @@ import Servant.API.Verbs (Created, Delete, DeleteAccepted,

77 GetNonAuthoritative,

78 GetPartialContent,

79 GetResetContent,

80− NoContent (NoContent), Patch,

80+ Patch,

81 PatchAccepted, PatchNoContent,

82 PatchNoContent,

83 PatchNonAuthoritative, Post,

servant/src/Servant/API/ContentTypes.hs+26−32

@@ -11,11 +11,10 @@

11{-# LANGUAGE TypeFamilies #-}

12{-# LANGUAGE TypeOperators #-}

13{-# LANGUAGE UndecidableInstances #-}

14−#if !MIN_VERSION_base(4,8,0)

15−{-# LANGUAGE OverlappingInstances #-}

16−#endif

17{-# OPTIONS_HADDOCK not-home #-}

14{-# OPTIONS_HADDOCK not-home #-}

16+#include "overlapping-compat.h"

17+

19-- | A collection of basic Content-Types (also known as Internet Media

18-- | A collection of basic Content-Types (also known as Internet Media

20-- Types, or MIME types). Additionally, this module provides classes that

19-- Types, or MIME types). Additionally, this module provides classes that

21-- encapsulate how to serialize or deserialize values to or from

20-- encapsulate how to serialize or deserialize values to or from

@@ -57,6 +56,9 @@ module Servant.API.ContentTypes

57 , MimeRender(..)

56 , MimeRender(..)

58 , MimeUnrender(..)

57 , MimeUnrender(..)

59+ -- * NoContent

60+ , NoContent(..)

61+

60 -- * Internal

62 -- * Internal

61 , AcceptHeader(..)

63 , AcceptHeader(..)

62 , AllCTRender(..)

64 , AllCTRender(..)

@@ -75,8 +77,7 @@ import Control.Applicative ((*>), (<*))

75#endif

77#endif

76import Control.Arrow (left)

78import Control.Arrow (left)

77import Control.Monad

79import Control.Monad

78−import Data.Aeson (FromJSON, ToJSON, encode,

80+import Data.Aeson (FromJSON(..), ToJSON(..), encode)

79− parseJSON)

80import Data.Aeson.Parser (value)

81import Data.Aeson.Parser (value)

81import Data.Aeson.Types (parseEither)

82import Data.Aeson.Types (parseEither)

82import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,

83import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,

@@ -168,10 +169,7 @@ class (AllMime list) => AllCTRender (list :: [*]) a where

168 -- mimetype).

169 -- mimetype).

169 handleAcceptH :: Proxy list -> AcceptHeader -> a -> Maybe (ByteString, ByteString)

170 handleAcceptH :: Proxy list -> AcceptHeader -> a -> Maybe (ByteString, ByteString)

170

171

171−instance

172+instance OVERLAPPABLE_

172−#if MIN_VERSION_base(4,8,0)

173− {-# OVERLAPPABLE #-}

174−#endif

175 (AllMimeRender (ct ': cts) a) => AllCTRender (ct ': cts) a where

173 (AllMimeRender (ct ': cts) a) => AllCTRender (ct ': cts) a where

176 handleAcceptH _ (AcceptHeader accept) val = M.mapAcceptMedia lkup accept

174 handleAcceptH _ (AcceptHeader accept) val = M.mapAcceptMedia lkup accept

177 where pctyps = Proxy :: Proxy (ct ': cts)

175 where pctyps = Proxy :: Proxy (ct ': cts)

@@ -275,20 +273,14 @@ instance ( MimeUnrender ctyp a

275-- * MimeRender Instances

273-- * MimeRender Instances

276

274

277-- | `encode`

275-- | `encode`

278−instance

276+instance OVERLAPPABLE_

279−#if MIN_VERSION_base(4,8,0)

280− {-# OVERLAPPABLE #-}

281−#endif

282 ToJSON a => MimeRender JSON a where

277 ToJSON a => MimeRender JSON a where

283 mimeRender _ = encode

278 mimeRender _ = encode

284

279

285-- | @encodeFormUrlEncoded . toFormUrlEncoded@

280-- | @encodeFormUrlEncoded . toFormUrlEncoded@

286-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only

281-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only

287-- holds if every element of x is non-null (i.e., not @("", "")@)

282-- holds if every element of x is non-null (i.e., not @("", "")@)

288−instance

283+instance OVERLAPPABLE_

289−#if MIN_VERSION_base(4,8,0)

290− {-# OVERLAPPABLE #-}

291−#endif

292 ToFormUrlEncoded a => MimeRender FormUrlEncoded a where

284 ToFormUrlEncoded a => MimeRender FormUrlEncoded a where

293 mimeRender _ = encodeFormUrlEncoded . toFormUrlEncoded

285 mimeRender _ = encodeFormUrlEncoded . toFormUrlEncoded

294

286

@@ -312,25 +304,27 @@ instance MimeRender OctetStream ByteString where

312instance MimeRender OctetStream BS.ByteString where

304instance MimeRender OctetStream BS.ByteString where

313 mimeRender _ = fromStrict

305 mimeRender _ = fromStrict

314

306

315−instance

307+-- | A type for responses with content-body.

316−#if MIN_VERSION_base(4,8,0)

308+data NoContent = NoContent

317− {-# OVERLAPPING #-}

309+ deriving (Show, Eq, Read)

318−#endif

310+

311+instance FromJSON NoContent where

312+ parseJSON _ = return NoContent

313+

314+instance ToJSON NoContent where

315+ toJSON _ = ""

316+

317+

318+instance OVERLAPPING_

319− MimeRender JSON () where

319+ MimeRender JSON NoContent where

320 mimeRender _ _ = ""

321

322−instance

322+instance OVERLAPPING_

323−#if MIN_VERSION_base(4,8,0)

324− {-# OVERLAPPING #-}

325−#endif

326− MimeRender PlainText () where

323+ MimeRender PlainText NoContent where

327 mimeRender _ _ = ""

324 mimeRender _ _ = ""

328

325

329−instance

326+instance OVERLAPPING_

330−#if MIN_VERSION_base(4,8,0)

331− {-# OVERLAPPING #-}

332−#endif

333− MimeRender OctetStream () where

327+ MimeRender OctetStream NoContent where

334 mimeRender _ _ = ""

328 mimeRender _ _ = ""

335

329

336--------------------------------------------------------------------------

330--------------------------------------------------------------------------

servant/src/Servant/API/Verbs.hs+16−16

@@ -11,6 +11,7 @@ import GHC.TypeLits (Nat)

11import Network.HTTP.Types.Method (Method, StdMethod (..),

12 methodDelete, methodGet, methodHead,

13 methodPatch, methodPost, methodPut)

14+import Servant.API.ContentTypes (NoContent(..))

15-- | @Verb@ is a general type for representing HTTP verbs/methods. For

16-- | @Verb@ is a general type for representing HTTP verbs/methods. For

16-- convenience, type synonyms for each verb with a 200 response code are

17-- convenience, type synonyms for each verb with a 200 response code are

@@ -95,40 +96,40 @@ type PutNonAuthoritative contentTypes a = Verb 'PUT 203 contentTypes a

96-- ** 204 No Content

97-- ** 204 No Content

97--

98--

98−-- Indicates that no response body is being returned. Handlers for these must

99+-- Indicates that no response body is being returned. Handlers for these should

99−-- return 'NoContent'.

100+-- return 'NoContent', possibly with headers.

100--

101--

101-- If the document view should be reset, use @205 Reset Content@.

102-- If the document view should be reset, use @205 Reset Content@.

102

103

103-- | 'GET' with 204 status code.

104-- | 'GET' with 204 status code.

104−type GetNoContent contentTypes = Verb 'GET 204 contentTypes NoContent

105+type GetNoContent contentTypes noContent = Verb 'GET 204 contentTypes noContent

105-- | 'POST' with 204 status code.

106-- | 'POST' with 204 status code.

106−type PostNoContent contentTypes = Verb 'POST 204 contentTypes NoContent

107+type PostNoContent contentTypes noContent = Verb 'POST 204 contentTypes noContent

107-- | 'DELETE' with 204 status code.

108-- | 'DELETE' with 204 status code.

108−type DeleteNoContent contentTypes = Verb 'DELETE 204 contentTypes NoContent

109+type DeleteNoContent contentTypes noContent = Verb 'DELETE 204 contentTypes noContent

109-- | 'PATCH' with 204 status code.

110-- | 'PATCH' with 204 status code.

110−type PatchNoContent contentTypes = Verb 'PATCH 204 contentTypes NoContent

111+type PatchNoContent contentTypes noContent = Verb 'PATCH 204 contentTypes noContent

111-- | 'PUT' with 204 status code.

112-- | 'PUT' with 204 status code.

112−type PutNoContent contentTypes = Verb 'PUT 204 contentTypes NoContent

113+type PutNoContent contentTypes noContent = Verb 'PUT 204 contentTypes noContent

113

114

115

115-- ** 205 Reset Content

116-- ** 205 Reset Content

116--

117--

117−-- Indicates that no response body is being returned. Handlers for these must

118+-- Indicates that no response body is being returned. Handlers for these should

118−-- return 'NoContent'.

119+-- return 'NoContent', possibly with Headers.

119--

120--

120-- If the document view should not be reset, use @204 No Content@.

121-- If the document view should not be reset, use @204 No Content@.

121

122

122-- | 'GET' with 205 status code.

123-- | 'GET' with 205 status code.

123−type GetResetContent contentTypes = Verb 'GET 205 contentTypes NoContent

124+type GetResetContent contentTypes noContent = Verb 'GET 205 contentTypes noContent

124-- | 'POST' with 205 status code.

125-- | 'POST' with 205 status code.

125−type PostResetContent contentTypes = Verb 'POST 205 contentTypes NoContent

126+type PostResetContent contentTypes noContent = Verb 'POST 205 contentTypes noContent

126-- | 'DELETE' with 205 status code.

127-- | 'DELETE' with 205 status code.

127−type DeleteResetContent contentTypes = Verb 'DELETE 205 contentTypes NoContent

128+type DeleteResetContent contentTypes noContent = Verb 'DELETE 205 contentTypes noContent

128-- | 'PATCH' with 205 status code.

129-- | 'PATCH' with 205 status code.

129−type PatchResetContent contentTypes = Verb 'PATCH 205 contentTypes NoContent

130+type PatchResetContent contentTypes noContent = Verb 'PATCH 205 contentTypes noContent

130-- | 'PUT' with 205 status code.

131-- | 'PUT' with 205 status code.

131−type PutResetContent contentTypes = Verb 'PUT 205 contentTypes NoContent

132+type PutResetContent contentTypes noContent = Verb 'PUT 205 contentTypes noContent

132

133

134

134-- ** 206 Partial Content

135-- ** 206 Partial Content

@@ -140,9 +141,8 @@ type PutResetContent contentTypes = Verb 'PUT 205 contentTypes NoContent

140-- RFC7233 Section 4.1>

141-- RFC7233 Section 4.1>

141

142

142-- | 'GET' with 206 status code.

143-- | 'GET' with 206 status code.

143−type GetPartialContent contentTypes = Verb 'GET 205 contentTypes NoContent

144+type GetPartialContent contentTypes noContent = Verb 'GET 205 contentTypes noContent

144

145

145−data NoContent = NoContent

146

147class ReflectMethod a where

148 reflectMethod :: proxy a -> Method