diff --git a/yesod-json/Yesod/Json.hs b/yesod-json/Yesod/Json.hs index 369e3775..e59a11a9 100644 --- a/yesod-json/Yesod/Json.hs +++ b/yesod-json/Yesod/Json.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeSynonymInstances, OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Yesod.Json @@ -14,16 +14,22 @@ module Yesod.Json , J.Value (..) , object , array + + -- * Convenience functions + , jsonOrRedirect ) where -import Yesod.Handler (GHandler, waiRequest, lift, invalidArgs) +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 qualified Data.Aeson.Encode as JE import Data.Aeson.Encode (fromValue) @@ -36,7 +42,10 @@ 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) +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 @@ -94,3 +103,24 @@ object = J.object . map (second J.toJSON) -- | Convert a list of values to an 'J.Array'. array :: J.ToJSON a => [a] -> J.Value array = J.Array . V.fromList . map J.toJSON + +-- | jsonOrRedirect 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). +-- +-- 2. 3xx otherwise, following the PRG pattern. +jsonOrRedirect :: (Yesod master, J.ToJSON a) + => Route master -- ^ Redirect target + -> a -- ^ Data to send via JSON + -> 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 diff --git a/yesod-json/yesod-json.cabal b/yesod-json/yesod-json.cabal index 4838d872..a5b65405 100644 --- a/yesod-json/yesod-json.cabal +++ b/yesod-json/yesod-json.cabal @@ -15,6 +15,7 @@ description: Generate content for Yesod using the aeson package. library build-depends: base >= 4 && < 5 , yesod-core >= 0.10 && < 0.11 + , yesod-routes < 0.1 , aeson >= 0.5 , text >= 0.8 && < 1.0 , shakespeare-js >= 0.10 && < 0.11 @@ -25,6 +26,9 @@ library , conduit >= 0.0 && < 0.1 , transformers >= 0.2.2 && < 0.3 , wai >= 1.0 && < 1.1 + , wai-extra >= 1.0 && < 1.1 + , bytestring >= 0.9 && < 0.10 + , safe >= 0.2 && < 0.4 exposed-modules: Yesod.Json ghc-options: -Wall