Skip to content

Commit

Permalink
Added support for aeson's toEncoding function (>= 0.11)
Browse files Browse the repository at this point in the history
  • Loading branch information
lippling committed Jun 20, 2016
1 parent 2a01710 commit 18cd783
Show file tree
Hide file tree
Showing 2 changed files with 63 additions and 3 deletions.
15 changes: 15 additions & 0 deletions yesod-core/Yesod/Core/Content.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down
51 changes: 48 additions & 3 deletions yesod-core/Yesod/Core/Json.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -24,6 +27,9 @@ module Yesod.Core.Json

-- * Convenience functions
, jsonOrRedirect
#if MIN_VERSION_aeson(0, 11, 0)
, jsonEncodingOrRedirect
#endif
, acceptsJson
) where

Expand Down Expand Up @@ -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'.
Expand All @@ -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'.
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 18cd783

Please sign in to comment.