Review fixes

servant-client/src/Servant/Client.hs

@@ -24,7 +24,6 @@ module Servant.Client
 #if !MIN_VERSION_base(4,8,0)
 import           Control.Applicative        ((<$>))
 #endif
-import           Control.Monad
 import           Control.Monad.Trans.Except
 import           Data.ByteString.Lazy       (ByteString)
 import           Data.List
@@ -420,6 +419,6 @@ It may seem to make more sense to have:
 
 But this means that if another instance exists that does *not* require
 non-empty lists, but is otherwise more specific, no instance will be overall
-more specific. This in turns generally means adding yet another instance (one
+more specific. This in turn generally means adding yet another instance (one
 for empty and one for non-empty lists).
 -}

servant-client/src/Servant/Common/Req.hs

@@ -156,7 +156,7 @@ performRequest reqMethod req reqHost manager = do
 
 performRequestCT :: MimeUnrender ct result =>
   Proxy ct -> Method -> Req -> BaseUrl -> Manager
-  -> ExceptT ServantError IO ([HTTP.Header], result)
+    -> ExceptT ServantError IO ([HTTP.Header], result)
 performRequestCT ct reqMethod req reqHost manager = do
   let acceptCT = contentType ct
   (_status, respBody, respCT, hdrs, _response) <-

servant-server/test/Servant/ServerSpec.hs

@@ -3,8 +3,10 @@
 {-# LANGUAGE DeriveGeneric        #-}
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE PolyKinds            #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances    #-}
 
@@ -13,7 +15,7 @@ module Servant.ServerSpec where
 #if !MIN_VERSION_base(4,8,0)
 import           Control.Applicative        ((<$>))
 #endif
-import           Control.Monad              (forM_, when)
+import           Control.Monad              (forM_, when, unless)
 import           Control.Monad.Trans.Except (ExceptT, throwE)
 import           Data.Aeson                 (FromJSON, ToJSON, decode', encode)
 import           Data.ByteString.Conversion ()
@@ -23,82 +25,144 @@ import           Data.String                (fromString)
 import           Data.String.Conversions    (cs)
 import qualified Data.Text                  as T
 import           GHC.Generics               (Generic)
-import           Network.HTTP.Types         (hAccept, hContentType,
+import           Network.HTTP.Types         (Status (..), hAccept, hContentType,
-                                             methodDelete, methodGet, methodHead,
+                                             methodDelete, methodGet,
-                                             methodPatch, methodPost, methodPut,
+                                             methodHead, methodPatch,
-                                             ok200, parseQuery, Status(..))
+                                             methodPost, methodPut, ok200,
+                                             parseQuery)
 import           Network.Wai                (Application, Request, pathInfo,
                                              queryString, rawQueryString,
-                                             responseLBS, responseBuilder)
+                                             responseBuilder, responseLBS)
-import           Network.Wai.Internal       (Response(ResponseBuilder))
+import           Network.Wai.Internal       (Response (ResponseBuilder))
 import           Network.Wai.Test           (defaultRequest, request,
-                                             runSession, simpleBody)
+                                             runSession, simpleBody,
+                                             simpleHeaders, simpleStatus)
 import           Servant.API                ((:<|>) (..), (:>), Capture, Delete,
-                                             Get, Header (..), Headers,
+                                             Get, Header (..),
-                                             HttpVersion, IsSecure (..), JSON,
+                                             Headers, HttpVersion,
-                                             Patch, PlainText, Post, Put,
+                                             IsSecure (..), JSON,
+                                             NoContent (..), Patch, PlainText,
+                                             Post, Put,
                                              QueryFlag, QueryParam, QueryParams,
-                                             Raw, RemoteHost, ReqBody, GetNoContent,
+                                             Raw, RemoteHost, ReqBody,
-                                             PostNoContent, addHeader, NoContent(..))
+                                             StdMethod (..), Verb, addHeader)
-import           Servant.Server             (Server, serve, ServantErr(..), err404)
+import           Servant.Server             (ServantErr (..), Server, err404,
-import           Test.Hspec                 (Spec, describe, it, shouldBe)
+                                             serve)
+import           Test.Hspec                 (Spec, context, describe, it,
+                                             shouldBe, shouldContain)
 import           Test.Hspec.Wai             (get, liftIO, matchHeaders,
-                                             matchStatus, post, request,
+                                             matchStatus, request,
                                              shouldRespondWith, with, (<:>))
