From 18cd7834d6a4bbd07bdf4fceec9d8f8d3a1a8796 Mon Sep 17 00:00:00 2001
From: Alexander Lippling <alexander@hotwirestudios.com>
Date: Mon, 20 Jun 2016 13:19:11 +0200
Subject: [PATCH] Added support for aeson's toEncoding function (>= 0.11)

---
 yesod-core/Yesod/Core/Content.hs | 15 ++++++++++
 yesod-core/Yesod/Core/Json.hs    | 51 ++++++++++++++++++++++++++++++--
 2 files changed, 63 insertions(+), 3 deletions(-)

diff --git a/yesod-core/Yesod/Core/Content.hs b/yesod-core/Yesod/Core/Content.hs
index a0f511d3..2e850362 100644
--- a/yesod-core/Yesod/Core/Content.hs
+++ b/yesod-core/Yesod/Core/Content.hs
@@ -251,9 +251,20 @@ instance ToContent J.Value where
 #else
               . fromValue
 #endif
+
+#if MIN_VERSION_aeson(0, 11, 0)
+instance ToContent J.Encoding where
+    toContent = flip ContentBuilder Nothing . J.fromEncoding
+#endif
+
 instance HasContentType J.Value where
     getContentType _ = typeJson
 
+#if MIN_VERSION_aeson(0, 11, 0)
+instance HasContentType J.Encoding where
+    getContentType _ = typeJson
+#endif
+
 instance HasContentType Html where
     getContentType _ = typeHtml
 
@@ -289,6 +300,10 @@ instance ToTypedContent RepXml where
     toTypedContent (RepXml c) = TypedContent typeXml c
 instance ToTypedContent J.Value where
     toTypedContent v = TypedContent typeJson (toContent v)
+#if MIN_VERSION_aeson(0, 11, 0)
+instance ToTypedContent J.Encoding where
+    toTypedContent e = TypedContent typeJson (toContent e)
+#endif
 instance ToTypedContent Html where
     toTypedContent h = TypedContent typeHtml (toContent h)
 instance ToTypedContent T.Text where
diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs
index 1ae81839..d112c3d4 100644
--- a/yesod-core/Yesod/Core/Json.hs
+++ b/yesod-core/Yesod/Core/Json.hs
@@ -6,6 +6,9 @@ module Yesod.Core.Json
       defaultLayoutJson
     , jsonToRepJson
     , returnJson
+#if MIN_VERSION_aeson(0, 11, 0)
+    , returnJsonEncoding
+#endif
     , provideJson
 
       -- * Convert to a JSON value
@@ -24,6 +27,9 @@ module Yesod.Core.Json
 
       -- * Convenience functions
     , jsonOrRedirect
+#if MIN_VERSION_aeson(0, 11, 0)
+    , jsonEncodingOrRedirect
+#endif
     , acceptsJson
     ) where
 
@@ -59,7 +65,11 @@ defaultLayoutJson :: (Yesod site, J.ToJSON a)
                   -> HandlerT site IO TypedContent
 defaultLayoutJson w json = selectRep $ do
     provideRep $ defaultLayout w
+#if MIN_VERSION_aeson(0, 11, 0)
+    provideRep $ fmap J.toEncoding json
+#else
     provideRep $ fmap J.toJSON json
+#endif
 
 -- | Wraps a data type in a 'RepJson'.  The data type must
 -- support conversion to JSON via 'J.ToJSON'.
@@ -75,12 +85,24 @@ jsonToRepJson = return . J.toJSON
 returnJson :: (Monad m, J.ToJSON a) => a -> m J.Value
 returnJson = return . J.toJSON
 
+#if MIN_VERSION_aeson(0, 11, 0)
+-- | Convert a value to a JSON representation via aeson\'s 'J.toEncoding' function.
+--
+-- Since ?
+returnJsonEncoding :: (Monad m, J.ToJSON a) => a -> m J.Encoding
+returnJsonEncoding = return . J.toEncoding
+#endif
+
 -- | Provide a JSON representation for usage with 'selectReps', using aeson\'s
--- 'J.toJSON' function to perform the conversion.
+-- 'J.toJSON' (aeson >= 0.11: 'J.toEncoding') function to perform the conversion.
 --
 -- Since 1.2.1
 provideJson :: (Monad m, J.ToJSON a) => a -> Writer (Endo [ProvidedRep m]) ()
+#if MIN_VERSION_aeson(0, 11, 0)
+provideJson = provideRep . return . J.toEncoding
+#else
 provideJson = provideRep . return . J.toJSON
+#endif
 
 -- | Parse the request body to a data type as a JSON value.  The
 -- data type must support conversion from JSON via 'J.FromJSON'.
@@ -129,9 +151,32 @@ jsonOrRedirect :: (MonadHandler m, J.ToJSON a)
                => Route (HandlerSite m) -- ^ Redirect target
                -> a            -- ^ Data to send via JSON
                -> m J.Value
-jsonOrRedirect r j = do
+jsonOrRedirect = jsonOrRedirect' J.toJSON
+
+#if MIN_VERSION_aeson(0, 11, 0)
+-- | jsonEncodingOrRedirect simplifies the scenario where a POST handler sends a different
+-- response based on Accept headers:
+--
+--     1. 200 with JSON data if the client prefers
+--     @application\/json@ (e.g. AJAX, see 'acceptsJSON').
+--
+--     2. 3xx otherwise, following the PRG pattern.
+-- Since ?
+jsonEncodingOrRedirect :: (MonadHandler m, J.ToJSON a)
+            => Route (HandlerSite m) -- ^ Redirect target
+            -> a            -- ^ Data to send via JSON
+            -> m J.Encoding
+jsonEncodingOrRedirect = jsonOrRedirect' J.toEncoding
+#endif
+
+jsonOrRedirect' :: (MonadHandler m, J.ToJSON a)
+            => (a -> b)
+            -> Route (HandlerSite m) -- ^ Redirect target
+            -> a            -- ^ Data to send via JSON
+            -> m b
+jsonOrRedirect' f r j = do
     q <- acceptsJson
-    if q then return (J.toJSON j)
+    if q then return (f j)
          else redirect r
 
 -- | Returns @True@ if the client prefers @application\/json@ as