From 6a60dac366feb36446379b1342967b53c06bf733 Mon Sep 17 00:00:00 2001
From: Chris Allen <cma@bitemyapp.com>
Date: Wed, 25 Nov 2015 14:49:53 -0600
Subject: [PATCH] JSON-specific sendResponseStatus

---
 yesod-core/Yesod/Core/Handler.hs | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs
index af4e8aff..c65dcc72 100644
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@@ -93,6 +93,8 @@ module Yesod.Core.Handler
     , sendFilePart
     , sendResponse
     , sendResponseStatus
+      -- ** Type specific response with custom status
+    , sendResponseStatusJSON
     , sendResponseCreated
     , sendWaiResponse
     , sendWaiApplication
@@ -198,6 +200,7 @@ import           Network.Wai.Middleware.HttpAuth
     ( extractBasicAuth, extractBearerAuth )
 import Control.Monad.Trans.Class (lift)
 
+import           Data.Aeson                    (ToJSON(..))
 import qualified Data.Text                     as T
 import           Data.Text.Encoding            (decodeUtf8With, encodeUtf8)
 import           Data.Text.Encoding.Error      (lenientDecode)
@@ -575,6 +578,11 @@ sendResponse = handlerError . HCContent H.status200 . toTypedContent
 sendResponseStatus :: (MonadHandler m, ToTypedContent c) => H.Status -> c -> m a
 sendResponseStatus s = handlerError . HCContent s . toTypedContent
 
+-- | Bypass remaining handler code and output the given JSON with the given
+-- status code.
+sendResponseStatusJSON :: (MonadHandler m, ToJSON a) => H.Status -> a -> m a
+sendResponseStatusJSON s v = sendResponseStatus s (toJSON v)
+
 -- | Send a 201 "Created" response with the given route as the Location
 -- response header.
 sendResponseCreated :: MonadHandler m => Route (HandlerSite m) -> m a