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

Evaluate NoContent before (not) rendering it. (#1587) 

* Evaluate NoContent before rendering it, so it shows up as covered in coverage reports

* failing test as well

* test that NoContent gets rendered if it is not an exception

Co-authored-by: Tom Sydney Kerckhove <syd@cs-syd.eu>
This commit is contained in:
Tom Sydney Kerckhove 2022-05-04 14:40:26 +02:00 committed by GitHub
parent 5e1569e9e2
commit 036102af58
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 12 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
servant/src/Servant/API/ContentTypes.hs
View File

@ -295,7 +295,7 @@ instance {-# OVERLAPPABLE #-}
-- then this would be taken care of. However there is no more specific instance -- then this would be taken care of. However there is no more specific instance
-- between that and 'MimeRender JSON a', so we do this instead -- between that and 'MimeRender JSON a', so we do this instead
instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
allMimeRender _ _ = map (, "") $ NE.toList $ contentTypes pctyp allMimeRender _ NoContent = map (, "") $ NE.toList $ contentTypes pctyp
where where
pctyp = Proxy :: Proxy ctyp pctyp = Proxy :: Proxy ctyp

11
servant/test/Servant/API/ContentTypesSpec.hs
View File

@ -33,6 +33,8 @@ import Data.String.Conversions
import qualified Data.Text as TextS import qualified Data.Text as TextS
import qualified Data.Text.Encoding as TextSE import qualified Data.Text.Encoding as TextSE
import qualified Data.Text.Lazy as TextL import qualified Data.Text.Lazy as TextL
import Control.Exception
(evaluate)
import GHC.Generics import GHC.Generics
import Test.Hspec import Test.Hspec
import Test.QuickCheck import Test.QuickCheck
@ -78,6 +80,15 @@ spec = describe "Servant.API.ContentTypes" $ do
it "has mimeUnrender reverse mimeRender for valid top-level json " $ do it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData) property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
describe "The NoContent Content-Type type" $ do
let p = Proxy :: Proxy '[JSON]
it "does not render any content" $
allMimeRender p NoContent `shouldSatisfy` (all (BSL8.null . snd))
it "evaluates the NoContent value" $
evaluate (allMimeRender p (undefined :: NoContent)) `shouldThrow` anyErrorCall
describe "The PlainText Content-Type type" $ do describe "The PlainText Content-Type type" $ do
let p = Proxy :: Proxy PlainText let p = Proxy :: Proxy PlainText