diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,5 @@ -Copyright 2001-2010, The University Court of the University of -Glasgow, Bjorn Bringert, Andy Gill, Anders Kaseorg, Ian Lynagh, Erik -Meijer, Sven Panne, Jeremy Shaw +Copyright 2001-2005, The University Court of the University of +Glasgow, Bjorn Bringert, Andy Gill, Ian Lynagh, Erik Meijer, Sven Panne All rights reserved. diff --git a/Network/CGI.hs b/Network/CGI.hs --- a/Network/CGI.hs +++ b/Network/CGI.hs @@ -8,7 +8,7 @@ -- (c) Jeremy Shaw 2005 -- License : BSD-style -- --- Maintainer : Anders Kaseorg +-- Maintainer : bjorn@bringert.net -- Stability : experimental -- Portability : non-portable (uses Control.Monad.State) -- @@ -94,13 +94,9 @@ , module Network.CGI.Compat ) where -#if MIN_VERSION_base(4,0,0) -import Control.Exception -#else -import Control.Exception.Extensible -#endif - (Exception(..), SomeException, ErrorCall(..)) +import Control.Exception.Extensible (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) @@ -179,7 +175,7 @@ -- > -- > 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/Compat.hs b/Network/CGI/Compat.hs --- a/Network/CGI/Compat.hs +++ b/Network/CGI/Compat.hs @@ -7,7 +7,7 @@ -- (c) Jeremy Shaw 2005 -- License : BSD-style -- --- Maintainer : Anders Kaseorg +-- Maintainer : bjorn@bringert.net -- Stability : experimental -- Portability : non-portable (uses Control.Monad.State) -- @@ -20,12 +20,7 @@ ) where import Control.Concurrent (forkIO) -#if MIN_VERSION_base(4,0,0) -import Control.Exception -#else -import Control.Exception.Extensible -#endif - as Exception (SomeException, throw, catch, finally) +import Control.Exception.Extensible as Exception (SomeException,throw,catch,finally) import Control.Monad (unless) import Control.Monad.Trans (MonadIO, liftIO) import qualified Data.Map as Map @@ -94,7 +89,7 @@ (\ e -> abort "Cannot connect to CGI daemon." e) BS.hPut h str >> hPutStrLn h "" (sendBack h `finally` hClose h) - `Exception.catch` (\e -> unless (isEOFError e) (ioError e)) + `Prelude.catch` (\e -> unless (isEOFError e) (ioError e)) -- | Returns the query string, or the request body if it is -- a POST request, or the empty string if there is an error. diff --git a/Network/CGI/Cookie.hs b/Network/CGI/Cookie.hs --- a/Network/CGI/Cookie.hs +++ b/Network/CGI/Cookie.hs @@ -5,7 +5,7 @@ -- (c) Ian Lynagh 2005 -- License : BSD-style -- --- Maintainer : Anders Kaseorg +-- Maintainer : Bjorn Bringert -- Stability : experimental -- Portability : portable -- diff --git a/Network/CGI/Header.hs b/Network/CGI/Header.hs --- a/Network/CGI/Header.hs +++ b/Network/CGI/Header.hs @@ -7,7 +7,7 @@ -- (c) Bjorn Bringert 2005-2006 -- License : BSD-style -- --- Maintainer : Anders Kaseorg +-- Maintainer : bjorn@bringert.net -- Stability : experimental -- Portability : non-portable -- diff --git a/Network/CGI/Monad.hs b/Network/CGI/Monad.hs --- a/Network/CGI/Monad.hs +++ b/Network/CGI/Monad.hs @@ -5,7 +5,7 @@ -- Copyright : (c) Bjorn Bringert 2006 -- License : BSD-style -- --- Maintainer : Anders Kaseorg +-- Maintainer : bjorn@bringert.net -- Stability : experimental -- Portability : non-portable -- @@ -27,18 +27,14 @@ throwCGI, catchCGI, tryCGI, handleExceptionCGI, ) where -#if MIN_VERSION_base(4,0,0) -import Control.Exception -#else -import Control.Exception.Extensible -#endif - as Exception (SomeException, try, throwIO) +import Prelude hiding (catch) +import Control.Exception.Extensible 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) @@ -59,7 +55,7 @@ typeOf _ = mkTyConApp (mkTyCon "Network.CGI.Monad.CGIT") [typeOf1 (undefined :: m a), typeOf (undefined :: a)] -instance (Functor m, Monad m) => Functor (CGIT m) where +instance Monad m => Functor (CGIT m) where fmap f c = CGIT (fmap f (unCGIT c)) instance Monad m => Monad (CGIT m) where @@ -71,6 +67,11 @@ 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. @@ -97,7 +98,7 @@ -- * Error handling -- -instance MonadError SomeException (CGIT IO) where +instance MonadCatchIO m => MonadError SomeException (CGIT m) where throwError = throwCGI catchError = catchCGI @@ -108,17 +109,15 @@ -- | 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/Network/CGI/Multipart.hs b/Network/CGI/Multipart.hs --- a/Network/CGI/Multipart.hs +++ b/Network/CGI/Multipart.hs @@ -7,7 +7,7 @@ -- (c) Bjorn Bringert 2005-2006 -- License : BSD-style -- --- Maintainer : Anders Kaseorg +-- Maintainer : bjorn@bringert.net -- Stability : experimental -- Portability : non-portable -- diff --git a/Network/CGI/Protocol.hs b/Network/CGI/Protocol.hs --- a/Network/CGI/Protocol.hs +++ b/Network/CGI/Protocol.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Bjorn Bringert 2006 -- License : BSD-style -- --- Maintainer : Anders Kaseorg +-- Maintainer : bjorn@bringert.net -- Stability : experimental -- Portability : non-portable -- @@ -39,7 +39,7 @@ import Data.Maybe (fromMaybe, listToMaybe, isJust) import Network.URI (unEscapeString,escapeURIString,isUnescapedInURI) import System.Environment (getEnvironment) -import System.IO (Handle, hPutStrLn, stderr, hFlush, hSetBinaryMode) +import System.IO (Handle, hPutStrLn, stderr, hFlush) import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString) @@ -104,8 +104,7 @@ -> (CGIRequest -> m (Headers, CGIResult)) -- ^ CGI action -> m () hRunCGI env hin hout f = - do liftIO $ hSetBinaryMode hin True - inp <- liftIO $ BS.hGetContents hin + do inp <- liftIO $ BS.hGetContents hin outp <- runCGIEnvFPS env inp f liftIO $ BS.hPut hout outp liftIO $ hFlush hout diff --git a/cgi.cabal b/cgi.cabal --- a/cgi.cabal +++ b/cgi.cabal @@ -1,5 +1,5 @@ Name: cgi -Version: 3001.1.7.5 +Version: 3001.1.8 Copyright: Bjorn Bringert, Andy Gill, Anders Kaseorg, Ian Lynagh, Erik Meijer, Sven Panne, Jeremy Shaw Category: Network @@ -16,7 +16,6 @@ Flag split-base Flag bytestring-in-base -Flag extensible-exceptions-in-base Library Exposed-Modules: @@ -29,16 +28,16 @@ Network.CGI.Accept, Network.CGI.Multipart, Network.CGI.Header - Extensions: - CPP, - MultiParamTypeClasses + Extensions: MultiParamTypeClasses ghc-options: -Wall Build-depends: network >= 2.0, parsec >= 2.0, mtl >= 1.0, - xhtml >= 3000.0.0 + MonadCatchIO-mtl, + xhtml >= 3000.0.0, + extensible-exceptions If flag(split-base) Build-depends: base >= 3 && < 5, old-time, old-locale, containers Else @@ -47,10 +46,6 @@ Build-depends: base >= 2 && < 3 Else Build-depends: base < 2 || < 5, bytestring - If flag(extensible-exceptions-in-base) - Build-depends: base >= 4 - Else - Build-depends: base < 4, extensible-exceptions --Executable: printinput --Main-Is: printinput.hs