diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index 78ab8b0b..211ef741 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -251,14 +251,14 @@ toWaiApp' y segments env = do onRequest y rr let h = case eurl of - Left _ -> errorHandler y NotFound + Left _ -> errorHandler NotFound Right url -> do -- FIXME auth <- isAuthorized y url case handleSite site render url method of - Nothing -> errorHandler y $ BadMethod method + Nothing -> errorHandler $ BadMethod method Just h' -> h' let eurl' = either (const Nothing) Just eurl - let eh er = runHandler (errorHandler y er) render eurl' id y id + let eh er = runHandler (errorHandler er) render eurl' id y id let ya = runHandler h render eurl' id y id (s, hs, ct, c, sessionFinal) <- unYesodApp ya eh rr types let sessionVal = encodeSession key' exp' host sessionFinal diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index e59856f3..fa9c5213 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -69,11 +69,8 @@ class Yesod a where clientSessionDuration = const 120 -- | Output error response pages. - errorHandler :: Yesod y - => a - -> ErrorResponse - -> Handler y ChooseRep - errorHandler _ = defaultErrorHandler + errorHandler :: ErrorResponse -> GHandler sub a ChooseRep + errorHandler = defaultErrorHandler -- | Applies some form of layout to the contents of a page. defaultLayout :: PageContent (Routes a) -> GHandler sub a Content @@ -167,9 +164,7 @@ applyLayout' :: Yesod master applyLayout' s = fmap chooseRep . applyLayout s mempty -- | The default error handler for 'errorHandler'. -defaultErrorHandler :: Yesod y - => ErrorResponse - -> Handler y ChooseRep +defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep defaultErrorHandler NotFound = do r <- waiRequest applyLayout' "Not Found" $ [$hamlet|