module System.IO.Error (
IOError,
userError,
mkIOError,
annotateIOError,
isAlreadyExistsError,
isDoesNotExistError,
isAlreadyInUseError,
isFullError,
isEOFError,
isIllegalOperation,
isPermissionError,
isUserError,
ioeGetErrorType,
ioeGetLocation,
ioeGetErrorString,
ioeGetHandle,
ioeGetFileName,
ioeSetErrorType,
ioeSetErrorString,
ioeSetLocation,
ioeSetHandle,
ioeSetFileName,
IOErrorType,
alreadyExistsErrorType,
doesNotExistErrorType,
alreadyInUseErrorType,
fullErrorType,
eofErrorType,
illegalOperationErrorType,
permissionErrorType,
userErrorType,
isAlreadyExistsErrorType,
isDoesNotExistErrorType,
isAlreadyInUseErrorType,
isFullErrorType,
isEOFErrorType,
isIllegalOperationErrorType,
isPermissionErrorType,
isUserErrorType,
ioError,
catch,
try,
modifyIOError,
) 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.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
, isDoesNotExistError
, isAlreadyInUseError
, isFullError
, isEOFError
, isIllegalOperation
, isPermissionError
, isUserError
, ioeGetErrorString
, ioeGetHandle
, ioeGetFileName
)
import qualified NHC.Internal as NHC (IOError(..))
import qualified NHC.DErrNo as NHC (ErrNo(..))
import Data.Maybe (fromJust)
import Control.Monad (MonadPlus(mplus))
#endif
#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__)
mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError
mkIOError t location maybe_hdl 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__
isAlreadyExistsError :: IOError -> Bool
isAlreadyExistsError = isAlreadyExistsErrorType . ioeGetErrorType
isDoesNotExistError :: IOError -> Bool
isDoesNotExistError = isDoesNotExistErrorType . ioeGetErrorType
isAlreadyInUseError :: IOError -> Bool
isAlreadyInUseError = isAlreadyInUseErrorType . ioeGetErrorType
isFullError :: IOError -> Bool
isFullError = isFullErrorType . ioeGetErrorType
isEOFError :: IOError -> Bool
isEOFError = isEOFErrorType . ioeGetErrorType
isIllegalOperation :: IOError -> Bool
isIllegalOperation = isIllegalOperationErrorType . ioeGetErrorType
isPermissionError :: IOError -> Bool
isPermissionError = isPermissionErrorType . ioeGetErrorType
isUserError :: IOError -> Bool
isUserError = isUserErrorType . ioeGetErrorType
#endif /* __NHC__ */
#ifdef __NHC__
data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy
| ResourceExhausted | EOF | IllegalOperation
| PermissionDenied | UserError
#endif
alreadyExistsErrorType :: IOErrorType
alreadyExistsErrorType = AlreadyExists
doesNotExistErrorType :: IOErrorType
doesNotExistErrorType = NoSuchThing
alreadyInUseErrorType :: IOErrorType
alreadyInUseErrorType = ResourceBusy
fullErrorType :: IOErrorType
fullErrorType = ResourceExhausted
eofErrorType :: IOErrorType
eofErrorType = EOF
illegalOperationErrorType :: IOErrorType
illegalOperationErrorType = IllegalOperation
permissionErrorType :: IOErrorType
permissionErrorType = PermissionDenied
userErrorType :: IOErrorType
userErrorType = UserError
isAlreadyExistsErrorType :: IOErrorType -> Bool
isAlreadyExistsErrorType AlreadyExists = True
isAlreadyExistsErrorType _ = False
isDoesNotExistErrorType :: IOErrorType -> Bool
isDoesNotExistErrorType NoSuchThing = True
isDoesNotExistErrorType _ = False
isAlreadyInUseErrorType :: IOErrorType -> Bool
isAlreadyInUseErrorType ResourceBusy = True
isAlreadyInUseErrorType _ = False
isFullErrorType :: IOErrorType -> Bool
isFullErrorType ResourceExhausted = True
isFullErrorType _ = False
isEOFErrorType :: IOErrorType -> Bool
isEOFErrorType EOF = True
isEOFErrorType _ = False
isIllegalOperationErrorType :: IOErrorType -> Bool
isIllegalOperationErrorType IllegalOperation = True
isIllegalOperationErrorType _ = False
isPermissionErrorType :: IOErrorType -> Bool
isPermissionErrorType PermissionDenied = True
isPermissionErrorType _ = False
isUserErrorType :: IOErrorType -> Bool
isUserErrorType UserError = True
isUserErrorType _ = False
#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
ioeGetErrorType :: IOError -> IOErrorType
ioeGetErrorString :: IOError -> String
ioeGetLocation :: IOError -> String
ioeGetHandle :: IOError -> Maybe Handle
ioeGetFileName :: IOError -> Maybe FilePath
ioeGetErrorType ioe = ioe_type ioe
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
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
modifyIOError :: (IOError -> IOError) -> IO a -> IO a
modifyIOError f io = catch io (\e -> ioError (f e))
annotateIOError :: IOError
-> String
-> Maybe Handle
-> Maybe FilePath
-> IOError
#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 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__
catch :: IO a -> (IOError -> IO a) -> IO a
catch = New.catch
#endif /* !__HUGS__ */