From: ross Date: Thu, 12 Dec 2002 13:42:47 +0000 (+0000) Subject: [project @ 2002-12-12 13:42:46 by ross] X-Git-Tag: nhc98-1-18-release~784 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a3e56f82973d7117fe4544e5702d1c0180ae7d79;p=haskell-directory.git [project @ 2002-12-12 13:42:46 by ross] Changes to the exception interface, as discussed on the libraries list. 1) Move bracket and bracket_ from GHC.Exception (and hence System.IO) to haskell98/IO.hs. These two should now never be used (except in all-H98 programs), and this will save users of the new libraries from having to hide them. Use the ones in Control.Exception instead. 2) Define type IOError = IOException -- was Exception leaving the type of Prelude.ioError as IOError -> IO a, but adding to Control.Exception throwIO :: Exception -> IO a The result is a type distinction between the variants of catch and try: Prelude.catch :: IO a -> (IOError -> IO a) -> IO a Control.Exception.catch :: IO a -> (Exception -> IO a) -> IO a System.IO.Error.try :: IO a -> IO (Either IOError a) Control.Exception.try :: IO a -> IO (Either Exception a) These are breaking changes: the first one affects only import lists, but the second will bite in the following situations: - using ioError on general Exceptions: use throwIO instead. - using throw on IOErrors: if in the IO monad, use ioError instead. Otherwise, use throw (IOException e), but why are you throwing IO exceptions outside of the IO monad? Minor changes: - System.IO.Error now exports catch and try - moved try from GHC.Exception to System.IO.Error, because it's portable and can be shared by Hugs. --- diff --git a/Control/Exception.hs b/Control/Exception.hs index b0a76b8..07115f5 100644 --- a/Control/Exception.hs +++ b/Control/Exception.hs @@ -25,11 +25,12 @@ module Control.Exception ( #endif -- * Throwing exceptions -#ifdef __HUGS__ throwIO, -- :: Exception -> IO a -#else +#ifndef __HUGS__ throw, -- :: Exception -> a - ioError, -- :: Exception -> IO a +#endif + ioError, -- :: IOError -> IO a +#ifndef __HUGS__ throwTo, -- :: ThreadId -> Exception -> a #endif @@ -115,7 +116,7 @@ module Control.Exception ( #ifdef __GLASGOW_HASKELL__ import GHC.Base ( assert ) -import GHC.Exception as ExceptionBase hiding (try, catch, bracket, bracket_) +import GHC.Exception as ExceptionBase hiding (catch) import GHC.Conc ( throwTo, ThreadId ) import GHC.IOBase ( IO(..) ) #endif @@ -125,7 +126,7 @@ import Hugs.Exception as ExceptionBase #endif import Prelude hiding ( catch ) -import System.IO.Error +import System.IO.Error hiding ( catch, try ) import System.IO.Unsafe (unsafePerformIO) import Data.Dynamic @@ -171,7 +172,7 @@ throw = throwIO -- -- Note that 'catch' catches all types of exceptions, and is generally -- used for \"cleaning up\" before passing on the exception using --- 'ioError'. It is not good practice to discard the exception and +-- 'throwIO'. It is not good practice to discard the exception and -- continue, without first checking the type of the exception (it -- might be a 'ThreadKilled', for example). In this case it is usually better -- to use 'catchJust' and select the kinds of exceptions to catch. @@ -344,7 +345,7 @@ userErrors :: Exception -> Maybe String #endif /* __GLASGOW_HASKELL__ */ #ifdef __GLASGOW_HASKELL__ -ioErrors e@(IOException _) = Just e +ioErrors (IOException e) = Just e ioErrors _ = Nothing arithExceptions (ArithException e) = Just e @@ -362,7 +363,7 @@ dynExceptions _ = Nothing asyncExceptions (AsyncException e) = Just e asyncExceptions _ = Nothing -userErrors e@IOException{} | isUserError e = Just (ioeGetErrorString e) +userErrors (IOException e) | isUserError e = Just (ioeGetErrorString e) userErrors _ = Nothing #endif /* __GLASGOW_HASKELL__ */ diff --git a/Foreign/C/Error.hs b/Foreign/C/Error.hs index 72cb512..dcee040 100644 --- a/Foreign/C/Error.hs +++ b/Foreign/C/Error.hs @@ -90,7 +90,7 @@ module Foreign.C.Error ( -- GHC allows us to get at the guts inside IO errors/exceptions -- #if __GLASGOW_HASKELL__ -import GHC.IOBase (Exception(..), IOException(..), IOErrorType(..)) +import GHC.IOBase (IOException(..), IOErrorType(..)) #endif /* __GLASGOW_HASKELL__ */ @@ -406,7 +406,7 @@ errnoToIOError :: String -> Errno -> Maybe Handle -> Maybe String -> IOError errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do str <- strerror errno >>= peekCString #if __GLASGOW_HASKELL__ - return (IOException (IOError maybeHdl errType loc str maybeName)) + return (IOError maybeHdl errType loc str maybeName) where errType | errno == eOK = OtherError diff --git a/Foreign/Marshal/Alloc.hs b/Foreign/Marshal/Alloc.hs index 31f96ec..0e394c5 100644 --- a/Foreign/Marshal/Alloc.hs +++ b/Foreign/Marshal/Alloc.hs @@ -36,7 +36,6 @@ import Foreign.C.Types ( CSize, CInt(..) ) import Foreign.Storable ( Storable(sizeOf) ) #ifdef __GLASGOW_HASKELL__ -import GHC.Exception ( bracket ) import GHC.IOBase import GHC.Real import GHC.Ptr diff --git a/GHC/Exception.lhs b/GHC/Exception.lhs index 5822ea8..3e26cdc 100644 --- a/GHC/Exception.lhs +++ b/GHC/Exception.lhs @@ -19,11 +19,9 @@ module GHC.Exception ( module GHC.Exception, Exception(..), AsyncException(..), IOException(..), ArithException(..), ArrayException(..), - throw, ioError ) + throw, throwIO, ioError ) where -import Data.Either - import GHC.Base import GHC.IOBase @@ -56,54 +54,15 @@ catchException m k = ST (\s -> unST m s `primCatch'` \ err -> unST (k err) s) catchException (IO m) k = IO $ \s -> catch# m (\ex -> unIO (k ex)) s #endif -catch :: IO a -> (Exception -> IO a) -> IO a +catch :: IO a -> (IOError -> IO a) -> IO a catch m k = catchException m handler - where handler err@(IOException _) = k err + where handler (IOException err) = k err handler other = throw other \end{code} %********************************************************* %* * -\subsection{Try and bracket} -%* * -%********************************************************* - -The construct @try comp@ exposes errors which occur within a -computation, and which are not fully handled. It always succeeds. - -These are the IO-only try/bracket. For the full exception try/bracket -see hslibs/lang/Exception.lhs. - -\begin{code} -try :: IO a -> IO (Either Exception a) -try f = catch (do r <- f - return (Right r)) - (return . Left) - -bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c -bracket before after m = do - x <- before - rs <- try (m x) - after x - case rs of - Right r -> return r - Left e -> ioError e - --- variant of the above where middle computation doesn't want x -bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c -bracket_ before after m = do - x <- before - rs <- try m - after x - case rs of - Right r -> return r - Left e -> ioError e -\end{code} - - -%********************************************************* -%* * \subsection{Controlling asynchronous exception delivery} %* * %********************************************************* diff --git a/GHC/Handle.hs b/GHC/Handle.hs index 13ceee1..5259469 100644 --- a/GHC/Handle.hs +++ b/GHC/Handle.hs @@ -131,8 +131,8 @@ withHandle' fun h m act = block $ do h_ <- takeMVar m checkBufferInvariants h_ - (h',v) <- catchException (act h_) - (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_)) + (h',v) <- catch (act h_) + (\ ex -> putMVar m h_ >> ioError (augmentIOError ex fun h h_)) checkBufferInvariants h' putMVar m h' return v @@ -146,8 +146,8 @@ withHandle_' fun h m act = block $ do h_ <- takeMVar m checkBufferInvariants h_ - v <- catchException (act h_) - (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_)) + v <- catch (act h_) + (\ ex -> putMVar m h_ >> ioError (augmentIOError ex fun h h_)) checkBufferInvariants h_ putMVar m h_ return v @@ -162,18 +162,16 @@ withHandle__' fun h m act = block $ do h_ <- takeMVar m checkBufferInvariants h_ - h' <- catchException (act h_) - (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_)) + h' <- catch (act h_) + (\ ex -> putMVar m h_ >> ioError (augmentIOError ex fun h h_)) checkBufferInvariants h' putMVar m h' return () -augmentIOError (IOException (IOError _ iot _ str fp)) fun h h_ - = IOException (IOError (Just h) iot fun str filepath) +augmentIOError (IOError _ iot _ str fp) fun h h_ + = IOError (Just h) iot fun str filepath where filepath | Just _ <- fp = fp | otherwise = Just (haFilePath h_) -augmentIOError other_exception _ _ _ - = other_exception -- --------------------------------------------------------------------------- -- Wrapper for write operations. @@ -560,10 +558,8 @@ data IOModeEx | TextMode IOMode deriving (Eq, Read, Show) -addFilePathToIOError fun fp (IOException (IOError h iot _ str _)) - = IOException (IOError h iot fun str (Just fp)) -addFilePathToIOError _ _ other_exception - = other_exception +addFilePathToIOError fun fp (IOError h iot _ str _) + = IOError h iot fun str (Just fp) openFile :: FilePath -> IOMode -> IO Handle openFile fp im = @@ -571,13 +567,13 @@ openFile fp im = (openFile' fp (if dEFAULT_OPEN_IN_BINARY_MODE then BinaryMode im else TextMode im)) - (\e -> throw (addFilePathToIOError "openFile" fp e)) + (\e -> ioError (addFilePathToIOError "openFile" fp e)) openFileEx :: FilePath -> IOModeEx -> IO Handle openFileEx fp m = catch (openFile' fp m) - (\e -> throw (addFilePathToIOError "openFileEx" fp e)) + (\e -> ioError (addFilePathToIOError "openFileEx" fp e)) openFile' filepath ex_mode = @@ -843,7 +839,7 @@ hIsEOF :: Handle -> IO Bool hIsEOF handle = catch (do hLookAhead handle; return False) - (\e -> if isEOFError e then return True else throw e) + (\e -> if isEOFError e then return True else ioError e) isEOF :: IO Bool isEOF = hIsEOF stdin diff --git a/GHC/IO.hs b/GHC/IO.hs index b3d590a..ab5b319 100644 --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -43,7 +43,7 @@ import GHC.Real import GHC.Num import GHC.Show import GHC.List -import GHC.Exception ( ioError, catch, throw ) +import GHC.Exception ( ioError, catch ) import GHC.Conc -- --------------------------------------------------------------------------- @@ -199,7 +199,7 @@ maybeFillReadBuffer fd is_line is_stream buf ) (\e -> do if isEOFError e then return Nothing - else throw e) + else ioError e) unpack :: RawBuffer -> Int -> Int -> IO [Char] diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs index 9659fdb..54ec69f 100644 --- a/GHC/IOBase.lhs +++ b/GHC/IOBase.lhs @@ -471,9 +471,6 @@ showHandle p h duplex = -- has a constructor in the 'Exception' type, and values of other -- types may be injected into 'Exception' by coercing them to -- 'Dynamic' (see the section on Dynamic Exceptions: "Control.Exception\#DynamicExceptions"). --- --- For backwards compatibility with Haskell 98, 'IOError' is a type synonym --- for 'Exception'. data Exception = ArithException ArithException -- ^Exceptions raised by arithmetic @@ -679,35 +676,39 @@ throw exception = raise# exception -- | A variant of 'throw' that can be used within the 'IO' monad. -- --- Although 'ioError' has a type that is an instance of the type of 'throw', the +-- Although 'throwIO' has a type that is an instance of the type of 'throw', the -- two functions are subtly different: -- -- > throw e `seq` return () ===> throw e --- > ioError e `seq` return () ===> return () +-- > throwIO e `seq` return () ===> return () -- -- The first example will cause the exception @e@ to be raised, --- whereas the second one won\'t. In fact, 'ioError' will only cause +-- whereas the second one won\'t. In fact, 'throwIO' will only cause -- an exception to be raised when it is used within the 'IO' monad. --- The 'ioError' variant should be used in preference to 'throw' to +-- The 'throwIO' variant should be used in preference to 'throw' to -- raise an exception within the 'IO' monad because it guarantees -- ordering with respect to other 'IO' operations, whereas 'throw' -- does not. -ioError :: Exception -> IO a -ioError err = IO $ \s -> throw err s +throwIO :: Exception -> IO a +throwIO err = IO $ \s -> throw err s ioException :: IOException -> IO a ioException err = IO $ \s -> throw (IOException err) s +ioError :: IOError -> IO a +ioError = ioException + -- --------------------------------------------------------------------------- -- IOError type --- A value @IOError@ encode errors occurred in the @IO@ monad. --- An @IOError@ records a more specific error type, a descriptive +-- | The Haskell 98 type for exceptions in the @IO@ monad. +-- In Haskell 98, this is an opaque type. +type IOError = IOException + +-- |Exceptions that occur in the @IO@ monad. +-- An @IOException@ records a more specific error type, a descriptive -- string and maybe the handle that was used when the error was -- flagged. - -type IOError = Exception - data IOException = IOError { ioe_handle :: Maybe Handle, -- the handle used by the action flagging @@ -778,7 +779,7 @@ instance Show IOErrorType where DynIOError{} -> "unknown IO error" userError :: String -> IOError -userError str = IOException (IOError Nothing UserError "" str Nothing) +userError str = IOError Nothing UserError "" str Nothing -- --------------------------------------------------------------------------- -- Showing IOErrors diff --git a/System/Directory.hs b/System/Directory.hs index 0ddd3d2..d3245df 100644 --- a/System/Directory.hs +++ b/System/Directory.hs @@ -57,6 +57,7 @@ module System.Directory import Prelude +import Control.Exception ( bracket ) import System.Posix.Types import System.Time ( ClockTime(..) ) import System.IO diff --git a/System/Environment.hs b/System/Environment.hs index 0ab0214..fab7202 100644 --- a/System/Environment.hs +++ b/System/Environment.hs @@ -24,7 +24,7 @@ module System.Environment ) where import Prelude -import System.IO ( bracket ) +import Control.Exception ( bracket ) #ifdef __GLASGOW_HASKELL__ import Foreign diff --git a/System/IO.hs b/System/IO.hs index c6ba2c9..d6bc1ee 100644 --- a/System/IO.hs +++ b/System/IO.hs @@ -62,12 +62,8 @@ module System.IO ( ioeGetFileName, -- :: IOError -> Maybe FilePath try, -- :: IO a -> IO (Either IOError a) - bracket, -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c - bracket_, -- :: IO a -> (a -> IO b) -> IO c -> IO c - -- Non-standard extension (but will hopefully become standard with 1.5) is - -- to export the Prelude io functions via IO (in addition to exporting them - -- from the prelude...for now.) + -- re-exports of Prelude names IO, -- instance MonadFix FilePath, -- :: String IOError, @@ -157,9 +153,6 @@ import IO , ioeGetErrorString -- :: IOError -> String , ioeGetHandle -- :: IOError -> Maybe Handle , ioeGetFileName -- :: IOError -> Maybe FilePath - , try -- :: IO a -> IO (Either IOError a) - , bracket -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c - , bracket_ -- :: IO a -> (a -> IO b) -> IO c -> IO c , IO () , FilePath -- :: String diff --git a/System/IO/Error.hs b/System/IO/Error.hs index be5b692..5b7ec1e 100644 --- a/System/IO/Error.hs +++ b/System/IO/Error.hs @@ -20,6 +20,9 @@ module System.IO.Error ( IOErrorType, -- abstract #endif + catch, -- :: IO a -> (IOError -> IO a) -> IO a + try, -- :: IO a -> IO (Either IOError a) + ioError, -- :: IOError -> IO a userError, -- :: String -> IOError @@ -67,11 +70,13 @@ module System.IO.Error ( ) where +import Data.Either #ifdef __GLASGOW_HASKELL__ import GHC.Base import Data.Maybe import GHC.IOBase +import GHC.Exception import Text.Show #endif @@ -82,6 +87,7 @@ import Hugs.IO #ifdef __NHC__ import IO ( IOError () + , try , ioError , userError , isAlreadyExistsError -- :: IOError -> Bool @@ -100,13 +106,25 @@ import IO --import Control.Monad (MonadPlus(mplus)) #endif +-- | The construct @try comp@ exposes IO errors which occur within a +-- computation, and which are not fully handled. +-- Other exceptions are not caught by this variant; +-- to catch all exceptions, use @try@ from "Control.Exception". + +#ifndef __NHC__ +try :: IO a -> IO (Either IOError a) +try f = catch (do r <- f + return (Right r)) + (return . Left) +#endif + #ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- Constructing an IOError mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError mkIOError t location maybe_hdl maybe_filename = - IOException IOError{ ioe_type = t, + IOError{ ioe_type = t, ioe_location = location, ioe_descr = "", ioe_handle = maybe_hdl, @@ -213,19 +231,15 @@ ioeGetHandle :: IOError -> Maybe Handle ioeGetErrorString :: IOError -> String ioeGetFileName :: IOError -> Maybe FilePath -ioeGetErrorType (IOException ioe) = ioe_type ioe -ioeGetErrorType _ = error "System.IO.Error.ioeGetErrorType: not an IO error" +ioeGetErrorType ioe = ioe_type ioe -ioeGetHandle (IOException ioe) = ioe_handle ioe -ioeGetHandle _ = error "System.IO.Error.ioeGetHandle: not an IO error" +ioeGetHandle ioe = ioe_handle ioe -ioeGetErrorString (IOException ioe) +ioeGetErrorString ioe | isUserErrorType (ioe_type ioe) = ioe_descr ioe | otherwise = show (ioe_type ioe) -ioeGetErrorString _ = error "System.IO.Error.ioeGetErrorString: not an IO error" -ioeGetFileName (IOException ioe) = ioe_filename ioe -ioeGetFileName _ = error "System.IO.Error.ioeGetFileName: not an IO error" +ioeGetFileName ioe = ioe_filename ioe #endif -- ----------------------------------------------------------------------------- @@ -237,13 +251,11 @@ annotateIOError :: IOError -> Maybe FilePath -> Maybe Handle -> IOError -annotateIOError (IOException (IOError hdl errTy _ str path)) loc opath ohdl = - IOException (IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath)) +annotateIOError (IOError hdl errTy _ str path) loc opath ohdl = + IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath) where Nothing `mplus` ys = ys xs `mplus` _ = xs -annotateIOError exc _ _ _ = - exc #endif #ifdef 0 /*__NHC__*/