From 9f61b1da66709d7fcc0c84cce131b3e75f477fe8 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Thu, 5 Jul 2012 23:18:07 -0300 Subject: [PATCH] Export yesod-json's acceptsJson. --- yesod-json/Yesod/Json.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/yesod-json/Yesod/Json.hs b/yesod-json/Yesod/Json.hs index a169819a..0eec299f 100644 --- a/yesod-json/Yesod/Json.hs +++ b/yesod-json/Yesod/Json.hs @@ -18,6 +18,7 @@ module Yesod.Json -- * Convenience functions , jsonOrRedirect + , acceptsJson ) where import Yesod.Handler (GHandler, waiRequest, lift, invalidArgs, redirect) @@ -109,7 +110,8 @@ 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). +-- 1. 200 with JSON data if the client prefers +-- @application\/json@ (e.g. AJAX, see 'acceptsJSON'). -- -- 2. 3xx otherwise, following the PRG pattern. jsonOrRedirect :: (Yesod master, J.ToJSON a) @@ -120,9 +122,12 @@ 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 + +-- | Returns @True@ if the client prefers @application\/json@ as +-- indicated by the @Accept@ HTTP header. +acceptsJson :: Yesod master => GHandler sub master Bool +acceptsJson = maybe False ((== "application/json") . B8.takeWhile (/= ';')) + . join + . fmap (headMay . parseHttpAccept) + . lookup "Accept" . requestHeaders + <$> waiRequest