haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

MonadCatchIO

Browse Source
This commit is contained in:
Michael Snoyman 2010-05-06 17:01:52 +03:00
parent 58b2990794
commit e8a042db2d
2 changed files with 16 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Yesod/Handler.hs
View File

@ -52,6 +52,7 @@ module Yesod.Handler
, YesodApp (..) , YesodApp (..)
) where ) where
import Prelude hiding (catch)
import Yesod.Request import Yesod.Request
import Yesod.Content import Yesod.Content
import Yesod.Internal import Yesod.Internal
@ -59,7 +60,8 @@ import Web.Mime
import Web.Routes.Quasi (Routes) import Web.Routes.Quasi (Routes)
import Data.List (foldl') import Data.List (foldl')
import Control.Exception hiding (Handler) import Control.Exception hiding (Handler, catch)
import qualified Control.Exception as E
import Control.Applicative import Control.Applicative
#if MIN_VERSION_transformers(0,2,0) #if MIN_VERSION_transformers(0,2,0)
@ -67,6 +69,8 @@ import "transformers" Control.Monad.IO.Class
#else #else
import "transformers" Control.Monad.Trans import "transformers" Control.Monad.Trans
#endif #endif
import qualified Control.Monad.CatchIO as C
import Control.Monad.CatchIO (catch)
import Control.Monad.Attempt import Control.Monad.Attempt
import Control.Monad (liftM, ap) import Control.Monad (liftM, ap)
@ -134,6 +138,13 @@ instance Monad (GHandler sub master) where
return (headers ++ headers', session' ++ session'', c') return (headers ++ headers', session' ++ session'', c')
instance MonadIO (GHandler sub master) where instance MonadIO (GHandler sub master) where
liftIO i = Handler $ \_ -> i >>= \i' -> return ([], [], HCContent i') 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 instance Failure ErrorResponse (GHandler sub master) where
failure e = Handler $ \_ -> return ([], [], HCError e) failure e = Handler $ \_ -> return ([], [], HCError e)
instance RequestReader (GHandler sub master) where instance RequestReader (GHandler sub master) where
@ -194,7 +205,7 @@ runHandler handler mrender sroute tomr ma tosa = YesodApp $ \eh rr cts -> do
let toErrorHandler = let toErrorHandler =
InternalError InternalError
. (show :: Control.Exception.SomeException -> String) . (show :: Control.Exception.SomeException -> String)
(headers, session', contents) <- Control.Exception.catch (headers, session', contents) <- E.catch
(unHandler handler HandlerData (unHandler handler HandlerData
{ handlerRequest = rr { handlerRequest = rr
, handlerSub = tosa ma , handlerSub = tosa ma
@ -220,7 +231,7 @@ runHandler handler mrender sroute tomr ma tosa = YesodApp $ \eh rr cts -> do
HCRedirect rt loc -> do HCRedirect rt loc -> do
let hs = Header "Location" loc : headers let hs = Header "Location" loc : headers
return (getRedirectStatus rt, hs, TypePlain, cs "", finalSession) return (getRedirectStatus rt, hs, TypePlain, cs "", finalSession)
HCSendFile ct fp -> Control.Exception.catch HCSendFile ct fp -> E.catch
(sendFile' ct fp) (sendFile' ct fp)
(handleError . toErrorHandler) (handleError . toErrorHandler)

3
yesod.cabal
View File

@ -32,7 +32,8 @@ library
web-routes-quasi >= 0.1 && < 0.2, web-routes-quasi >= 0.1 && < 0.2,
hamlet >= 0.0.1 && < 0.1, hamlet >= 0.0.1 && < 0.1,
transformers >= 0.1 && < 0.3, 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 exposed-modules: Yesod
Yesod.Content Yesod.Content
Yesod.Dispatch Yesod.Dispatch