-import           Servant.Server.Internal.RoutingApplication (toApplication, RouteResult(..))
+
+import           Servant.Server.Internal.RoutingApplication
+                                            (toApplication, RouteResult(..))
 import           Servant.Server.Internal.Router
                                             (tweakResponse, runRouter,
                                              Router, Router'(LeafRouter))
 
 
--- * test data types
+-- * Specs
-
-data Person = Person {
-  name :: String,
-  age  :: Integer
- }
-  deriving (Eq, Show, Generic)
-
-instance ToJSON Person
-instance FromJSON Person
-
-alice :: Person
-alice = Person "Alice" 42
-
-data Animal = Animal {
-  species      :: String,
-  numberOfLegs :: Integer
- }
-  deriving (Eq, Show, Generic)
-
-instance ToJSON Animal
-instance FromJSON Animal
-
-jerry :: Animal
-jerry = Animal "Mouse" 4
-
-tweety :: Animal
-tweety = Animal "Bird" 2
-
-
--- * specs
 
 spec :: Spec
 spec = do
+  verbSpec
   captureSpec
-  getSpec
-  headSpec
-  postSpec
-  putSpec
-  patchSpec
   queryParamSpec
+  reqBodySpec
   headerSpec
   rawSpec
-  unionSpec
+  alternativeSpec
-  routerSpec
   responseHeadersSpec
-  miscReqCombinatorsSpec
+  routerSpec
+  miscCombinatorSpec
 
+------------------------------------------------------------------------------
+-- * verbSpec {{{
+------------------------------------------------------------------------------
+
+type VerbApi method status
+    =                Verb method status '[JSON] Person
+ :<|> "noContent" :> Verb method status '[JSON] NoContent
+ :<|> "header"    :> Verb method status '[JSON] (Headers '[Header "H" Int] Person)
+ :<|> "headerNC"  :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent)
+
+verbSpec :: Spec
+verbSpec = describe "Servant.API.Verb" $ do
+  let server :: Server (VerbApi method status)
+      server = return alice
+          :<|> return NoContent
+          :<|> return (addHeader 5 alice)
+          :<|> return (addHeader 10 NoContent)
+      get200     = Proxy :: Proxy (VerbApi 'GET 200)
+      post210    = Proxy :: Proxy (VerbApi 'POST 210)
+      put203     = Proxy :: Proxy (VerbApi 'PUT 203)
+      delete280  = Proxy :: Proxy (VerbApi 'DELETE 280)
+      patch214   = Proxy :: Proxy (VerbApi 'PATCH 214)
+      wrongMethod m = if m == methodPatch then methodPost else methodPatch
+      test desc api method (status :: Int) = context desc $
+
+        with (return $ serve api server) $ do
+
+          -- HEAD and 214/215 need not return bodies
+          unless (status `elem` [214, 215] || method == methodHead) $
+            it "returns the person" $ do
+              response <- Test.Hspec.Wai.request method "/" [] ""
+              liftIO $ statusCode (simpleStatus response) `shouldBe` status
+              liftIO $ decode' (simpleBody response) `shouldBe` Just alice
+
+          it "returns no content on NoContent" $ do
+              response <- Test.Hspec.Wai.request method "/noContent" [] ""
+              liftIO $ statusCode (simpleStatus response) `shouldBe` status
+              liftIO $ simpleBody response `shouldBe` ""
+
+          -- HEAD should not return body
+          when (method == methodHead) $
+            it "HEAD returns no content body" $ do
+              response <- Test.Hspec.Wai.request method "/" [] ""
+              liftIO $ simpleBody response `shouldBe` ""
+
+          it "throws 405 on wrong method " $ do
+            Test.Hspec.Wai.request (wrongMethod method) "/" [] ""
+              `shouldRespondWith` 405
+
+          it "returns headers" $ do
+            response1 <- Test.Hspec.Wai.request method "/header" [] ""
+            liftIO $ statusCode (simpleStatus response1) `shouldBe` status
+            liftIO $ simpleHeaders response1 `shouldContain` [("H", "5")]
+
+            response2 <- Test.Hspec.Wai.request method "/header" [] ""
+            liftIO $ statusCode (simpleStatus response2) `shouldBe` status
+            liftIO $ simpleHeaders response2 `shouldContain` [("H", "5")]
+
+          it "handles trailing '/' gracefully" $ do
+            response <- Test.Hspec.Wai.request method "/headerNC/" [] ""
+            liftIO $ statusCode (simpleStatus response) `shouldBe` status
+
+          it "returns 406 if the Accept header is not supported" $ do
+            Test.Hspec.Wai.request method "" [(hAccept, "crazy/mime")] ""
+              `shouldRespondWith` 406
+
+          it "responds if the Accept header is supported" $ do
+            response <- Test.Hspec.Wai.request method ""
+               [(hAccept, "application/json")] ""
+            liftIO $ statusCode (simpleStatus response) `shouldBe` status
+
+          it "sets the Content-Type header" $ do
+            response <- Test.Hspec.Wai.request method "" [] ""
+            liftIO $ simpleHeaders response `shouldContain`
+              [("Content-Type", "application/json")]
+
+  test "GET 200" get200 methodGet 200
+  test "POST 210" post210 methodPost 210
+  test "PUT 203" put203 methodPut 203
+  test "DELETE 280" delete280 methodDelete 280
+  test "PATCH 214" patch214 methodPatch 214
+  test "GET 200 with HEAD" get200 methodHead 200
+
+-- }}}
+------------------------------------------------------------------------------
+-- * captureSpec {{{
+------------------------------------------------------------------------------
 
 type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
 captureApi :: Proxy CaptureApi
@@ -128,68 +192,10 @@ captureSpec = do
       it "strips the captured path snippet from pathInfo" $ do
         get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
 
-
+-- }}}
-type GetApi = Get '[JSON] Person
+------------------------------------------------------------------------------
-        :<|> "empty" :> GetNoContent '[JSON] NoContent
+-- * queryParamSpec {{{
-        :<|> "emptyWithHeaders" :> GetNoContent '[JSON] (Headers '[Header "H" Int] NoContent)
+------------------------------------------------------------------------------
-        :<|> "post" :> PostNoContent '[JSON] NoContent
-
-getApi :: Proxy GetApi
-getApi = Proxy
-
-getSpec :: Spec
-getSpec = do
-  describe "Servant.API.Get" $ do
-    let server = return alice
-            :<|> return NoContent
-            :<|> return (addHeader 5 NoContent)
-            :<|> return NoContent
-
-    with (return $ serve getApi server) $ do
-
-      it "allows to GET a Person" $ do
-        response <- get "/"
-        return response `shouldRespondWith` 200
-        liftIO $ decode' (simpleBody response) `shouldBe` Just alice
-
-      it "throws 405 (wrong method) on POSTs" $ do
-        post "/" "" `shouldRespondWith` 405
-        post "/empty" "" `shouldRespondWith` 405
-
-      it "returns headers" $ do
-        get "/emptyWithHeaders" `shouldRespondWith` 204 { matchHeaders = [ "H" <:> "5" ] }
-
-      it "returns 406 if the Accept header is not supported" $ do
-        Test.Hspec.Wai.request methodGet "" [(hAccept, "crazy/mime")] ""
-          `shouldRespondWith` 406
-
-
-headSpec :: Spec
-headSpec = do
-  describe "Servant.API.Head" $ do
-    let server = return alice
-            :<|> return NoContent
-            :<|> return (addHeader 5 NoContent)
-            :<|> return NoContent
-    with (return $ serve getApi server) $ do
-
-      it "allows to GET a Person" $ do
-        response <- Test.Hspec.Wai.request methodHead "/" [] ""
-        return response `shouldRespondWith` 200
-        liftIO $ decode' (simpleBody response) `shouldBe` (Nothing :: Maybe Person)
-
-      it "does not allow HEAD to POST route" $ do
-        response <- Test.Hspec.Wai.request methodHead "/post" [] ""
-        return response `shouldRespondWith` 405
-
-      it "throws 405 (wrong method) on POSTs" $ do
-        post "/" "" `shouldRespondWith` 405
-        post "/empty" "" `shouldRespondWith` 405
-
-      it "returns 406 if the Accept header is not supported" $ do
-        Test.Hspec.Wai.request methodHead "" [(hAccept, "crazy/mime")] ""
-          `shouldRespondWith` 406
-
 
 type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person
                 :<|> "a" :> QueryParams "names" String :> Get '[JSON] Person
@@ -274,122 +280,41 @@ queryParamSpec = do
               name = "Alice"
              }
 
-type PostApi =
+-- }}}
-       ReqBody '[JSON] Person :> Post '[JSON] Integer
+------------------------------------------------------------------------------
-  :<|> "bla" :> ReqBody '[JSON] Person :> Post '[JSON] Integer
+-- * reqBodySpec {{{
-  :<|> "empty" :> Post '[JSON] ()
+------------------------------------------------------------------------------
+type ReqBodyApi = ReqBody '[JSON] Person :> Post '[JSON] Person
+           :<|> "blah" :> ReqBody '[JSON] Person :> Put '[JSON] Integer
 
-postApi :: Proxy PostApi
+reqBodyApi :: Proxy ReqBodyApi
-postApi = Proxy
+reqBodyApi = Proxy
 
-postSpec :: Spec
+reqBodySpec :: Spec
-postSpec = do
+reqBodySpec = describe "Servant.API.ReqBody" $ do
-  describe "Servant.API.Post and .ReqBody" $ do
-    let server = return . age :<|> return . age :<|> return ()
-    with (return $ serve postApi server) $ do
-      let post' x = Test.Hspec.Wai.request methodPost x [(hContentType
-                                                        , "application/json;charset=utf-8")]
 
-      it "allows to POST a Person" $ do
+  let server :: Server ReqBodyApi
-        post' "/" (encode alice) `shouldRespondWith` "42"{
+      server = return :<|> return . age
-          matchStatus = 200
+      mkReq method x = Test.Hspec.Wai.request method x
-         }
+         [(hContentType, "application/json;charset=utf-8")]
 
-      it "allows alternative routes if all have request bodies" $ do
+  with (return $ serve reqBodyApi server) $ do
-        post' "/bla" (encode alice) `shouldRespondWith` "42"{
-          matchStatus = 200
-         }
 
-      it "handles trailing '/' gracefully" $ do
+    it "passes the argument to the handler" $ do
-        post' "/bla/" (encode alice) `shouldRespondWith` "42"{
+      response <- mkReq methodPost "" (encode alice)
-          matchStatus = 200
+      liftIO $ decode' (simpleBody response) `shouldBe` Just alice
-         }
 
