eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add HasStatus instance for Headers (that defers StatusOf to underlying value) (#1649)

Browse source 
* Add HasStatus instance for Headers (that defers StatusOf to underlying value)

* changelog.d/1649
This commit is contained in:
Intolerable 2023-02-14 22:28:57 +00:00 committed by GitHub
parent b3214eac38
commit a2e003367d
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
3 changed files with 23 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
changelog.d/1649 Normal file
View file

@ -0,0 +1,8 @@
synopsis: Add HasStatus instance for Headers (that defers StatusOf to underlying value)
prs: #1649
description: {
Adds a new HasStatus (Headers hs a) instance (StatusOf (Headers hs a) = StatusOf a)
}

4
servant/src/Servant/API/UVerb.hs
View file

@ -38,6 +38,7 @@ import GHC.TypeLits (Nat)
import Network.HTTP.Types (Status, StdMethod)
import Servant.API.ContentTypes (JSON, PlainText, FormUrlEncoded, OctetStream, NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender))
import Servant.API.Status (KnownStatus, statusVal)
import Servant.API.ResponseHeaders (Headers)
import Servant.API.UVerb.Union
class KnownStatus (StatusOf a) => HasStatus (a :: *) where
@ -52,6 +53,9 @@ statusOf = const (statusVal (Proxy :: Proxy (StatusOf a)))
instance HasStatus NoContent where
type StatusOf NoContent = 204
instance HasStatus a => HasStatus (Headers hs a) where
type StatusOf (Headers hs a) = StatusOf a
class HasStatuses (as :: [*]) where
type Statuses (as :: [*]) :: [Nat]
statuses :: Proxy as -> [Status]

11
servant/test/Servant/API/ResponseHeadersSpec.hs
View file

@ -2,10 +2,14 @@
{-# LANGUAGE OverloadedStrings #-}
module Servant.API.ResponseHeadersSpec where
import Data.Proxy
import GHC.TypeLits
import Test.Hspec
import Servant.API.ContentTypes
import Servant.API.Header
import Servant.API.ResponseHeaders
import Servant.API.UVerb
spec :: Spec
spec = describe "Servant.API.ResponseHeaders" $ do
@ -28,3 +32,10 @@ spec = describe "Servant.API.ResponseHeaders" $ do
it "does not add a header" $ do
let val = noHeader 5 :: Headers '[Header "test" Int] Int
getHeaders val `shouldBe` []
describe "HasStatus Headers" $ do
it "gets the status from the underlying value" $ do
natVal (Proxy :: Proxy (StatusOf (Headers '[Header "first" Int] NoContent))) `shouldBe` 204
natVal (Proxy :: Proxy (StatusOf (Headers '[Header "first" Int] (WithStatus 503 ())))) `shouldBe` 503