(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),
[isResourceVanishedError](System.IO.Error.html#isResourceVanishedError),


[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),
[resourceVanishedErrorType](System.IO.Error.html#resourceVanishedErrorType),


[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),
[isResourceVanishedErrorType](System.IO.Error.html#isResourceVanishedErrorType),


[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 :: forall a. IO a -> IO (Either IOError a) tryIOError 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 IOErrorType t String location Maybe Handle maybe_hdl Maybe String maybe_filename = IOError{ ioe_type :: IOErrorType ioe_type = IOErrorType t, ioe_location :: String ioe_location = String location, ioe_description :: String ioe_description = String "", 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

isResourceVanishedError :: IOError -> Bool isResourceVanishedError :: IOError -> Bool isResourceVanishedError = IOErrorType -> Bool isResourceVanishedErrorType (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

resourceVanishedErrorType :: IOErrorType resourceVanishedErrorType :: IOErrorType resourceVanishedErrorType = IOErrorType ResourceVanished

isAlreadyExistsErrorType :: IOErrorType -> Bool isAlreadyExistsErrorType :: IOErrorType -> Bool isAlreadyExistsErrorType IOErrorType AlreadyExists = Bool True isAlreadyExistsErrorType IOErrorType _ = Bool False

isDoesNotExistErrorType :: IOErrorType -> Bool isDoesNotExistErrorType :: IOErrorType -> Bool isDoesNotExistErrorType IOErrorType NoSuchThing = Bool True isDoesNotExistErrorType IOErrorType _ = Bool False

isAlreadyInUseErrorType :: IOErrorType -> Bool isAlreadyInUseErrorType :: IOErrorType -> Bool isAlreadyInUseErrorType IOErrorType ResourceBusy = Bool True isAlreadyInUseErrorType IOErrorType _ = Bool False

isFullErrorType :: IOErrorType -> Bool isFullErrorType :: IOErrorType -> Bool isFullErrorType IOErrorType ResourceExhausted = Bool True isFullErrorType IOErrorType _ = Bool False

isEOFErrorType :: IOErrorType -> Bool isEOFErrorType :: IOErrorType -> Bool isEOFErrorType IOErrorType EOF = Bool True isEOFErrorType IOErrorType _ = Bool False

isIllegalOperationErrorType :: IOErrorType -> Bool isIllegalOperationErrorType :: IOErrorType -> Bool isIllegalOperationErrorType IOErrorType IllegalOperation = Bool True isIllegalOperationErrorType IOErrorType _ = Bool False

isPermissionErrorType :: IOErrorType -> Bool isPermissionErrorType :: IOErrorType -> Bool isPermissionErrorType IOErrorType PermissionDenied = Bool True isPermissionErrorType IOErrorType _ = Bool False

isUserErrorType :: IOErrorType -> Bool isUserErrorType :: IOErrorType -> Bool isUserErrorType IOErrorType UserError = Bool True isUserErrorType IOErrorType _ = Bool False

isResourceVanishedErrorType :: IOErrorType -> Bool isResourceVanishedErrorType :: IOErrorType -> Bool isResourceVanishedErrorType IOErrorType ResourceVanished = Bool True isResourceVanishedErrorType IOErrorType _ = Bool False

ioeGetErrorType :: IOError -> IOErrorType ioeGetErrorString :: IOError -> String ioeGetLocation :: IOError -> String ioeGetHandle :: IOError -> Maybe Handle ioeGetFileName :: IOError -> Maybe FilePath

ioeGetErrorType :: IOError -> IOErrorType ioeGetErrorType IOError ioe = IOError -> IOErrorType ioe_type IOError ioe

ioeGetErrorString :: IOError -> String ioeGetErrorString 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 IOError ioe = IOError -> String ioe_location IOError ioe

ioeGetHandle :: IOError -> Maybe Handle ioeGetHandle IOError ioe = IOError -> Maybe Handle ioe_handle IOError ioe

ioeGetFileName :: IOError -> Maybe String ioeGetFileName 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 IOError ioe IOErrorType errtype = IOError ioe{ ioe_type :: IOErrorType ioe_type = IOErrorType errtype } ioeSetErrorString :: IOError -> String -> IOError ioeSetErrorString IOError ioe String str = IOError ioe{ ioe_description :: String ioe_description = String str } ioeSetLocation :: IOError -> String -> IOError ioeSetLocation IOError ioe String str = IOError ioe{ ioe_location :: String ioe_location = String str } ioeSetHandle :: IOError -> Handle -> IOError ioeSetHandle IOError ioe 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 IOError ioe 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 :: forall a. (IOError -> IOError) -> IO a -> IO a modifyIOError IOError -> IOError f 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 (\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 IOError ioe String loc Maybe Handle hdl 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 :: forall a. 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