-      it "correctly rejects invalid request bodies with status 400" $ do
+    it "rejects invalid request bodies with status 400" $ do
-        post' "/" "some invalid body" `shouldRespondWith` 400
+      mkReq methodPut "/blah" "some invalid body" `shouldRespondWith` 400
 
-      it "responds with 415 if the request body media type is unsupported" $ do
+    it "responds with 415 if the request body media type is unsupported" $ do
-        let post'' x = Test.Hspec.Wai.request methodPost x [(hContentType
+      Test.Hspec.Wai.request methodPost "/"
-                                                            , "application/nonsense")]
+        [(hContentType, "application/nonsense")] "" `shouldRespondWith` 415
-        post'' "/" "anything at all" `shouldRespondWith` 415
 
-type PutApi =
+-- }}}
-       ReqBody '[JSON] Person :> Put '[JSON] Integer
+------------------------------------------------------------------------------
-  :<|> "bla" :> ReqBody '[JSON] Person :> Put '[JSON] Integer
+-- * headerSpec {{{
-  :<|> "empty" :> Put '[JSON] ()
+------------------------------------------------------------------------------
-
-putApi :: Proxy PutApi
-putApi = Proxy
-
-putSpec :: Spec
-putSpec = do
-  describe "Servant.API.Put and .ReqBody" $ do
-    let server = return . age :<|> return . age :<|> return ()
-    with (return $ serve putApi server) $ do
-      let put' x = Test.Hspec.Wai.request methodPut x [(hContentType
-                                                        , "application/json;charset=utf-8")]
-
-      it "allows to put a Person" $ do
-        put' "/" (encode alice) `shouldRespondWith` "42"{
-          matchStatus = 200
-         }
-
-      it "allows alternative routes if all have request bodies" $ do
-        put' "/bla" (encode alice) `shouldRespondWith` "42"{
-          matchStatus = 200
-         }
-
-      it "handles trailing '/' gracefully" $ do
-        put' "/bla/" (encode alice) `shouldRespondWith` "42"{
-          matchStatus = 200
-         }
-
-      it "correctly rejects invalid request bodies with status 400" $ do
-        put' "/" "some invalid body" `shouldRespondWith` 400
-
-      it "responds with 415 if the request body media type is unsupported" $ do
-        let put'' x = Test.Hspec.Wai.request methodPut x [(hContentType
-                                                            , "application/nonsense")]
-        put'' "/" "anything at all" `shouldRespondWith` 415
-
-type PatchApi =
-       ReqBody '[JSON] Person :> Patch '[JSON] Integer
-  :<|> "bla" :> ReqBody '[JSON] Person :> Patch '[JSON] Integer
-  :<|> "empty" :> Patch '[JSON] ()
-
-patchApi :: Proxy PatchApi
-patchApi = Proxy
-
-patchSpec :: Spec
-patchSpec = do
-  describe "Servant.API.Patch and .ReqBody" $ do
-    let server = return . age :<|> return . age :<|> return ()
-    with (return $ serve patchApi server) $ do
-      let patch' x = Test.Hspec.Wai.request methodPatch x [(hContentType
-                                                        , "application/json;charset=utf-8")]
-
-      it "allows to patch a Person" $ do
-        patch' "/" (encode alice) `shouldRespondWith` "42"{
-          matchStatus = 200
-         }
-
-      it "allows alternative routes if all have request bodies" $ do
-        patch' "/bla" (encode alice) `shouldRespondWith` "42"{
-          matchStatus = 200
-         }
-
-      it "handles trailing '/' gracefully" $ do
-        patch' "/bla/" (encode alice) `shouldRespondWith` "42"{
-          matchStatus = 200
-         }
-
-      it "correctly rejects invalid request bodies with status 400" $ do
-        patch' "/" "some invalid body" `shouldRespondWith` 400
-
-      it "responds with 415 if the request body media type is unsupported" $ do
-        let patch'' x = Test.Hspec.Wai.request methodPatch x [(hContentType
-                                                            , "application/nonsense")]
-        patch'' "/" "anything at all" `shouldRespondWith` 415
 
 type HeaderApi a = Header "MyHeader" a :> Delete '[JSON] ()
 headerApi :: Proxy (HeaderApi a)
