(original) (raw)

{-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}

module System.IO.Error (

[IOError](GHC.IO.Exception.html#IOError),

[userError](GHC.IO.Exception.html#userError),

[mkIOError](System.IO.Error.html#mkIOError),

[annotateIOError](System.IO.Error.html#annotateIOError),


[isAlreadyExistsError](System.IO.Error.html#isAlreadyExistsError),
[isDoesNotExistError](System.IO.Error.html#isDoesNotExistError),
[isAlreadyInUseError](System.IO.Error.html#isAlreadyInUseError),
[isFullError](System.IO.Error.html#isFullError),
[isEOFError](System.IO.Error.html#isEOFError),
[isIllegalOperation](System.IO.Error.html#isIllegalOperation),
[isPermissionError](System.IO.Error.html#isPermissionError),
[isUserError](System.IO.Error.html#isUserError),


[ioeGetErrorType](System.IO.Error.html#ioeGetErrorType),
[ioeGetLocation](System.IO.Error.html#ioeGetLocation),
[ioeGetErrorString](System.IO.Error.html#ioeGetErrorString),
[ioeGetHandle](System.IO.Error.html#ioeGetHandle),
[ioeGetFileName](System.IO.Error.html#ioeGetFileName),

[ioeSetErrorType](System.IO.Error.html#ioeSetErrorType),
[ioeSetErrorString](System.IO.Error.html#ioeSetErrorString),
[ioeSetLocation](System.IO.Error.html#ioeSetLocation),
[ioeSetHandle](System.IO.Error.html#ioeSetHandle),
[ioeSetFileName](System.IO.Error.html#ioeSetFileName),


[IOErrorType](GHC.IO.Exception.html#IOErrorType),                

[alreadyExistsErrorType](System.IO.Error.html#alreadyExistsErrorType),
[doesNotExistErrorType](System.IO.Error.html#doesNotExistErrorType),
[alreadyInUseErrorType](System.IO.Error.html#alreadyInUseErrorType),
[fullErrorType](System.IO.Error.html#fullErrorType),
[eofErrorType](System.IO.Error.html#eofErrorType),
[illegalOperationErrorType](System.IO.Error.html#illegalOperationErrorType),
[permissionErrorType](System.IO.Error.html#permissionErrorType),
[userErrorType](System.IO.Error.html#userErrorType),


[isAlreadyExistsErrorType](System.IO.Error.html#isAlreadyExistsErrorType),
[isDoesNotExistErrorType](System.IO.Error.html#isDoesNotExistErrorType),
[isAlreadyInUseErrorType](System.IO.Error.html#isAlreadyInUseErrorType),
[isFullErrorType](System.IO.Error.html#isFullErrorType),
[isEOFErrorType](System.IO.Error.html#isEOFErrorType),
[isIllegalOperationErrorType](System.IO.Error.html#isIllegalOperationErrorType),
[isPermissionErrorType](System.IO.Error.html#isPermissionErrorType),
[isUserErrorType](System.IO.Error.html#isUserErrorType),


[ioError](GHC.IO.Exception.html#ioError),

[catchIOError](System.IO.Error.html#catchIOError),
[tryIOError](System.IO.Error.html#tryIOError),

[modifyIOError](System.IO.Error.html#modifyIOError),

) where

import Control.Exception.Base

import Data.Either import Data.Maybe

import GHC.Base import GHC.IO import GHC.IO.Exception import GHC.IO.Handle.Types import Text.Show

tryIOError :: IO a -> IO (Either IOError a) tryIOError f = catch (do r <- f return (Right r)) (return . Left)

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_errno = Nothing, ioe_handle = maybe_hdl, ioe_filename = maybe_filename }

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

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

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 }

modifyIOError :: (IOError -> IOError) -> IO a -> IO a modifyIOError f io = catch io ([e](#local-6989586621679351540) -> ioError (f e))

annotateIOError :: IOError -> String -> Maybe Handle -> Maybe FilePath -> IOError annotateIOError ioe loc hdl path = ioe{ ioe_handle = hdl [mplus](GHC.Base.html#mplus) ioe_handle ioe, ioe_location = loc, ioe_filename = path [mplus](GHC.Base.html#mplus) ioe_filename ioe }

catchIOError :: IO a -> (IOError -> IO a) -> IO a catchIOError = catch