X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FIO%2FError.hs;h=a5aba922d003122642011b8c6c855b79f369a142;hb=41e8fba828acbae1751628af50849f5352b27873;hp=04bf6c664d3d4db5065eef974b6b965d82ca17bb;hpb=3a4a64a72ecf7c8659730edf93f1ff9990172a85;p=ghc-base.git diff --git a/System/IO/Error.hs b/System/IO/Error.hs index 04bf6c6..a5aba92 100644 --- a/System/IO/Error.hs +++ b/System/IO/Error.hs @@ -1,32 +1,59 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude #-} ----------------------------------------------------------------------------- --- +-- | -- Module : System.IO.Error -- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- --- $Id: Error.hs,v 1.3 2002/03/27 17:55:26 simonmar Exp $ --- -- Standard IO Errors. -- ----------------------------------------------------------------------------- module System.IO.Error ( - IOError, -- abstract - IOErrorType, -- abstract - ioError, -- :: IOError -> IO a - userError, -- :: String -> IOError + -- * I\/O errors + IOError, -- = IOException + + userError, -- :: String -> IOError - mkIOError, -- :: IOErrorType -> String -> Maybe Handle - -- -> Maybe FilePath -> IOError + mkIOError, -- :: IOErrorType -> String -> Maybe Handle + -- -> Maybe FilePath -> IOError - alreadyExistsErrorType, -- :: IOErrorType + annotateIOError, -- :: IOError -> String -> Maybe Handle + -- -> Maybe FilePath -> IOError + + -- ** Classifying I\/O errors + isAlreadyExistsError, -- :: IOError -> Bool + isDoesNotExistError, + isAlreadyInUseError, + isFullError, + isEOFError, + isIllegalOperation, + isPermissionError, + isUserError, + + -- ** Attributes of I\/O errors + 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 + + alreadyExistsErrorType, -- :: IOErrorType doesNotExistErrorType, alreadyInUseErrorType, fullErrorType, @@ -35,7 +62,8 @@ module System.IO.Error ( permissionErrorType, userErrorType, - isAlreadyExistsErrorType, -- :: IOErrorType -> Bool + -- ** 'IOErrorType' predicates + isAlreadyExistsErrorType, -- :: IOErrorType -> Bool isDoesNotExistErrorType, isAlreadyInUseErrorType, isFullErrorType, @@ -44,147 +72,388 @@ module System.IO.Error ( isPermissionErrorType, isUserErrorType, - isAlreadyExistsError, -- :: IOError -> Bool - isDoesNotExistError, - isAlreadyInUseError, - isFullError, - isEOFError, - isIllegalOperation, - isPermissionError, - isUserError, + -- * Throwing and catching I\/O errors - ioeGetErrorType, -- :: IOError -> IOErrorType - ioeGetErrorString, -- :: IOError -> String - ioeGetHandle, -- :: IOError -> Maybe Handle - ioeGetFileName, -- :: IOError -> Maybe FilePath + ioError, -- :: IOError -> IO a + catch, -- :: IO a -> (IOError -> IO a) -> IO a + try, -- :: IO a -> IO (Either IOError a) + + 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 Data.Maybe -import GHC.IOBase +import GHC.IO +import GHC.IO.Exception +import GHC.IO.Handle.Types import Text.Show #endif +#ifdef __HUGS__ +import Hugs.Prelude(Handle, IOException(..), IOErrorType(..), IO) +#endif + +#ifdef __NHC__ +import IO + ( IOError () + , Handle () + , try + , ioError + , userError + , isAlreadyExistsError -- :: IOError -> Bool + , isDoesNotExistError + , isAlreadyInUseError + , isFullError + , isEOFError + , isIllegalOperation + , isPermissionError + , isUserError + , ioeGetErrorString -- :: IOError -> String + , ioeGetHandle -- :: IOError -> Maybe Handle + , ioeGetFileName -- :: IOError -> Maybe FilePath + ) +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 +-- 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". + +#ifndef __NHC__ +try :: IO a -> IO (Either IOError a) +try f = catch (do r <- f + return (Right r)) + (return . Left) +#endif + +#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -- ----------------------------------------------------------------------------- -- Constructing an IOError +-- | Construct an 'IOError' of the given type where the second argument +-- describes the error location and the third and fourth argument +-- contain the file handle and file path of the file involved in the +-- error if applicable. mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError mkIOError t location maybe_hdl maybe_filename = - IOException IOError{ ioe_type = t, - ioe_location = location, - ioe_descr = "", - ioe_handle = maybe_hdl, - ioe_filename = maybe_filename - } - + IOError{ ioe_type = t, + 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 = + NHC.EOFError location (fromJust maybe_hdl) +mkIOError UserError location maybe_hdl maybe_filename = + NHC.UserError location "" +mkIOError t location maybe_hdl maybe_filename = + NHC.IOError location maybe_filename maybe_hdl (ioeTypeToErrNo t) + where + 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__ -- ----------------------------------------------------------------------------- -- IOErrorType -isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError, - isFullError, isEOFError, isIllegalOperation, isPermissionError, - isUserError :: IOError -> Bool - +-- | An error indicating that an 'IO' operation failed because +-- one of its arguments already exists. +isAlreadyExistsError :: IOError -> Bool isAlreadyExistsError = isAlreadyExistsErrorType . ioeGetErrorType + +-- | An error indicating that an 'IO' operation failed because +-- one of its arguments does not exist. +isDoesNotExistError :: IOError -> Bool isDoesNotExistError = isDoesNotExistErrorType . ioeGetErrorType + +-- | An error indicating that an 'IO' operation failed because +-- one of its arguments is a single-use resource, which is already +-- being used (for example, opening the same file twice for writing +-- might give this error). +isAlreadyInUseError :: IOError -> Bool isAlreadyInUseError = isAlreadyInUseErrorType . ioeGetErrorType + +-- | An error indicating that an 'IO' operation failed because +-- the device is full. +isFullError :: IOError -> Bool isFullError = isFullErrorType . ioeGetErrorType + +-- | An error indicating that an 'IO' operation failed because +-- the end of file has been reached. +isEOFError :: IOError -> Bool isEOFError = isEOFErrorType . ioeGetErrorType + +-- | An error indicating that an 'IO' operation failed because +-- the operation was not possible. +-- Any computation which returns an 'IO' result may fail with +-- 'isIllegalOperation'. In some cases, an implementation will not be +-- able to distinguish between the possible error causes. In this case +-- it should fail with 'isIllegalOperation'. +isIllegalOperation :: IOError -> Bool isIllegalOperation = isIllegalOperationErrorType . ioeGetErrorType + +-- | An error indicating that an 'IO' operation failed because +-- the user does not have sufficient operating system privilege +-- to perform that operation. +isPermissionError :: IOError -> Bool isPermissionError = isPermissionErrorType . ioeGetErrorType + +-- | A programmer-defined error value constructed using 'userError'. +isUserError :: IOError -> Bool isUserError = isUserErrorType . ioeGetErrorType +#endif /* __NHC__ */ -- ----------------------------------------------------------------------------- -- IOErrorTypes -#ifdef __GLASGOW_HASKELL__ -alreadyExistsErrorType, doesNotExistErrorType, alreadyInUseErrorType, - fullErrorType, eofErrorType, illegalOperationErrorType, - permissionErrorType, userErrorType :: IOErrorType +#ifdef __NHC__ +data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy + | ResourceExhausted | EOF | IllegalOperation + | PermissionDenied | UserError +#endif +-- | I\/O error where the operation failed because one of its arguments +-- already exists. +alreadyExistsErrorType :: IOErrorType alreadyExistsErrorType = AlreadyExists + +-- | I\/O error where the operation failed because one of its arguments +-- does not exist. +doesNotExistErrorType :: IOErrorType doesNotExistErrorType = NoSuchThing + +-- | I\/O error where the operation failed because one of its arguments +-- is a single-use resource, which is already being used. +alreadyInUseErrorType :: IOErrorType alreadyInUseErrorType = ResourceBusy + +-- | I\/O error where the operation failed because the device is full. +fullErrorType :: IOErrorType fullErrorType = ResourceExhausted + +-- | I\/O error where the operation failed because the end of file has +-- been reached. +eofErrorType :: IOErrorType eofErrorType = EOF + +-- | I\/O error where the operation is not possible. +illegalOperationErrorType :: IOErrorType illegalOperationErrorType = IllegalOperation + +-- | I\/O error where the operation failed because the user does not +-- have sufficient operating system privilege to perform that operation. +permissionErrorType :: IOErrorType permissionErrorType = PermissionDenied -userErrorType = UserError -#endif + +-- | I\/O error that is programmer-defined. +userErrorType :: IOErrorType +userErrorType = UserError -- ----------------------------------------------------------------------------- -- IOErrorType predicates -isAlreadyExistsErrorType, isDoesNotExistErrorType, isAlreadyInUseErrorType, - isFullErrorType, isEOFErrorType, isIllegalOperationErrorType, - isPermissionErrorType, isUserErrorType :: IOErrorType -> Bool - -#ifdef __GLASGOW_HASKELL__ +-- | I\/O error where the operation failed because one of its arguments +-- already exists. +isAlreadyExistsErrorType :: IOErrorType -> Bool isAlreadyExistsErrorType AlreadyExists = True isAlreadyExistsErrorType _ = False +-- | I\/O error where the operation failed because one of its arguments +-- does not exist. +isDoesNotExistErrorType :: IOErrorType -> Bool isDoesNotExistErrorType NoSuchThing = True isDoesNotExistErrorType _ = False +-- | I\/O error where the operation failed because one of its arguments +-- is a single-use resource, which is already being used. +isAlreadyInUseErrorType :: IOErrorType -> Bool isAlreadyInUseErrorType ResourceBusy = True isAlreadyInUseErrorType _ = False +-- | I\/O error where the operation failed because the device is full. +isFullErrorType :: IOErrorType -> Bool isFullErrorType ResourceExhausted = True isFullErrorType _ = False +-- | I\/O error where the operation failed because the end of file has +-- been reached. +isEOFErrorType :: IOErrorType -> Bool isEOFErrorType EOF = True isEOFErrorType _ = False +-- | I\/O error where the operation is not possible. +isIllegalOperationErrorType :: IOErrorType -> Bool isIllegalOperationErrorType IllegalOperation = True isIllegalOperationErrorType _ = False +-- | I\/O error where the operation failed because the user does not +-- have sufficient operating system privilege to perform that operation. +isPermissionErrorType :: IOErrorType -> Bool isPermissionErrorType PermissionDenied = True isPermissionErrorType _ = False +-- | I\/O error that is programmer-defined. +isUserErrorType :: IOErrorType -> Bool isUserErrorType UserError = True isUserErrorType _ = False -#endif -- ----------------------------------------------------------------------------- -- Miscellaneous -#ifdef __GLASGOW_HASKELL__ -ioeGetErrorType :: IOError -> IOErrorType -ioeGetHandle :: IOError -> Maybe Handle +#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) +ioeGetErrorType :: IOError -> IOErrorType ioeGetErrorString :: IOError -> String +ioeGetLocation :: IOError -> String +ioeGetHandle :: IOError -> Maybe Handle ioeGetFileName :: IOError -> Maybe FilePath -ioeGetErrorType (IOException ioe) = ioe_type ioe -ioeGetErrorType _ = error "System.IO.Error.ioeGetHandle: 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" - -ioeGetErrorString (IOException ioe) - | isUserErrorType (ioe_type ioe) = show (ioe_descr ioe) +ioeGetErrorString ioe + | isUserErrorType (ioe_type ioe) = ioe_description 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" +ioeGetLocation ioe = ioe_location ioe + +ioeGetHandle ioe = ioe_handle ioe + +ioeGetFileName ioe = ioe_filename ioe + +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 +modifyIOError f io = catch io (\e -> ioError (f e)) + -- ----------------------------------------------------------------------------- -- annotating an IOError -#ifdef __GLASGOW_HASKELL__ +-- | Adds a location description and maybe a file path and file handle +-- to an 'IOError'. If any of the file handle or file path is not given +-- the corresponding value in the 'IOError' remains unaltered. annotateIOError :: IOError -> String - -> Maybe FilePath -> Maybe Handle + -> Maybe FilePath -> IOError -annotateIOError (IOException (IOError hdl errTy _ str path)) loc opath ohdl = - IOException (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 -annotateIOError exc _ _ _ = - exc +#endif /* __GLASGOW_HASKELL__ || __HUGS__ */ + +#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 'catch' function establishes a handler that receives any 'IOError' +-- raised in the action protected by 'catch'. An 'IOError' is caught by +-- the most recent handler established by 'catch'. 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 = catch 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". +catch :: IO a -> (IOError -> IO a) -> IO a +catch = New.catch +#endif /* !__HUGS__ */