@@ -418,12 +343,19 @@ headerSpec = describe "Servant.API.Header" $ do
         it "passes the header to the handler (String)" $
             delete' "/" "" `shouldRespondWith` 200
 
+-- }}}
+------------------------------------------------------------------------------
+-- * rawSpec {{{
+------------------------------------------------------------------------------
 
 type RawApi = "foo" :> Raw
+
 rawApi :: Proxy RawApi
 rawApi = Proxy
+
 rawApplication :: Show a => (Request -> a) -> Application
-rawApplication f request_ respond = respond $ responseLBS ok200 [] (cs $ show $ f request_)
+rawApplication f request_ respond = respond $ responseLBS ok200 []
+    (cs $ show $ f request_)
 
 rawSpec :: Spec
 rawSpec = do
@@ -444,7 +376,10 @@ rawSpec = do
         liftIO $ do
           simpleBody response `shouldBe` cs (show ["bar" :: String])
 
-
+-- }}}
+------------------------------------------------------------------------------
+-- * alternativeSpec {{{
+------------------------------------------------------------------------------
 type AlternativeApi =
        "foo" :> Get '[JSON] Person
   :<|> "bar" :> Get '[JSON] Animal
@@ -452,11 +387,12 @@ type AlternativeApi =
   :<|> "bar" :> Post '[JSON] Animal
   :<|> "bar" :> Put '[JSON] Animal
   :<|> "bar" :> Delete '[JSON] ()
-unionApi :: Proxy AlternativeApi
-unionApi = Proxy
 
-unionServer :: Server AlternativeApi
+alternativeApi :: Proxy AlternativeApi
-unionServer =
+alternativeApi = Proxy
+
+alternativeServer :: Server AlternativeApi
+alternativeServer =
        return alice
   :<|> return jerry
   :<|> return "a string"
@@ -464,10 +400,10 @@ unionServer =
   :<|> return jerry
   :<|> return ()
 
-unionSpec :: Spec
+alternativeSpec :: Spec
-unionSpec = do
+alternativeSpec = do
   describe "Servant.API.Alternative" $ do
-    with (return $ serve unionApi unionServer) $ do
+    with (return $ serve alternativeApi alternativeServer) $ do
 
       it "unions endpoints" $ do
         response <- get "/foo"
@@ -484,7 +420,10 @@ unionSpec = do
 
       it "returns 404 if the path does not exist" $ do
         get "/nonexistent" `shouldRespondWith` 404
-
+-- }}}
+------------------------------------------------------------------------------
+-- * responseHeaderSpec {{{
+------------------------------------------------------------------------------
 type ResponseHeadersApi =
        Get   '[JSON] (Headers '[Header "H1" Int, Header "H2" String] String)
   :<|> Post  '[JSON] (Headers '[Header "H1" Int, Header "H2" String] String)
@@ -501,26 +440,29 @@ responseHeadersSpec :: Spec
 responseHeadersSpec = describe "ResponseHeaders" $ do
   with (return $ serve (Proxy :: Proxy ResponseHeadersApi) responseHeadersServer) $ do
 
-    let methods = [(methodGet, 200), (methodPost, 200), (methodPut, 200), (methodPatch, 200)]
+    let methods = [methodGet, methodPost, methodPut, methodPatch]
 
     it "includes the headers in the response" $
-      forM_ methods $ \(method, expected) ->
+      forM_ methods $ \method ->
         Test.Hspec.Wai.request method "/" [] ""
           `shouldRespondWith` "\"hi\""{ matchHeaders = ["H1" <:> "5", "H2" <:> "kilroy"]
-                                      , matchStatus  = expected
+                                      , matchStatus  = 200
                                       }
 
     it "responds with not found for non-existent endpoints" $
-      forM_ methods $ \(method,_) ->
+      forM_ methods $ \method ->
         Test.Hspec.Wai.request method "blahblah" [] ""
           `shouldRespondWith` 404
 
     it "returns 406 if the Accept header is not supported" $
-      forM_ methods $ \(method,_) ->
+      forM_ methods $ \method ->
         Test.Hspec.Wai.request method "" [(hAccept, "crazy/mime")] ""
           `shouldRespondWith` 406
 
-
+-- }}}
+------------------------------------------------------------------------------
+-- * routerSpec {{{
+------------------------------------------------------------------------------
 routerSpec :: Spec
 routerSpec = do
   describe "Servant.Server.Internal.Router" $ do
@@ -539,6 +481,10 @@ routerSpec = do
       it "calls f on route result" $ do
         get "" `shouldRespondWith` 202
 
+-- }}}
+------------------------------------------------------------------------------
+-- * miscCombinatorSpec {{{
+------------------------------------------------------------------------------
 type MiscCombinatorsAPI
   =    "version" :> HttpVersion :> Get '[JSON] String
   :<|> "secure"  :> IsSecure :> Get '[JSON] String
@@ -557,8 +503,8 @@ miscServ = versionHandler
         secureHandler NotSecure = return "not secure"
         hostHandler = return . show
 
-miscReqCombinatorsSpec :: Spec
+miscCombinatorSpec :: Spec
-miscReqCombinatorsSpec = with (return $ serve miscApi miscServ) $
+miscCombinatorSpec = with (return $ serve miscApi miscServ) $
   describe "Misc. combinators for request inspection" $ do
     it "Successfully gets the HTTP version specified in the request" $
       go "/version" "\"HTTP/1.0\""
@@ -570,3 +516,35 @@ miscReqCombinatorsSpec = with (return $ serve miscApi miscServ) $
       go "/host" "\"0.0.0.0:0\""
 
   where go path res = Test.Hspec.Wai.get path `shouldRespondWith` res
+-- }}}
+------------------------------------------------------------------------------
+-- * Test data types {{{
+------------------------------------------------------------------------------
+
+data Person = Person {
+  name :: String,
+  age  :: Integer
+ }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Person
+instance FromJSON Person
+
+alice :: Person
+alice = Person "Alice" 42
+
+data Animal = Animal {
+  species      :: String,
+  numberOfLegs :: Integer
+ }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Animal
+instance FromJSON Animal
+
+jerry :: Animal
+jerry = Animal "Mouse" 4
+
+tweety :: Animal
+tweety = Animal "Bird" 2
+-- }}}

