on master help sign in
Evaluate NoContent before (not) rendering it. (#1587)
036102aTom Sydney Kerckhove
servant/src/Servant/API/ContentTypes.hs+1−1
@@ -295,7 +295,7 @@ instance {-# OVERLAPPABLE #-}
295-- then this would be taken care of. However there is no more specific instance
295-- then this would be taken care of. However there is no more specific instance
296-- between that and 'MimeRender JSON a', so we do this instead
296-- between that and 'MimeRender JSON a', so we do this instead
297instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
297instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
298− allMimeRender _ _ = map (, "") $ NE.toList $ contentTypes pctyp
298+ allMimeRender _ NoContent = map (, "") $ NE.toList $ contentTypes pctyp
299 where
299 where
300 pctyp = Proxy :: Proxy ctyp
300 pctyp = Proxy :: Proxy ctyp
301
301
servant/test/Servant/API/ContentTypesSpec.hs+11
@@ -33,6 +33,8 @@ import Data.String.Conversions
33import qualified Data.Text as TextS
33import qualified Data.Text as TextS
34import qualified Data.Text.Encoding as TextSE
34import qualified Data.Text.Encoding as TextSE
35import qualified Data.Text.Lazy as TextL
35import qualified Data.Text.Lazy as TextL
36+import Control.Exception
37+ (evaluate)
36import GHC.Generics
38import GHC.Generics
37import Test.Hspec
39import Test.Hspec
38import Test.QuickCheck
40import Test.QuickCheck
@@ -78,6 +80,15 @@ spec = describe "Servant.API.ContentTypes" $ do
78 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
80 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
79 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
81 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
80
82
83+ describe "The NoContent Content-Type type" $ do
84+ let p = Proxy :: Proxy '[JSON]
85+
86+ it "does not render any content" $
87+ allMimeRender p NoContent `shouldSatisfy` (all (BSL8.null . snd))
88+
89+ it "evaluates the NoContent value" $
90+ evaluate (allMimeRender p (undefined :: NoContent)) `shouldThrow` anyErrorCall
91+
81 describe "The PlainText Content-Type type" $ do
92 describe "The PlainText Content-Type type" $ do
82 let p = Proxy :: Proxy PlainText
93 let p = Proxy :: Proxy PlainText
83
94