git.iko.soy/servant
on master help sign in
Add HasStatus instance for Headers (that defers StatusOf to underlying value) (#1649)

* Add HasStatus instance for Headers (that defers StatusOf to underlying value) * changelog.d/1649

commita2e003367d9ca267ae853d0f1870ba253104d8e6 authorIntolerable <fraser.m.murray@gmail.com> dateTue 14 Feb 2023, 22:28 (4 years ago) parentb3214ea
3 files changed+23
compare with master
unifiedsplit
changelog.d/1649+8 servant/src/Servant/API/UVerb.hs+4 servant/test/Servant/API/ResponseHeadersSpec.hs+11
changelog.d/1649new file+8
@@ -0,0 +1,8 @@
1+synopsis: Add HasStatus instance for Headers (that defers StatusOf to underlying value)
2+prs: #1649
3+
4+description: {
5+
6+Adds a new HasStatus (Headers hs a) instance (StatusOf (Headers hs a) = StatusOf a)
7+
8+}
servant/src/Servant/API/UVerb.hs+4
@@ -38,6 +38,7 @@ import GHC.TypeLits (Nat)
3838import Network.HTTP.Types (Status, StdMethod)
3939import Servant.API.ContentTypes (JSON, PlainText, FormUrlEncoded, OctetStream, NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender))
4040import Servant.API.Status (KnownStatus, statusVal)
41+import Servant.API.ResponseHeaders (Headers)
4142import Servant.API.UVerb.Union
4243
4344class KnownStatus (StatusOf a) => HasStatus (a :: *) where
@@ -52,6 +53,9 @@ statusOf = const (statusVal (Proxy :: Proxy (StatusOf a)))
5253instance HasStatus NoContent where
5354 type StatusOf NoContent = 204
5455
56+instance HasStatus a => HasStatus (Headers hs a) where
57+ type StatusOf (Headers hs a) = StatusOf a
58+
5559class HasStatuses (as :: [*]) where
5660 type Statuses (as :: [*]) :: [Nat]
5761 statuses :: Proxy as -> [Status]
servant/test/Servant/API/ResponseHeadersSpec.hs+11
@@ -2,10 +2,14 @@
22{-# LANGUAGE OverloadedStrings #-}
33module Servant.API.ResponseHeadersSpec where
44
5+import Data.Proxy
6+import GHC.TypeLits
57import Test.Hspec
68
9+import Servant.API.ContentTypes
710import Servant.API.Header
811import Servant.API.ResponseHeaders
12+import Servant.API.UVerb
913
1014spec :: Spec
1115spec = describe "Servant.API.ResponseHeaders" $ do
@@ -28,3 +32,10 @@ spec = describe "Servant.API.ResponseHeaders" $ do
2832 it "does not add a header" $ do
2933 let val = noHeader 5 :: Headers '[Header "test" Int] Int
3034 getHeaders val `shouldBe` []
35+
36+ describe "HasStatus Headers" $ do
37+
38+ it "gets the status from the underlying value" $ do
39+ natVal (Proxy :: Proxy (StatusOf (Headers '[Header "first" Int] NoContent))) `shouldBe` 204
40+ natVal (Proxy :: Proxy (StatusOf (Headers '[Header "first" Int] (WithStatus 503 ())))) `shouldBe` 503
41+