diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index e87dc584..e10bf937 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/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 - ) => HasServer (HttpMethod method status ctypes a) where + , KnownNat (DefaultStatusCode method) + ) => 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 status ctypes ()) where + ) => HasServer (HttpMethod method 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 - ) => HasServer (HttpMethod method status ctypes (Headers h v)) where + , KnownNat (DefaultStatusCode method) + ) => 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, diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index f3f95c52..f7a0b04d 100644 --- a/servant/src/Servant/API.hs +++ b/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) diff --git a/servant/src/Servant/API/Delete.hs b/servant/src/Servant/API/Delete.hs index f6168c96..a31deb83 100644 --- a/servant/src/Servant/API/Delete.hs +++ b/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 diff --git a/servant/src/Servant/API/Get.hs b/servant/src/Servant/API/Get.hs index 6e318777..3cf8b087 100644 --- a/servant/src/Servant/API/Get.hs +++ b/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 diff --git a/servant/src/Servant/API/Methods.hs b/servant/src/Servant/API/Methods.hs index 7a1cadd9..a0658f48 100644 --- a/servant/src/Servant/API/Methods.hs +++ b/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 diff --git a/servant/src/Servant/API/Patch.hs b/servant/src/Servant/API/Patch.hs index c332ca12..c55808b1 100644 --- a/servant/src/Servant/API/Patch.hs +++ b/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 diff --git a/servant/src/Servant/API/Post.hs b/servant/src/Servant/API/Post.hs index b9fb1842..4d42511f 100644 --- a/servant/src/Servant/API/Post.hs +++ b/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 diff --git a/servant/src/Servant/API/Put.hs b/servant/src/Servant/API/Put.hs index e6924f94..c4356795 100644 --- a/servant/src/Servant/API/Put.hs +++ b/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