Remove 'default' status code from HttpMethod type

Instead we use a type family to set this, where it's needed (for
backwards compatibility).

servant-server/src/Servant/Server/Internal.hs

@@ -43,7 +43,7 @@ import           Network.Wai                 (Application, lazyRequestBody,
                                               requestMethod, responseLBS, remoteHost,
                                               isSecure, vault, httpVersion, Response,
                                               Request)
-import           Servant.API                 ((:<|>) (..), (:>), Capture,
+import           Servant.API                 ((:<|>) (..), (:>), Capture, DefaultStatusCode,
                                               Header, HttpMethod, IsSecure(..),
                                               MatrixFlag, MatrixParam, MatrixParams,
                                               QueryFlag, QueryParam, QueryParams,
@@ -236,25 +236,24 @@ instance
 #endif
          ( AllCTRender ctypes a
          , KnownSymbol method
-         , KnownNat status
+         , KnownNat (DefaultStatusCode method)
-         ) => HasServer (HttpMethod method status ctypes a) where
+         ) => HasServer (HttpMethod method ctypes a) where
 
-  type ServerT (HttpMethod method status ctypes a) m = m a
+  type ServerT (HttpMethod method ctypes a) m = m a
 
   route Proxy = methodRouter method (Proxy :: Proxy ctypes) status
     where 
       method = B8.pack $ symbolVal (Proxy :: Proxy method)
-      status = toEnum $ fromInteger $ natVal (Proxy :: Proxy status)
+      status = toEnum $ fromInteger $ natVal (Proxy :: Proxy (DefaultStatusCode method))
 
 instance
 #if MIN_VERSION_base(4,8,0)
          {-# OVERLAPPING #-}
 #endif 
         ( KnownSymbol method
-        , KnownNat status
+        ) => HasServer (HttpMethod method ctypes ()) where
-        ) => HasServer (HttpMethod method status ctypes ()) where
 
-  type ServerT (HttpMethod method status ctypes ()) m = m ()
+  type ServerT (HttpMethod method ctypes ()) m = m ()
 
   route Proxy = methodRouterEmpty method
     where 
@@ -269,15 +268,15 @@ instance
          ( GetHeaders (Headers h v)
          , AllCTRender ctypes v
          , KnownSymbol method
-         , KnownNat status
+         , KnownNat (DefaultStatusCode method)
-         ) => HasServer (HttpMethod method status ctypes (Headers h v)) where
+         ) => HasServer (HttpMethod method ctypes (Headers h v)) where
 
-  type ServerT (HttpMethod method status ctypes (Headers h v)) m = m (Headers h v)
+  type ServerT (HttpMethod method ctypes (Headers h v)) m = m (Headers h v)
 
   route Proxy = methodRouterHeaders method (Proxy :: Proxy ctypes) status
     where 
       method = B8.pack $ symbolVal (Proxy :: Proxy method)
-      status = toEnum $ fromInteger $ natVal (Proxy :: Proxy status)
+      status = toEnum $ fromInteger $ natVal (Proxy :: Proxy (DefaultStatusCode method))
 
 
 -- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,

servant/src/Servant/API.hs

@@ -75,7 +75,7 @@ import           Servant.API.HttpVersion     (HttpVersion (..))
 import           Servant.API.IsSecure        (IsSecure (..))
 import           Servant.API.MatrixParam     (MatrixFlag, MatrixParam,
                                               MatrixParams)
-import           Servant.API.Methods         (HttpMethod)
+import           Servant.API.Methods         (DefaultStatusCode, HttpMethod)
 import           Servant.API.Patch           (Patch)
 import           Servant.API.Post            (Post)
 import           Servant.API.Put             (Put)

