diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index 7743a0de..d29821b0 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -52,6 +52,7 @@ module Yesod.Handler , YesodApp (..) ) where +import Prelude hiding (catch) import Yesod.Request import Yesod.Content import Yesod.Internal @@ -59,7 +60,8 @@ import Web.Mime import Web.Routes.Quasi (Routes) import Data.List (foldl') -import Control.Exception hiding (Handler) +import Control.Exception hiding (Handler, catch) +import qualified Control.Exception as E import Control.Applicative #if MIN_VERSION_transformers(0,2,0) @@ -67,6 +69,8 @@ import "transformers" Control.Monad.IO.Class #else import "transformers" Control.Monad.Trans #endif +import qualified Control.Monad.CatchIO as C +import Control.Monad.CatchIO (catch) import Control.Monad.Attempt import Control.Monad (liftM, ap) @@ -134,6 +138,13 @@ instance Monad (GHandler sub master) where return (headers ++ headers', session' ++ session'', c') instance MonadIO (GHandler sub master) where liftIO i = Handler $ \_ -> i >>= \i' -> return ([], [], HCContent i') +instance C.MonadCatchIO (GHandler sub master) where + catch (Handler m) f = + Handler $ \d -> E.catch (m d) (\e -> unHandler (f e) d) + block (Handler m) = + Handler $ \d -> E.block (m d) + unblock (Handler m) = + Handler $ \d -> E.unblock (m d) instance Failure ErrorResponse (GHandler sub master) where failure e = Handler $ \_ -> return ([], [], HCError e) instance RequestReader (GHandler sub master) where @@ -194,7 +205,7 @@ runHandler handler mrender sroute tomr ma tosa = YesodApp $ \eh rr cts -> do let toErrorHandler = InternalError . (show :: Control.Exception.SomeException -> String) - (headers, session', contents) <- Control.Exception.catch + (headers, session', contents) <- E.catch (unHandler handler HandlerData { handlerRequest = rr , handlerSub = tosa ma @@ -220,7 +231,7 @@ runHandler handler mrender sroute tomr ma tosa = YesodApp $ \eh rr cts -> do HCRedirect rt loc -> do let hs = Header "Location" loc : headers return (getRedirectStatus rt, hs, TypePlain, cs "", finalSession) - HCSendFile ct fp -> Control.Exception.catch + HCSendFile ct fp -> E.catch (sendFile' ct fp) (handleError . toErrorHandler) diff --git a/yesod.cabal b/yesod.cabal index 533b8c85..45f0b980 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -32,7 +32,8 @@ library web-routes-quasi >= 0.1 && < 0.2, hamlet >= 0.0.1 && < 0.1, transformers >= 0.1 && < 0.3, - clientsession >= 0.2 && < 0.3 + clientsession >= 0.2 && < 0.3, + MonadCatchIO-transformers >= 0.2.2 && < 0.3 exposed-modules: Yesod Yesod.Content Yesod.Dispatch