diff --git a/yesod-json/Yesod/Json.hs b/yesod-json/Yesod/Json.hs index f81202e1..369e3775 100644 --- a/yesod-json/Yesod/Json.hs +++ b/yesod-json/Yesod/Json.hs @@ -8,6 +8,7 @@ module Yesod.Json -- * Convert to a JSON value , parseJsonBody + , parseJsonBody_ -- * Produce JSON values , J.Value (..) @@ -15,7 +16,7 @@ module Yesod.Json , array ) where -import Yesod.Handler (GHandler, waiRequest, lift) +import Yesod.Handler (GHandler, waiRequest, lift, invalidArgs) import Yesod.Content ( ToContent (toContent), RepHtmlJson (RepHtmlJson), RepHtml (RepHtml) , RepJson (RepJson), Content (ContentBuilder) @@ -27,7 +28,7 @@ import qualified Data.Aeson as J import qualified Data.Aeson.Encode as JE import Data.Aeson.Encode (fromValue) import Data.Conduit.Attoparsec (sinkParser) -import Data.Text (Text) +import Data.Text (Text, pack) import qualified Data.Vector as V import Text.Julius (ToJavascript (..)) import Data.Text.Lazy.Builder (fromLazyText) @@ -74,6 +75,15 @@ parseJsonBody = do req <- waiRequest fmap J.fromJSON $ lift $ requestBody req $$ sinkParser J.json' +-- | Same as 'parseJsonBody', but return an invalid args response on a parse +-- error. +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