From 036102af58c54d2237dfd6331dcc845e3f4b8f47 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <NorfairKing@users.noreply.github.com>
Date: Wed, 4 May 2022 14:40:26 +0200
Subject: [PATCH] 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>
---
 servant/src/Servant/API/ContentTypes.hs      |  2 +-
 servant/test/Servant/API/ContentTypesSpec.hs | 11 +++++++++++
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/servant/src/Servant/API/ContentTypes.hs b/servant/src/Servant/API/ContentTypes.hs
index 10e8d896..814d5244 100644
--- a/servant/src/Servant/API/ContentTypes.hs
+++ b/servant/src/Servant/API/ContentTypes.hs
@@ -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
 
diff --git a/servant/test/Servant/API/ContentTypesSpec.hs b/servant/test/Servant/API/ContentTypesSpec.hs
index 1a7d4d1d..eb6d2a96 100644
--- a/servant/test/Servant/API/ContentTypesSpec.hs
+++ b/servant/test/Servant/API/ContentTypesSpec.hs
@@ -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