servant/src/Servant/API.hs

@@ -70,7 +70,7 @@ import           Servant.API.ResponseHeaders (AddHeader (addHeader),
                                               getHeadersHList, getResponse)
 import           Servant.API.Sub             ((:>))
 import           Servant.API.Vault           (Vault)
-import           Servant.API.Verbs           (Created, Delete, DeleteAccepted,
+import           Servant.API.Verbs           (PostCreated, Delete, DeleteAccepted,
                                               DeleteNoContent,
                                               DeleteNonAuthoritative, Get,
                                               GetAccepted, GetNoContent,
@@ -87,7 +87,7 @@ import           Servant.API.Verbs           (Created, Delete, DeleteAccepted,
                                               PutAccepted, PutNoContent,
                                               PutNoContent, PutNonAuthoritative,
                                               ReflectMethod (reflectMethod),
-                                              Verb)
+                                              Verb, StdMethod(..))
 import           Servant.Utils.Links         (HasLink (..), IsElem, IsElem',
                                               URI (..), safeLink)
 import           Web.HttpApiData             (FromHttpApiData (..),

servant/src/Servant/API/ContentTypes.hs

@@ -304,7 +304,7 @@ instance MimeRender OctetStream ByteString where
 instance MimeRender OctetStream BS.ByteString where
     mimeRender _ = fromStrict
 
--- | A type for responses with content-body.
+-- | A type for responses without content-body.
 data NoContent = NoContent
   deriving (Show, Eq, Read)
 

servant/src/Servant/API/Verbs.hs

@@ -3,17 +3,20 @@
 {-# LANGUAGE DeriveGeneric      #-}
 {-# LANGUAGE KindSignatures     #-}
 {-# LANGUAGE PolyKinds          #-}
-module Servant.API.Verbs where
+module Servant.API.Verbs
+  ( module Servant.API.Verbs
+  , StdMethod(GET, POST, HEAD, PUT, DELETE, TRACE, CONNECT, OPTIONS, PATCH)
+  ) where
 
 import           Data.Typeable             (Typeable)
+import           Data.Proxy                (Proxy)
 import           GHC.Generics              (Generic)
 import           GHC.TypeLits              (Nat)
 import           Network.HTTP.Types.Method (Method, StdMethod (..),
                                             methodDelete, methodGet, methodHead,
                                             methodPatch, methodPost, methodPut)
-import           Servant.API.ContentTypes  (NoContent(..))
 
--- | @Verb@ is a general type for representing HTTP verbs/methods. For
+-- | @Verb@ is a general type for representing HTTP verbs (a.k.a. methods). For
 -- convenience, type synonyms for each verb with a 200 response code are
 -- provided, but you are free to define your own:
 --
@@ -55,7 +58,7 @@ type Patch  contentTypes a = Verb 'PATCH  200 contentTypes a
 
 -- | 'POST' with 201 status code.
 --
-type Created contentTypes a = Verb 'POST 201 contentTypes a
+type PostCreated contentTypes a = Verb 'POST 201 contentTypes a
 
 
 -- ** 202 Accepted
@@ -141,11 +144,11 @@ type PutResetContent contentTypes noContent = Verb 'PUT 205 contentTypes noConte
 -- RFC7233 Section 4.1>
 
 -- | 'GET' with 206 status code.
-type GetPartialContent contentTypes noContent = Verb 'GET 205 contentTypes noContent
+type GetPartialContent contentTypes noContent = Verb 'GET 206 contentTypes noContent
 
 
 class ReflectMethod a where
-    reflectMethod :: proxy a -> Method
+    reflectMethod :: Proxy a -> Method
 
 instance ReflectMethod 'GET where
     reflectMethod _ = methodGet

servant/src/Servant/Utils/Links.hs

@@ -74,9 +74,7 @@
 -- >>> safeLink api bad_link
 -- ...
 --     Could not deduce (Or
---                         (IsElem'
+--                         (IsElem' (Verb 'DELETE 200 '[JSON] ()) (Verb 'GET 200 '[JSON] Int))
---                            (Verb 'Network.HTTP.Types.Method.DELETE 200 '[JSON] ())
---                            (Verb 'Network.HTTP.Types.Method.GET 200 '[JSON] Int))
 --                         (IsElem'
 --                            ("hello" :> Delete '[JSON] ())
 --                            ("bye" :> (QueryParam "name" String :> Delete '[JSON] ()))))