Merge pull request #222 from chreekat/master

Add jsonOrRedirect convenience function

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

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