X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FIO%2FError.hs;h=a026f338a190a3d2d2c706d606abb70fe4691d2e;hb=HEAD;hp=95fde8522a97ae6eeef09e4fad6e7327e2e51548;hpb=aaf764b3ad8b1816d68b5f27299eac125f08e1a5;p=ghc-base.git diff --git a/System/IO/Error.hs b/System/IO/Error.hs index 95fde85..a026f33 100644 --- a/System/IO/Error.hs +++ b/System/IO/Error.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | @@ -17,20 +17,18 @@ module System.IO.Error ( -- * I\/O errors - IOError, -- = IOException + IOError, -- = IOException - userError, -- :: String -> IOError + userError, -- :: String -> IOError -#ifndef __NHC__ - mkIOError, -- :: IOErrorType -> String -> Maybe Handle - -- -> Maybe FilePath -> IOError + mkIOError, -- :: IOErrorType -> String -> Maybe Handle + -- -> Maybe FilePath -> IOError - annotateIOError, -- :: IOError -> String -> Maybe Handle - -- -> Maybe FilePath -> IOError -#endif + annotateIOError, -- :: IOError -> String -> Maybe Handle + -- -> Maybe FilePath -> IOError -- ** Classifying I\/O errors - isAlreadyExistsError, -- :: IOError -> Bool + isAlreadyExistsError, -- :: IOError -> Bool isDoesNotExistError, isAlreadyInUseError, isFullError, @@ -40,24 +38,22 @@ module System.IO.Error ( isUserError, -- ** Attributes of I\/O errors -#ifndef __NHC__ - ioeGetErrorType, -- :: IOError -> IOErrorType -#endif - ioeGetErrorString, -- :: IOError -> String - ioeGetHandle, -- :: IOError -> Maybe Handle - ioeGetFileName, -- :: IOError -> Maybe FilePath - -#ifndef __NHC__ - ioeSetErrorType, -- :: IOError -> IOErrorType -> IOError - ioeSetErrorString, -- :: IOError -> String -> IOError - ioeSetHandle, -- :: IOError -> Handle -> IOError - ioeSetFileName, -- :: IOError -> FilePath -> IOError -#endif + ioeGetErrorType, -- :: IOError -> IOErrorType + ioeGetLocation, -- :: IOError -> String + ioeGetErrorString, -- :: IOError -> String + ioeGetHandle, -- :: IOError -> Maybe Handle + ioeGetFileName, -- :: IOError -> Maybe FilePath + + ioeSetErrorType, -- :: IOError -> IOErrorType -> IOError + ioeSetErrorString, -- :: IOError -> String -> IOError + ioeSetLocation, -- :: IOError -> String -> IOError + ioeSetHandle, -- :: IOError -> Handle -> IOError + ioeSetFileName, -- :: IOError -> FilePath -> IOError -- * Types of I\/O error - IOErrorType, -- abstract + IOErrorType, -- abstract - alreadyExistsErrorType, -- :: IOErrorType + alreadyExistsErrorType, -- :: IOErrorType doesNotExistErrorType, alreadyInUseErrorType, fullErrorType, @@ -67,7 +63,7 @@ module System.IO.Error ( userErrorType, -- ** 'IOErrorType' predicates - isAlreadyExistsErrorType, -- :: IOErrorType -> Bool + isAlreadyExistsErrorType, -- :: IOErrorType -> Bool isDoesNotExistErrorType, isAlreadyInUseErrorType, isFullErrorType, @@ -78,37 +74,45 @@ module System.IO.Error ( -- * Throwing and catching I\/O errors - ioError, -- :: IOError -> IO a + ioError, -- :: IOError -> IO a - catch, -- :: IO a -> (IOError -> IO a) -> IO a - try, -- :: IO a -> IO (Either IOError a) + catchIOError, -- :: IO a -> (IOError -> IO a) -> IO a + catch, -- :: IO a -> (IOError -> IO a) -> IO a + tryIOError, -- :: IO a -> IO (Either IOError a) + try, -- :: IO a -> IO (Either IOError a) -#ifndef __NHC__ - modifyIOError, -- :: (IOError -> IOError) -> IO a -> IO a -#endif + modifyIOError, -- :: (IOError -> IOError) -> IO a -> IO a ) where +#ifndef __HUGS__ +import qualified Control.Exception.Base as New (catch) +#endif + +#ifndef __HUGS__ import Data.Either +#endif import Data.Maybe #ifdef __GLASGOW_HASKELL__ import GHC.Base -import GHC.IOBase -import GHC.Exception +import GHC.IO +import GHC.IO.Exception +import GHC.IO.Handle.Types import Text.Show #endif #ifdef __HUGS__ -import Hugs.Prelude(Handle, IOException(..), IOErrorType(..)) +import Hugs.Prelude(Handle, IOException(..), IOErrorType(..), IO) #endif #ifdef __NHC__ import IO ( IOError () + , Handle () , try , ioError , userError - , isAlreadyExistsError -- :: IOError -> Bool + , isAlreadyExistsError -- :: IOError -> Bool , isDoesNotExistError , isAlreadyInUseError , isFullError @@ -120,17 +124,26 @@ import IO , ioeGetHandle -- :: IOError -> Maybe Handle , ioeGetFileName -- :: IOError -> Maybe FilePath ) ---import Data.Maybe (fromJust) ---import Control.Monad (MonadPlus(mplus)) +import qualified NHC.Internal as NHC (IOError(..)) +import qualified NHC.DErrNo as NHC (ErrNo(..)) +import Data.Maybe (fromJust) +import Control.Monad (MonadPlus(mplus)) #endif --- | The construct 'try' @comp@ exposes IO errors which occur within a +-- | The construct 'tryIOError' @comp@ exposes IO errors which occur within a -- computation, and which are not fully handled. -- -- Non-I\/O exceptions are not caught by this variant; to catch all -- exceptions, use 'Control.Exception.try' from "Control.Exception". +tryIOError :: IO a -> IO (Either IOError a) +tryIOError f = catch (do r <- f + return (Right r)) + (return . Left) #ifndef __NHC__ +{-# DEPRECATED try "Please use the new exceptions variant, Control.Exception.try" #-} +-- | The 'try' function is deprecated. Please use the new exceptions +-- variant, 'Control.Exception.try' from "Control.Exception", instead. try :: IO a -> IO (Either IOError a) try f = catch (do r <- f return (Right r)) @@ -148,27 +161,30 @@ try f = catch (do r <- f mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError mkIOError t location maybe_hdl maybe_filename = IOError{ ioe_type = t, - ioe_location = location, - ioe_description = "", - ioe_handle = maybe_hdl, - ioe_filename = maybe_filename - } + ioe_location = location, + ioe_description = "", +#if defined(__GLASGOW_HASKELL__) + ioe_errno = Nothing, +#endif + ioe_handle = maybe_hdl, + ioe_filename = maybe_filename + } +#endif /* __GLASGOW_HASKELL__ || __HUGS__ */ #ifdef __NHC__ mkIOError EOF location maybe_hdl maybe_filename = - EOFError location (fromJust maybe_hdl) + NHC.EOFError location (fromJust maybe_hdl) mkIOError UserError location maybe_hdl maybe_filename = - UserError location "" + NHC.UserError location "" mkIOError t location maybe_hdl maybe_filename = - NHC.FFI.mkIOError location maybe_filename maybe_handle (ioeTypeToInt t) + NHC.IOError location maybe_filename maybe_hdl (ioeTypeToErrNo t) where - ioeTypeToInt AlreadyExists = fromEnum EEXIST - ioeTypeToInt NoSuchThing = fromEnum ENOENT - ioeTypeToInt ResourceBusy = fromEnum EBUSY - ioeTypeToInt ResourceExhausted = fromEnum ENOSPC - ioeTypeToInt IllegalOperation = fromEnum EPERM - ioeTypeToInt PermissionDenied = fromEnum EACCES -#endif -#endif /* __GLASGOW_HASKELL__ || __HUGS__ */ + ioeTypeToErrNo AlreadyExists = NHC.EEXIST + ioeTypeToErrNo NoSuchThing = NHC.ENOENT + ioeTypeToErrNo ResourceBusy = NHC.EBUSY + ioeTypeToErrNo ResourceExhausted = NHC.ENOSPC + ioeTypeToErrNo IllegalOperation = NHC.EPERM + ioeTypeToErrNo PermissionDenied = NHC.EACCES +#endif /* __NHC__ */ #ifndef __NHC__ -- ----------------------------------------------------------------------------- @@ -226,8 +242,8 @@ isUserError = isUserErrorType . ioeGetErrorType #ifdef __NHC__ data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy - | ResourceExhausted | EOF | IllegalOperation - | PermissionDenied | UserError + | ResourceExhausted | EOF | IllegalOperation + | PermissionDenied | UserError #endif -- | I\/O error where the operation failed because one of its arguments @@ -264,8 +280,8 @@ permissionErrorType :: IOErrorType permissionErrorType = PermissionDenied -- | I\/O error that is programmer-defined. -userErrorType :: IOErrorType -userErrorType = UserError +userErrorType :: IOErrorType +userErrorType = UserError -- ----------------------------------------------------------------------------- -- IOErrorType predicates @@ -319,8 +335,9 @@ isUserErrorType _ = False -- Miscellaneous #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -ioeGetErrorType :: IOError -> IOErrorType +ioeGetErrorType :: IOError -> IOErrorType ioeGetErrorString :: IOError -> String +ioeGetLocation :: IOError -> String ioeGetHandle :: IOError -> Maybe Handle ioeGetFileName :: IOError -> Maybe FilePath @@ -330,20 +347,65 @@ ioeGetErrorString ioe | isUserErrorType (ioe_type ioe) = ioe_description ioe | otherwise = show (ioe_type ioe) +ioeGetLocation ioe = ioe_location ioe + ioeGetHandle ioe = ioe_handle ioe ioeGetFileName ioe = ioe_filename ioe -ioeSetErrorType :: IOError -> IOErrorType -> IOError -ioeSetErrorString :: IOError -> String -> IOError -ioeSetHandle :: IOError -> Handle -> IOError -ioeSetFileName :: IOError -> FilePath -> IOError +ioeSetErrorType :: IOError -> IOErrorType -> IOError +ioeSetErrorString :: IOError -> String -> IOError +ioeSetLocation :: IOError -> String -> IOError +ioeSetHandle :: IOError -> Handle -> IOError +ioeSetFileName :: IOError -> FilePath -> IOError ioeSetErrorType ioe errtype = ioe{ ioe_type = errtype } ioeSetErrorString ioe str = ioe{ ioe_description = str } +ioeSetLocation ioe str = ioe{ ioe_location = str } ioeSetHandle ioe hdl = ioe{ ioe_handle = Just hdl } ioeSetFileName ioe filename = ioe{ ioe_filename = Just filename } +#elif defined(__NHC__) +ioeGetErrorType :: IOError -> IOErrorType +ioeGetLocation :: IOError -> String + +ioeGetErrorType e | isAlreadyExistsError e = AlreadyExists + | isDoesNotExistError e = NoSuchThing + | isAlreadyInUseError e = ResourceBusy + | isFullError e = ResourceExhausted + | isEOFError e = EOF + | isIllegalOperation e = IllegalOperation + | isPermissionError e = PermissionDenied + | isUserError e = UserError + +ioeGetLocation (NHC.IOError _ _ _ _) = "unknown location" +ioeGetLocation (NHC.EOFError _ _ ) = "unknown location" +ioeGetLocation (NHC.PatternError loc) = loc +ioeGetLocation (NHC.UserError loc _) = loc + +ioeSetErrorType :: IOError -> IOErrorType -> IOError +ioeSetErrorString :: IOError -> String -> IOError +ioeSetLocation :: IOError -> String -> IOError +ioeSetHandle :: IOError -> Handle -> IOError +ioeSetFileName :: IOError -> FilePath -> IOError + +ioeSetErrorType e _ = e +ioeSetErrorString (NHC.IOError _ f h e) s = NHC.IOError s f h e +ioeSetErrorString (NHC.EOFError _ f) s = NHC.EOFError s f +ioeSetErrorString e@(NHC.PatternError _) _ = e +ioeSetErrorString (NHC.UserError l _) s = NHC.UserError l s +ioeSetLocation e@(NHC.IOError _ _ _ _) _ = e +ioeSetLocation e@(NHC.EOFError _ _) _ = e +ioeSetLocation (NHC.PatternError _) l = NHC.PatternError l +ioeSetLocation (NHC.UserError _ m) l = NHC.UserError l m +ioeSetHandle (NHC.IOError o f _ e) h = NHC.IOError o f (Just h) e +ioeSetHandle (NHC.EOFError o _) h = NHC.EOFError o h +ioeSetHandle e@(NHC.PatternError _) _ = e +ioeSetHandle e@(NHC.UserError _ _) _ = e +ioeSetFileName (NHC.IOError o _ h e) f = NHC.IOError o (Just f) h e +ioeSetFileName e _ = e +#endif + -- | Catch any 'IOError' that occurs in the computation and throw a -- modified version. modifyIOError :: (IOError -> IOError) -> IO a -> IO a @@ -360,20 +422,55 @@ annotateIOError :: IOError -> Maybe Handle -> Maybe FilePath -> IOError -annotateIOError (IOError ohdl errTy _ str opath) loc hdl path = - IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath) + +#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) +annotateIOError ioe loc hdl path = + ioe{ ioe_handle = hdl `mplus` ioe_handle ioe, + ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe } where + mplus :: Maybe a -> Maybe a -> Maybe a Nothing `mplus` ys = ys xs `mplus` _ = xs #endif /* __GLASGOW_HASKELL__ || __HUGS__ */ -#if 0 /*__NHC__*/ -annotateIOError (IOError msg file hdl code) msg' file' hdl' = - IOError (msg++'\n':msg') (file`mplus`file') (hdl`mplus`hdl') code -annotateIOError (EOFError msg hdl) msg' file' hdl' = - EOFError (msg++'\n':msg') (hdl`mplus`hdl') -annotateIOError (UserError loc msg) msg' file' hdl' = - UserError loc (msg++'\n':msg') -annotateIOError (PatternError loc) msg' file' hdl' = - PatternError (loc++'\n':msg') +#if defined(__NHC__) +annotateIOError (NHC.IOError msg file hdl code) msg' hdl' file' = + NHC.IOError (msg++'\n':msg') (file`mplus`file') (hdl`mplus`hdl') code +annotateIOError (NHC.EOFError msg hdl) msg' _ _ = + NHC.EOFError (msg++'\n':msg') hdl +annotateIOError (NHC.UserError loc msg) msg' _ _ = + NHC.UserError loc (msg++'\n':msg') +annotateIOError (NHC.PatternError loc) msg' _ _ = + NHC.PatternError (loc++'\n':msg') #endif + +#ifndef __HUGS__ +-- | The 'catchIOError' function establishes a handler that receives any +-- 'IOError' raised in the action protected by 'catchIOError'. +-- An 'IOError' is caught by +-- the most recent handler established by one of the exception handling +-- functions. These handlers are +-- not selective: all 'IOError's are caught. Exception propagation +-- must be explicitly provided in a handler by re-raising any unwanted +-- exceptions. For example, in +-- +-- > f = catchIOError g (\e -> if IO.isEOFError e then return [] else ioError e) +-- +-- the function @f@ returns @[]@ when an end-of-file exception +-- (cf. 'System.IO.Error.isEOFError') occurs in @g@; otherwise, the +-- exception is propagated to the next outer handler. +-- +-- When an exception propagates outside the main program, the Haskell +-- system prints the associated 'IOError' value and exits the program. +-- +-- Non-I\/O exceptions are not caught by this variant; to catch all +-- exceptions, use 'Control.Exception.catch' from "Control.Exception". +catchIOError :: IO a -> (IOError -> IO a) -> IO a +catchIOError = New.catch + +{-# DEPRECATED catch "Please use the new exceptions variant, Control.Exception.catch" #-} +-- | The 'catch' function is deprecated. Please use the new exceptions +-- variant, 'Control.Exception.catch' from "Control.Exception", instead. +catch :: IO a -> (IOError -> IO a) -> IO a +catch = New.catch +#endif /* !__HUGS__ */