A few things have frustrated me about Network.CGI’s exception handling. • I can’t use the new-style Exception class directly; I have to convert to and from SomeException first. • There’s no analogue of nice utilities like bracket and onException for CGI. • I can only use throwCGI and catchCGI in CGIT IO, not an arbitrary MonadCGI. One way to solve all three of these problems is using MonadCatchIO. As an added bonus, we get a much simpler definition of try/catch. Who is maintaining the CGI library these days? What do you think of this patch? (It would be possible to generalize the types even further, from SomeException to Exception e => e, but I’m worried about introducing ambiguous type variables into existing code. After this patch, new code can just use the Control.Monad.CatchIO functions directly to deal with Exception e => e.) Anders -- 8< -- From 5f9b9ca5e9faf34b36887737d820c3ca9ea76e09 Mon Sep 17 00:00:00 2001 From: Anders Kaseorg Date: Tue, 9 Mar 2010 05:18:57 -0500 Subject: [PATCH] Generalize exception handling to an arbitrary MonadCatchIO. Signed-off-by: Anders Kaseorg --- Network/CGI.hs | 3 ++- Network/CGI/Monad.hs | 24 ++++++++++++++---------- cgi.cabal | 2 +- 3 files changed, 17 insertions(+), 12 deletions(-) diff --git a/Network/CGI.hs b/Network/CGI.hs index 3acd0db..8ebc057 100644 --- a/Network/CGI.hs +++ b/Network/CGI.hs @@ -96,6 +96,7 @@ module Network.CGI ( import Control.Exception (Exception(..), SomeException, ErrorCall(..)) import Control.Monad (liftM) +import Control.Monad.CatchIO (MonadCatchIO) import Control.Monad.Trans (MonadIO, liftIO) import Data.Char (toUpper) import Data.List (intersperse, sort, group) @@ -175,7 +176,7 @@ redirect url = do setHeader "Location" url -- > -- > main :: IO () -- > main = runCGI (handleErrors cgiMain) -handleErrors :: CGI CGIResult -> CGI CGIResult +handleErrors :: (MonadCGI m, MonadCatchIO m) => m CGIResult -> m CGIResult handleErrors = flip catchCGI outputException -- diff --git a/Network/CGI/Monad.hs b/Network/CGI/Monad.hs index 69d7840..f3d55cf 100644 --- a/Network/CGI/Monad.hs +++ b/Network/CGI/Monad.hs @@ -27,13 +27,14 @@ module Network.CGI.Monad ( throwCGI, catchCGI, tryCGI, handleExceptionCGI, ) where -import Control.Exception as Exception (SomeException, try, throwIO) +import Prelude hiding (catch) +import Control.Exception as Exception (SomeException, throwIO) import Control.Monad (liftM) +import Control.Monad.CatchIO (MonadCatchIO, block, catch, try, unblock) import Control.Monad.Error (MonadError(..)) import Control.Monad.Reader (ReaderT(..), asks) import Control.Monad.Writer (WriterT(..), tell) import Control.Monad.Trans (MonadTrans, MonadIO, liftIO, lift) -import Data.Monoid (mempty) import Data.Typeable (Typeable(..), Typeable1(..), mkTyConApp, mkTyCon) @@ -66,6 +67,11 @@ instance Monad m => Monad (CGIT m) where instance MonadIO m => MonadIO (CGIT m) where liftIO = lift . liftIO +instance MonadCatchIO m => MonadCatchIO (CGIT m) where + CGIT m `catch` h = CGIT (try m) >>= either h return + block (CGIT m) = CGIT (block m) + unblock (CGIT m) = CGIT (unblock m) + -- | The class of CGI monads. Most CGI actions can be run in -- any monad which is an instance of this class, which means that -- you can use your own monad transformers to add extra functionality. @@ -92,7 +98,7 @@ runCGIT (CGIT c) = liftM (uncurry (flip (,))) . runWriterT . runReaderT c -- * Error handling -- -instance MonadError SomeException (CGIT IO) where +instance MonadCatchIO m => MonadError SomeException (CGIT m) where throwError = throwCGI catchError = catchCGI @@ -103,17 +109,15 @@ throwCGI = liftIO . throwIO -- | Catches any expection thrown by a CGI action, and uses the given -- exception handler if an exception is thrown. -catchCGI :: CGI a -> (SomeException -> CGI a) -> CGI a -catchCGI c h = tryCGI c >>= either h return +catchCGI :: (MonadCGI m, MonadCatchIO m) => m a -> (SomeException -> m a) -> m a +catchCGI = catch -- | Catches any exception thrown by an CGI action, and returns either -- the exception, or if no exception was raised, the result of the action. -tryCGI :: CGI a -> CGI (Either SomeException a) -tryCGI (CGIT c) = CGIT (ReaderT (\r -> WriterT (f (runWriterT (runReaderT c r))))) - where - f = liftM (either (\ex -> (Left ex,mempty)) (\(a,w) -> (Right a,w))) . try +tryCGI :: (MonadCGI m, MonadCatchIO m) => m a -> m (Either SomeException a) +tryCGI = try {-# DEPRECATED handleExceptionCGI "Use catchCGI instead." #-} -- | Deprecated version of 'catchCGI'. Use 'catchCGI' instead. -handleExceptionCGI :: CGI a -> (SomeException -> CGI a) -> CGI a +handleExceptionCGI :: (MonadCGI m, MonadCatchIO m) => m a -> (SomeException -> m a) -> m a handleExceptionCGI = catchCGI diff --git a/cgi.cabal b/cgi.cabal index fba15ff..b2ba0c1 100644 --- a/cgi.cabal +++ b/cgi.cabal @@ -30,7 +30,7 @@ Library Extensions: MultiParamTypeClasses ghc-options: -Wall - Build-depends: network>=2.0, parsec >= 2.0, mtl >= 1.0, xhtml >= 3000.0.0 + Build-depends: network>=2.0, parsec >= 2.0, mtl >= 1.0, MonadCatchIO-mtl, xhtml >= 3000.0.0 If flag(split-base) Build-depends: base >= 3 && < 5, old-time, old-locale, containers Else -- 1.7.0.2