diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index eb549e79..33c31b0f 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -234,11 +234,12 @@ toWaiApp' y segments env = do render u = fromMaybe (fullRender (approot y) (formatPathSegments site) u) (urlRenderOverride y u) + let errorHandler' = localNoCurrent . errorHandler rr <- parseWaiRequest env session' let h = do onRequest case eurl of - Left _ -> errorHandler NotFound + Left _ -> errorHandler' NotFound Right url -> do isWrite <- isWriteRequest url ar <- isAuthorized url isWrite @@ -253,10 +254,10 @@ toWaiApp' y segments env = do redirect RedirectTemporary url' Unauthorized s -> permissionDenied s case handleSite site render url method of - Nothing -> errorHandler $ BadMethod method + Nothing -> errorHandler' $ BadMethod method Just h' -> h' let eurl' = either (const Nothing) Just eurl - let eh er = runHandler (errorHandler 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/Handler.hs b/Yesod/Handler.hs index ce81516f..509272bb 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -66,6 +66,7 @@ module Yesod.Handler , runHandler , YesodApp (..) , toMasterHandler + , localNoCurrent ) where import Prelude hiding (catch) @@ -438,3 +439,7 @@ data RedirectType = RedirectPermanent | RedirectTemporary | RedirectSeeOther deriving (Show, Eq) + +localNoCurrent :: GHandler s m a -> GHandler s m a +localNoCurrent = + GHandler . local (\hd -> hd { handlerRoute = Nothing }) . unGHandler