X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FIO%2FError.hs;h=95fde8522a97ae6eeef09e4fad6e7327e2e51548;hb=567080c906535534628b1ab83a4a4425dcd4bb5e;hp=fd92ee1f25041fa4b6bec45a1826bd7618098f87;hpb=9812e0a321ec0ed8f9e53eb2febfb14c79564200;p=haskell-directory.git diff --git a/System/IO/Error.hs b/System/IO/Error.hs index fd92ee1..95fde85 100644 --- a/System/IO/Error.hs +++ b/System/IO/Error.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | @@ -15,18 +15,48 @@ ----------------------------------------------------------------------------- module System.IO.Error ( - IOError, -- abstract -#ifndef __HUGS__ - IOErrorType, -- abstract -#endif - ioError, -- :: IOError -> IO a + -- * I\/O errors + IOError, -- = IOException + userError, -- :: String -> IOError -#ifndef __HUGS__ +#ifndef __NHC__ mkIOError, -- :: IOErrorType -> String -> Maybe Handle -- -> Maybe FilePath -> IOError + annotateIOError, -- :: IOError -> String -> Maybe Handle + -- -> Maybe FilePath -> IOError +#endif + + -- ** Classifying I\/O errors + isAlreadyExistsError, -- :: IOError -> Bool + isDoesNotExistError, + isAlreadyInUseError, + isFullError, + isEOFError, + isIllegalOperation, + isPermissionError, + 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 + + -- * Types of I\/O error + IOErrorType, -- abstract + alreadyExistsErrorType, -- :: IOErrorType doesNotExistErrorType, alreadyInUseErrorType, @@ -36,6 +66,7 @@ module System.IO.Error ( permissionErrorType, userErrorType, + -- ** 'IOErrorType' predicates isAlreadyExistsErrorType, -- :: IOErrorType -> Bool isDoesNotExistErrorType, isAlreadyInUseErrorType, @@ -44,159 +75,305 @@ module System.IO.Error ( isIllegalOperationErrorType, isPermissionErrorType, isUserErrorType, -#endif /* __HUGS__ */ - isAlreadyExistsError, -- :: IOError -> Bool - isDoesNotExistError, - isAlreadyInUseError, - isFullError, - isEOFError, - isIllegalOperation, - isPermissionError, - isUserError, + -- * Throwing and catching I\/O errors -#ifndef __HUGS__ - ioeGetErrorType, -- :: IOError -> IOErrorType -#endif - 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) +#ifndef __NHC__ + modifyIOError, -- :: (IOError -> IOError) -> IO a -> IO a +#endif ) where +import Data.Either +import Data.Maybe #ifdef __GLASGOW_HASKELL__ import GHC.Base -import Data.Maybe import GHC.IOBase +import GHC.Exception import Text.Show #endif #ifdef __HUGS__ -import Hugs.IO +import Hugs.Prelude(Handle, IOException(..), IOErrorType(..)) +#endif + +#ifdef __NHC__ +import IO + ( IOError () + , 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 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 -#ifndef __HUGS__ +#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, + IOError{ ioe_type = t, ioe_location = location, - ioe_descr = "", + ioe_description = "", ioe_handle = maybe_hdl, ioe_filename = maybe_filename } +#ifdef __NHC__ +mkIOError EOF location maybe_hdl maybe_filename = + EOFError location (fromJust maybe_hdl) +mkIOError UserError location maybe_hdl maybe_filename = + UserError location "" +mkIOError t location maybe_hdl maybe_filename = + NHC.FFI.mkIOError location maybe_filename maybe_handle (ioeTypeToInt 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__ */ +#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 +#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 + +-- | I\/O error that is programmer-defined. +userErrorType :: IOErrorType userErrorType = UserError -#endif -- ----------------------------------------------------------------------------- -- IOErrorType predicates -#ifndef __HUGS__ -isAlreadyExistsErrorType, isDoesNotExistErrorType, isAlreadyInUseErrorType, - isFullErrorType, isEOFErrorType, isIllegalOperationErrorType, - isPermissionErrorType, isUserErrorType :: IOErrorType -> Bool -#endif - -#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__ +#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) ioeGetErrorType :: IOError -> IOErrorType -ioeGetHandle :: IOError -> Maybe Handle ioeGetErrorString :: 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" - -ioeGetHandle (IOException ioe) = ioe_handle ioe -ioeGetHandle _ = error "System.IO.Error.ioeGetHandle: not an IO error" +ioeGetErrorType ioe = ioe_type ioe -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" -#endif +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 ioe errtype = ioe{ ioe_type = errtype } +ioeSetErrorString ioe str = ioe{ ioe_description = str } +ioeSetHandle ioe hdl = ioe{ ioe_handle = Just hdl } +ioeSetFileName ioe filename = ioe{ ioe_filename = Just filename } + +-- | 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)) +annotateIOError (IOError ohdl errTy _ str opath) loc hdl path = + IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath) where Nothing `mplus` ys = ys xs `mplus` _ = xs -annotateIOError exc _ _ _ = - exc +#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') #endif