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

View file

@ -295,7 +295,7 @@ instance {-# OVERLAPPABLE #-}
-- 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
instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
allMimeRender _ _ = map (, "") $ NE.toList $ contentTypes pctyp
allMimeRender _ NoContent = map (, "") $ NE.toList $ contentTypes pctyp
where
pctyp = Proxy :: Proxy ctyp

View file

@ -33,6 +33,8 @@ import Data.String.Conversions
import qualified Data.Text as TextS
import qualified Data.Text.Encoding as TextSE
import qualified Data.Text.Lazy as TextL
import Control.Exception
(evaluate)
import GHC.Generics
import Test.Hspec
import Test.QuickCheck
@ -78,6 +80,15 @@ spec = describe "Servant.API.ContentTypes" $ do
it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
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
let p = Proxy :: Proxy PlainText