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
