{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
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,
catchIOError,
tryIOError,
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 :: IO a -> IO (Either IOError a)
tryIOError f :: IO a
f = IO (Either IOError a)
-> (IOError -> IO (Either IOError a)) -> IO (Either IOError a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (do a
r <- IO a
f
Either IOError a -> IO (Either IOError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either IOError a
forall a b. b -> Either a b
Right a
r))
(Either IOError a -> IO (Either IOError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOError a -> IO (Either IOError a))
-> (IOError -> Either IOError a)
-> IOError
-> IO (Either IOError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Either IOError a
forall a b. a -> Either a b
Left)
mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError
mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError t :: IOErrorType
t location :: String
location maybe_hdl :: Maybe Handle
maybe_hdl maybe_filename :: Maybe String
maybe_filename =
IOError :: Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOError
IOError{ ioe_type :: IOErrorType
ioe_type = IOErrorType
t,
ioe_location :: String
ioe_location = String
location,
ioe_description :: String
ioe_description = "",
ioe_errno :: Maybe CInt
ioe_errno = Maybe CInt
forall a. Maybe a
Nothing,
ioe_handle :: Maybe Handle
ioe_handle = Maybe Handle
maybe_hdl,
ioe_filename :: Maybe String
ioe_filename = Maybe String
maybe_filename
}
isAlreadyExistsError :: IOError -> Bool
isAlreadyExistsError :: IOError -> Bool
isAlreadyExistsError = IOErrorType -> Bool
isAlreadyExistsErrorType (IOErrorType -> Bool)
-> (IOError -> IOErrorType) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IOErrorType
ioeGetErrorType
isDoesNotExistError :: IOError -> Bool
isDoesNotExistError :: IOError -> Bool
isDoesNotExistError = IOErrorType -> Bool
isDoesNotExistErrorType (IOErrorType -> Bool)
-> (IOError -> IOErrorType) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IOErrorType
ioeGetErrorType
isAlreadyInUseError :: IOError -> Bool
isAlreadyInUseError :: IOError -> Bool
isAlreadyInUseError = IOErrorType -> Bool
isAlreadyInUseErrorType (IOErrorType -> Bool)
-> (IOError -> IOErrorType) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IOErrorType
ioeGetErrorType
isFullError :: IOError -> Bool
isFullError :: IOError -> Bool
isFullError = IOErrorType -> Bool
isFullErrorType (IOErrorType -> Bool)
-> (IOError -> IOErrorType) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IOErrorType
ioeGetErrorType
isEOFError :: IOError -> Bool
isEOFError :: IOError -> Bool
isEOFError = IOErrorType -> Bool
isEOFErrorType (IOErrorType -> Bool)
-> (IOError -> IOErrorType) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IOErrorType
ioeGetErrorType
isIllegalOperation :: IOError -> Bool
isIllegalOperation :: IOError -> Bool
isIllegalOperation = IOErrorType -> Bool
isIllegalOperationErrorType (IOErrorType -> Bool)
-> (IOError -> IOErrorType) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IOErrorType
ioeGetErrorType
isPermissionError :: IOError -> Bool
isPermissionError :: IOError -> Bool
isPermissionError = IOErrorType -> Bool
isPermissionErrorType (IOErrorType -> Bool)
-> (IOError -> IOErrorType) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IOErrorType
ioeGetErrorType
isUserError :: IOError -> Bool
isUserError :: IOError -> Bool
isUserError = IOErrorType -> Bool
isUserErrorType (IOErrorType -> Bool)
-> (IOError -> IOErrorType) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IOErrorType
ioeGetErrorType
alreadyExistsErrorType :: IOErrorType
alreadyExistsErrorType :: IOErrorType
alreadyExistsErrorType = IOErrorType
AlreadyExists
doesNotExistErrorType :: IOErrorType
doesNotExistErrorType :: IOErrorType
doesNotExistErrorType = IOErrorType
NoSuchThing
alreadyInUseErrorType :: IOErrorType
alreadyInUseErrorType :: IOErrorType
alreadyInUseErrorType = IOErrorType
ResourceBusy
fullErrorType :: IOErrorType
fullErrorType :: IOErrorType
fullErrorType = IOErrorType
ResourceExhausted
eofErrorType :: IOErrorType
eofErrorType :: IOErrorType
eofErrorType = IOErrorType
EOF
illegalOperationErrorType :: IOErrorType
illegalOperationErrorType :: IOErrorType
illegalOperationErrorType = IOErrorType
IllegalOperation
permissionErrorType :: IOErrorType
permissionErrorType :: IOErrorType
permissionErrorType = IOErrorType
PermissionDenied
userErrorType :: IOErrorType
userErrorType :: IOErrorType
userErrorType = IOErrorType
UserError
isAlreadyExistsErrorType :: IOErrorType -> Bool
isAlreadyExistsErrorType :: IOErrorType -> Bool
isAlreadyExistsErrorType AlreadyExists = Bool
True
isAlreadyExistsErrorType _ = Bool
False
isDoesNotExistErrorType :: IOErrorType -> Bool
isDoesNotExistErrorType :: IOErrorType -> Bool
isDoesNotExistErrorType NoSuchThing = Bool
True
isDoesNotExistErrorType _ = Bool
False
isAlreadyInUseErrorType :: IOErrorType -> Bool
isAlreadyInUseErrorType :: IOErrorType -> Bool
isAlreadyInUseErrorType ResourceBusy = Bool
True
isAlreadyInUseErrorType _ = Bool
False
isFullErrorType :: IOErrorType -> Bool
isFullErrorType :: IOErrorType -> Bool
isFullErrorType ResourceExhausted = Bool
True
isFullErrorType _ = Bool
False
isEOFErrorType :: IOErrorType -> Bool
isEOFErrorType :: IOErrorType -> Bool
isEOFErrorType EOF = Bool
True
isEOFErrorType _ = Bool
False
isIllegalOperationErrorType :: IOErrorType -> Bool
isIllegalOperationErrorType :: IOErrorType -> Bool
isIllegalOperationErrorType IllegalOperation = Bool
True
isIllegalOperationErrorType _ = Bool
False
isPermissionErrorType :: IOErrorType -> Bool
isPermissionErrorType :: IOErrorType -> Bool
isPermissionErrorType PermissionDenied = Bool
True
isPermissionErrorType _ = Bool
False
isUserErrorType :: IOErrorType -> Bool
isUserErrorType :: IOErrorType -> Bool
isUserErrorType UserError = Bool
True
isUserErrorType _ = Bool
False
ioeGetErrorType :: IOError -> IOErrorType
ioeGetErrorString :: IOError -> String
ioeGetLocation :: IOError -> String
ioeGetHandle :: IOError -> Maybe Handle
ioeGetFileName :: IOError -> Maybe FilePath
ioeGetErrorType :: IOError -> IOErrorType
ioeGetErrorType ioe :: IOError
ioe = IOError -> IOErrorType
ioe_type IOError
ioe
ioeGetErrorString :: IOError -> String
ioeGetErrorString ioe :: IOError
ioe
| IOErrorType -> Bool
isUserErrorType (IOError -> IOErrorType
ioe_type IOError
ioe) = IOError -> String
ioe_description IOError
ioe
| Bool
otherwise = IOErrorType -> String
forall a. Show a => a -> String
show (IOError -> IOErrorType
ioe_type IOError
ioe)
ioeGetLocation :: IOError -> String
ioeGetLocation ioe :: IOError
ioe = IOError -> String
ioe_location IOError
ioe
ioeGetHandle :: IOError -> Maybe Handle
ioeGetHandle ioe :: IOError
ioe = IOError -> Maybe Handle
ioe_handle IOError
ioe
ioeGetFileName :: IOError -> Maybe String
ioeGetFileName ioe :: IOError
ioe = IOError -> Maybe String
ioe_filename IOError
ioe
ioeSetErrorType :: IOError -> IOErrorType -> IOError
ioeSetErrorString :: IOError -> String -> IOError
ioeSetLocation :: IOError -> String -> IOError
ioeSetHandle :: IOError -> Handle -> IOError
ioeSetFileName :: IOError -> FilePath -> IOError
ioeSetErrorType :: IOError -> IOErrorType -> IOError
ioeSetErrorType ioe :: IOError
ioe errtype :: IOErrorType
errtype = IOError
ioe{ ioe_type :: IOErrorType
ioe_type = IOErrorType
errtype }
ioeSetErrorString :: IOError -> String -> IOError
ioeSetErrorString ioe :: IOError
ioe str :: String
str = IOError
ioe{ ioe_description :: String
ioe_description = String
str }
ioeSetLocation :: IOError -> String -> IOError
ioeSetLocation ioe :: IOError
ioe str :: String
str = IOError
ioe{ ioe_location :: String
ioe_location = String
str }
ioeSetHandle :: IOError -> Handle -> IOError
ioeSetHandle ioe :: IOError
ioe hdl :: Handle
hdl = IOError
ioe{ ioe_handle :: Maybe Handle
ioe_handle = Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
hdl }
ioeSetFileName :: IOError -> String -> IOError
ioeSetFileName ioe :: IOError
ioe filename :: String
filename = IOError
ioe{ ioe_filename :: Maybe String
ioe_filename = String -> Maybe String
forall a. a -> Maybe a
Just String
filename }
modifyIOError :: (IOError -> IOError) -> IO a -> IO a
modifyIOError :: (IOError -> IOError) -> IO a -> IO a
modifyIOError f :: IOError -> IOError
f io :: IO a
io = IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
io (\e :: IOError
e -> IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IOError
f IOError
e))
annotateIOError :: IOError
-> String
-> Maybe Handle
-> Maybe FilePath
-> IOError
annotateIOError :: IOError -> String -> Maybe Handle -> Maybe String -> IOError
annotateIOError ioe :: IOError
ioe loc :: String
loc hdl :: Maybe Handle
hdl path :: Maybe String
path =
IOError
ioe{ ioe_handle :: Maybe Handle
ioe_handle = Maybe Handle
hdl Maybe Handle -> Maybe Handle -> Maybe Handle
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` IOError -> Maybe Handle
ioe_handle IOError
ioe,
ioe_location :: String
ioe_location = String
loc, ioe_filename :: Maybe String
ioe_filename = Maybe String
path Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` IOError -> Maybe String
ioe_filename IOError
ioe }
catchIOError :: IO a -> (IOError -> IO a) -> IO a
catchIOError :: IO a -> (IOError -> IO a) -> IO a
catchIOError = IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch