From ba2593c15f328b7cf409258393b51fa5cf2ac8e9 Mon Sep 17 00:00:00 2001
From: Maximilian Tagher <feedback.tagher@gmail.com>
Date: Sun, 11 Mar 2018 21:05:29 -0700
Subject: [PATCH] Add JSONResponse type

Closes #1481
---
 yesod-core/ChangeLog.md          |  4 ++++
 yesod-core/Yesod/Core/Content.hs |  8 ++++++++
 yesod-core/Yesod/Core/Types.hs   | 12 ++++++++++++
 yesod-core/yesod-core.cabal      |  2 +-
 4 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md
index 443649a7..19e45924 100644
--- a/yesod-core/ChangeLog.md
+++ b/yesod-core/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.6.3
+
+* Add a type `JSONResponse a` that can be used to type a Handler as returning some value `a`, which should be encoded as JSON. [#1481](https://github.com/yesodweb/yesod/issues/1481)
+
 ## 1.6.2
 
 * Derive a `Show` instance for `ResourceTree` and `FlatResource` [#1492](https://github.com/yesodweb/yesod/pull/1492)
diff --git a/yesod-core/Yesod/Core/Content.hs b/yesod-core/Yesod/Core/Content.hs
index d7668d8d..be874dbd 100644
--- a/yesod-core/Yesod/Core/Content.hs
+++ b/yesod-core/Yesod/Core/Content.hs
@@ -251,6 +251,12 @@ instance HasContentType J.Value where
 instance HasContentType J.Encoding where
     getContentType _ = typeJson
 
+instance ToContent (JSONResponse a) where
+  toContent (JSONResponse a) = toContent $ toEncoding a
+
+instance HasContentType (JSONResponse a) where
+    getContentType _ = typeJson
+
 instance HasContentType Html where
     getContentType _ = typeHtml
 
@@ -288,6 +294,8 @@ instance ToTypedContent J.Value where
     toTypedContent v = TypedContent typeJson (toContent v)
 instance ToTypedContent J.Encoding where
     toTypedContent e = TypedContent typeJson (toContent e)
+instance ToTypedContent (JSONResponse a) where
+  toTypedContent c = TypedContent typeJson (toContent c)
 instance ToTypedContent Html where
     toTypedContent h = TypedContent typeHtml (toContent h)
 instance ToTypedContent T.Text where
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index ec849043..f4f4fc1e 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -308,6 +308,18 @@ newtype RepXml = RepXml Content
 
 type ContentType = ByteString -- FIXME Text?
 
+-- | Wrapper around types so that Handlers can be typed them, encoded as JSON.
+-- Example usage in a type signature:
+-- 
+-- > postSignupR :: Handler (JSONResponse CreateUserResponse)
+--
+-- And in the implementation:
+--
+-- > return $ JSONResponse $ CreateUserResponse userId
+--
+-- @since 1.6.3 
+data JSONResponse a = ToJSON a => JSONResponse a
+
 -- | Prevents a response body from being fully evaluated before sending the
 -- request.
 --
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index 7dd1a9dc..c61e7aad 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.6.2
+version:         1.6.3
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>