module Yesod.Json
(
defaultLayoutJson
, jsonToRepJson
, parseJsonBody
, parseJsonBody_
, J.Value (..)
, object
, array
, (.=)
, jsonOrRedirect
) where
import Yesod.Handler (GHandler, waiRequest, lift, invalidArgs, redirect)
import Yesod.Content
( ToContent (toContent), RepHtmlJson (RepHtmlJson), RepHtml (RepHtml)
, RepJson (RepJson), Content (ContentBuilder)
)
import Yesod.Core (defaultLayout, Yesod)
import Yesod.Widget (GWidget)
import Yesod.Routes.Class
import Control.Arrow (second)
import Control.Applicative ((<$>))
import Control.Monad (join)
import qualified Data.Aeson as J
import Data.Aeson ((.=))
import qualified Data.Aeson.Encode as JE
import Data.Aeson.Encode (fromValue)
import Data.Conduit.Attoparsec (sinkParser)
import Data.Text (Text, pack)
import qualified Data.Vector as V
import Text.Julius (ToJavascript (..))
import Data.Text.Lazy.Builder (fromLazyText)
import Data.Text.Lazy.Encoding (decodeUtf8)
import Data.Text.Lazy.Builder (toLazyText)
import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
import Data.Conduit (($$))
import Network.Wai (requestBody, requestHeaders)
import Network.Wai.Parse (parseHttpAccept)
import qualified Data.ByteString.Char8 as B8
import Safe (headMay)
instance ToContent J.Value where
toContent = flip ContentBuilder Nothing
. Blaze.fromLazyText
. toLazyText
. fromValue
defaultLayoutJson :: (Yesod master, J.ToJSON a)
=> GWidget sub master ()
-> a
-> GHandler sub master RepHtmlJson
defaultLayoutJson w json = do
RepHtml html' <- defaultLayout w
return $ RepHtmlJson html' $ toContent (J.toJSON json)
jsonToRepJson :: J.ToJSON a => a -> GHandler sub master RepJson
jsonToRepJson = return . RepJson . toContent . J.toJSON
parseJsonBody :: J.FromJSON a => GHandler sub master (J.Result a)
parseJsonBody = do
req <- waiRequest
fmap J.fromJSON $ lift $ requestBody req $$ sinkParser J.json'
parseJsonBody_ :: J.FromJSON a => GHandler sub master a
parseJsonBody_ = do
ra <- parseJsonBody
case ra of
J.Error s -> invalidArgs [pack s]
J.Success a -> return a
instance ToJavascript J.Value where
toJavascript = fromLazyText . decodeUtf8 . JE.encode
object :: J.ToJSON a => [(Text, a)] -> J.Value
object = J.object . map (second J.toJSON)
array :: J.ToJSON a => [a] -> J.Value
array = J.Array . V.fromList . map J.toJSON
jsonOrRedirect :: (Yesod master, J.ToJSON a)
=> Route master
-> a
-> GHandler sub master RepJson
jsonOrRedirect r j = do
q <- acceptsJson
if q then jsonToRepJson (J.toJSON j)
else redirect r
where
acceptsJson = maybe False ((== "application/json") . B8.takeWhile (/= ';'))
. join
. fmap (headMay . parseHttpAccept)
. lookup "Accept" . requestHeaders
<$> waiRequest