servant/src/Servant/API/Delete.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE KindSignatures     #-}
+{-# LANGUAGE TypeFamilies       #-}
 {-# OPTIONS_HADDOCK not-home    #-}
 module Servant.API.Delete (Delete) where
 
@@ -12,7 +13,9 @@ import           Servant.API.Methods
 --
 -- >>>            -- DELETE /books/:isbn
 -- >>> type MyApi = "books" :> Capture "isbn" Text :> Delete '[JSON] ()
-type Delete (contentTypes :: [*]) a = HttpMethod "DELETE" 200 contentTypes a
+type Delete (contentTypes :: [*]) a = HttpMethod "DELETE" contentTypes a
+
+type instance DefaultStatusCode "DELETE" = 200
 
 -- $setup
 -- >>> import Servant.API

servant/src/Servant/API/Get.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE KindSignatures     #-}
+{-# LANGUAGE TypeFamilies       #-}
 {-# OPTIONS_HADDOCK not-home    #-}
 module Servant.API.Get (Get) where
 
@@ -11,7 +12,9 @@ import           Servant.API.Methods
 -- Example:
 --
 -- >>> type MyApi = "books" :> Get '[JSON] [Book]
-type Get (contentTypes :: [*]) a = HttpMethod "GET" 200 contentTypes a
+type Get (contentTypes :: [*]) a = HttpMethod "GET" contentTypes a
+
+type instance DefaultStatusCode "GET" = 200
 
 -- $setup
 -- >>> import Servant.API

servant/src/Servant/API/Methods.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE KindSignatures     #-}
+{-# LANGUAGE TypeFamilies       #-}
 {-# OPTIONS_HADDOCK not-home    #-}
 
 module Servant.API.Methods where
@@ -8,5 +9,7 @@ module Servant.API.Methods where
 import           Data.Typeable (Typeable)
 import           GHC.TypeLits (Nat, Symbol)
 
-data HttpMethod (m :: Symbol) (s :: Nat) (contentTypes :: [*]) a 
+data HttpMethod (m :: Symbol) (contentTypes :: [*]) a 
     deriving Typeable
+
+type family DefaultStatusCode (m :: Symbol) :: Nat

servant/src/Servant/API/Patch.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE KindSignatures     #-}
+{-# LANGUAGE TypeFamilies       #-}
 {-# OPTIONS_HADDOCK not-home    #-}
 module Servant.API.Patch (Patch) where
 
@@ -18,7 +19,9 @@ import           Servant.API.Methods
 -- >>>            -- with a JSON encoded Book as the request body
 -- >>>            -- returning the just-created Book
 -- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Patch '[JSON] Book
-type Patch (contentTypes :: [*]) a = HttpMethod "PATCH" 200 contentTypes a
+type Patch (contentTypes :: [*]) a = HttpMethod "PATCH" contentTypes a
+
+type instance DefaultStatusCode "PATCH" = 200
 
 -- $setup
 -- >>> import Servant.API

servant/src/Servant/API/Post.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE KindSignatures     #-}
+{-# LANGUAGE TypeFamilies       #-}
 {-# OPTIONS_HADDOCK not-home    #-}
 module Servant.API.Post (Post) where
 
@@ -16,7 +17,9 @@ import           Servant.API.Methods
 -- >>>            -- with a JSON encoded Book as the request body
 -- >>>            -- returning the just-created Book
 -- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
-type Post (contentTypes :: [*]) a = HttpMethod "POST" 201 contentTypes a
+type Post (contentTypes :: [*]) a = HttpMethod "POST" contentTypes a
+
+type instance DefaultStatusCode "POST" = 201
 
 -- $setup
 -- >>> import Servant.API

servant/src/Servant/API/Put.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE KindSignatures     #-}
+{-# LANGUAGE TypeFamilies       #-}
 {-# OPTIONS_HADDOCK not-home    #-}
 module Servant.API.Put (Put) where
 
@@ -14,7 +15,9 @@ import           Servant.API.Methods
 -- >>> -- PUT /books/:isbn
 -- >>> -- with a Book as request body, returning the updated Book
 -- >>> type MyApi = "books" :> Capture "isbn" Text :> ReqBody '[JSON] Book :> Put '[JSON] Book
-type Put (contentTypes :: [*]) a = HttpMethod "PUT" 200 contentTypes a
+type Put (contentTypes :: [*]) a = HttpMethod "PUT" contentTypes a
+
+type instance DefaultStatusCode "PUT" = 200
 
 -- $setup
 -- >>> import Servant.API