diff --git a/yesod-core/Yesod/Core/Class.hs b/yesod-core/Yesod/Core/Class.hs index e4362dc1..665477a6 100644 --- a/yesod-core/Yesod/Core/Class.hs +++ b/yesod-core/Yesod/Core/Class.hs @@ -19,6 +19,7 @@ import Control.Monad.Logger (LogLevel (LevelInfo, LevelO LogSource) import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L +import Data.Aeson (object, (.=)) import Data.List (foldl') import Data.List (nub) import qualified Data.Map as Map @@ -54,6 +55,7 @@ import Web.Cookie (SetCookie (..)) import Yesod.Core.Types import Yesod.Internal.Session import Yesod.Widget +import Yesod.Core.Trans.Class (lift) -- | Define settings for a Yesod applications. All methods have intelligent -- defaults, and therefore no implementation is required. @@ -401,57 +403,54 @@ $newline never runUniqueList :: Eq x => UniqueList x -> [x] runUniqueList (UniqueList x) = nub $ x [] --- | Helper function for 'defaultErrorHandler'. -applyLayout' :: Yesod master - => Html -- ^ title - -> HtmlUrl (Route master) -- ^ body - -> GHandler sub master TypedContent -applyLayout' title body = fmap toTypedContent $ defaultLayout $ do - setTitle title - toWidget body - -- | The default error handler for 'errorHandler'. defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y TypedContent -defaultErrorHandler NotFound = do - r <- waiRequest - let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r - applyLayout' "Not Found" - [hamlet| -$newline never -
#{path'} -|] -defaultErrorHandler (PermissionDenied msg) = - applyLayout' "Permission Denied" - [hamlet| -$newline never -
#{msg} -|] -defaultErrorHandler (InvalidArgs ia) = - applyLayout' "Invalid Arguments" - [hamlet| -$newline never -
#{path'} + |] + provideRep $ return $ object ["message" .= ("Not Found" :: Text)] +defaultErrorHandler (PermissionDenied msg) = selectRep $ do + provideRep $ defaultLayout $ do + setTitle "Permission Denied" + toWidget [hamlet| +
#{msg} + |] + provideRep $ return $ object ["message" .= ("Permission Denied" :: Text)] +defaultErrorHandler (InvalidArgs ia) = selectRep $ do + provideRep $ defaultLayout $ do + setTitle "Invalid Arguments" + toWidget [hamlet| +
#{e}
-|]
-defaultErrorHandler (BadMethod m) =
- applyLayout' "Bad Method"
- [hamlet|
-$newline never
-Method Not Supported
-
Method #{S8.unpack m} not supported
-|]
+ selectRep $ do
+ provideRep $ defaultLayout $ do
+ setTitle "Internal Server Error"
+ toWidget [hamlet|
+
Internal Server Error
+ #{e}
+ |]
+ provideRep $ return $ object ["message" .= ("Internal Server Error" :: Text), "error" .= e]
+defaultErrorHandler (BadMethod m) = selectRep $ do
+ provideRep $ defaultLayout $ do
+ setTitle"Bad Method"
+ toWidget [hamlet|
+ Method Not Supported
+
Method #{S8.unpack m} not supported
+ |]
+ provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= m]
asyncHelper :: (url -> [x] -> Text)
-> [Script (url)]
diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs
index 2c751c6c..1a4488e8 100644
--- a/yesod-core/Yesod/Core/Json.hs
+++ b/yesod-core/Yesod/Core/Json.hs
@@ -48,11 +48,11 @@ import Data.Maybe (listToMaybe)
-- /Since: 0.3.0/
defaultLayoutJson :: (Yesod master, J.ToJSON a)
=> GWidget sub master () -- ^ HTML
- -> a -- ^ JSON
+ -> GHandler sub master a -- ^ JSON
-> GHandler sub master TypedContent
defaultLayoutJson w json = selectRep $ do
provideRep $ defaultLayout w
- provideRep $ return $ J.toJSON json
+ provideRep $ fmap J.toJSON json
-- | Wraps a data type in a 'RepJson'. The data type must
-- support conversion to JSON via 'J.ToJSON'.