{-|
Module      : Z.IO.Exception
Description : Extensible IO exceptions
Copyright   : (c) Dong Han, 2017-2018
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module implemented extensible io exception following approach described in /An Extensible Dynamically-Typed
Hierarchy of Exceptions/ by Simon Marlow. The implementation in this module has simplified to meet common need.
User who want to catch certain type of exceptions can directly use exception types this module provide,
which are modeled after @IOErrorType@ from "GHC.IO.Exception".


Functions from this package will throw exceptions from this module only instead of the old 'IOError' on IO exceptions.
Exceptions from this module contain 'IOEInfo' which is pretty detailed, but this also require user of this module
do some extra work to keep error message's quality(provide CallStack, device informations, etc.).
New defined IO exceptions are encouraged to include a 'IOEInfo', since it helps a lot when debugging.

Example for library author defining new io exception:

@
  data MyNetworkException = MyNetworkException IOEInfo ... deriving Show
  instance Exception MyNetworkException where
        toException = ioExceptionToException
        fromException = ioExceptionFromException
@

If you're dealing with OS's errno directly, you should convert the errno to libuv's errno in C side with
'uv_translate_sys_error' from @hs_uv.h@, then use 'throwUVIfMinus\/throwUVError' from this module.

-}

module Z.IO.Exception
  ( -- * The 'SomeIOException' type
    SomeIOException(..)
  , ioExceptionToException
  , ioExceptionFromException
    -- * Builtin io exception types
  , IOEInfo(..)
  , AlreadyExists(..)
  , NoSuchThing(..)
  , ResourceBusy(..)
  , ResourceExhausted(..)
  , UnexpectedEOF(..)
  , IllegalOperation(..)
  , PermissionDenied(..)
  , UnsatisfiedConstraints(..)
  , SystemError(..)
  , ProtocolError(..)
  , OtherError(..)
  , InvalidArgument(..)
  , InappropriateType(..)
  , HardwareFault(..)
  , UnsupportedOperation(..)
  , TimeExpired(..)
  , ResourceVanished(..)
  , Interrupted(..)
    -- * Throw io exceptions
  , throwOOMIfNull
  , throwUVIfMinus
  , throwUVIfMinus_
  , throwUVIf
  , throwUVIf_
  , throwUV
  , throwECLOSED
  , throwECLOSEDSTM
  , throwUVError
  , throwOtherError
  , unwrap
  , unwrap'
    -- * Sync exception tools
  , catchSync
  , ignoreSync
    -- * Re-exports
  , module Control.Exception
  , HasCallStack
  , CallStack
  , callStack
  , module Z.IO.UV.Errno
  ) where

import           Control.Concurrent.STM
import           Control.Exception      hiding (IOException)
import           Control.Monad
import           Data.Typeable          (cast)
import           Foreign.C.Types
import           Foreign.Ptr
import           GHC.Stack
import qualified Z.Data.Text            as T
import qualified Z.Data.Text.Print      as T
import           Z.IO.UV.Errno


-- | The root type of all io exceptions, you can catch all io exception by catching this root type.
--
data SomeIOException = forall e . Exception e => SomeIOException e

instance Show SomeIOException where
    show :: SomeIOException -> String
show (SomeIOException e
e) = e -> String
forall a. Show a => a -> String
show e
e

instance Exception SomeIOException

ioExceptionToException :: Exception e => e -> SomeException
ioExceptionToException :: e -> SomeException
ioExceptionToException = SomeIOException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeIOException -> SomeException)
-> (e -> SomeIOException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeIOException
forall e. Exception e => e -> SomeIOException
SomeIOException

ioExceptionFromException :: Exception e => SomeException -> Maybe e
ioExceptionFromException :: SomeException -> Maybe e
ioExceptionFromException SomeException
x = do
    SomeIOException e
a <- SomeException -> Maybe SomeIOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

#define IOE(e) data e = e IOEInfo deriving (Show);  \
               instance Exception e where                     \
                   { toException = ioExceptionToException     \
                   ; fromException = ioExceptionFromException \
                   }
IOE(AlreadyExists)
IOE(NoSuchThing)
IOE(ResourceBusy)
IOE(ResourceExhausted)
IOE(UnexpectedEOF)
IOE(IllegalOperation)
IOE(PermissionDenied)
IOE(UnsatisfiedConstraints)
IOE(SystemError)
IOE(ProtocolError)
IOE(OtherError)
IOE(InvalidArgument)
IOE(InappropriateType)
IOE(HardwareFault)
IOE(UnsupportedOperation)
IOE(TimeExpired)
IOE(ResourceVanished)
IOE(Interrupted)

--------------------------------------------------------------------------------

-- | Throw 'ResourceExhausted' if allocation return a 'nullPtr'.
--
throwOOMIfNull :: HasCallStack
               => IO (Ptr a)    -- ^ the allocation action
               -> IO (Ptr a)
{-# INLINABLE throwOOMIfNull #-}
throwOOMIfNull :: IO (Ptr a) -> IO (Ptr a)
throwOOMIfNull IO (Ptr a)
f = do
    Ptr a
addr <- IO (Ptr a)
f
    if Ptr a
addr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr
        then ResourceExhausted -> IO (Ptr a)
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted (Text -> Text -> CallStack -> IOEInfo
IOEInfo Text
"OOM" Text
"out of memory when doing allocation" CallStack
HasCallStack => CallStack
callStack))
        else Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
addr

-- | Throw appropriate IO exception if return value < 0 (libuv's convention).
{-# INLINABLE throwUVIfMinus #-}
throwUVIfMinus :: (HasCallStack, Integral a)
               => IO a    -- ^ the IO action
               -> IO a
throwUVIfMinus :: IO a -> IO a
throwUVIfMinus IO a
f = IO a -> (a -> Bool) -> IO a
forall a. (HasCallStack, Integral a) => IO a -> (a -> Bool) -> IO a
throwUVIf IO a
f (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0)

-- | Throw appropriate IO exception if return value < 0, otherwise ignore the result.
{-# INLINABLE throwUVIfMinus_ #-}
throwUVIfMinus_ :: (HasCallStack, Integral a)
                => IO a    -- ^ the IO action
                -> IO ()
throwUVIfMinus_ :: IO a -> IO ()
throwUVIfMinus_ IO a
f = IO a -> (a -> Bool) -> IO ()
forall a.
(HasCallStack, Integral a) =>
IO a -> (a -> Bool) -> IO ()
throwUVIf_ IO a
f (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0)

-- | Throw appropriate IO exception if condition is true.
throwUVIf :: (HasCallStack, Integral a) => IO a -> (a -> Bool) -> IO a
{-# INLINABLE throwUVIf #-}
throwUVIf :: IO a -> (a -> Bool) -> IO a
throwUVIf IO a
f a -> Bool
cond = do
    a
errno <- IO a
f
    if a -> Bool
cond a
errno
       then a -> IO a
forall a b. (Integral a, HasCallStack) => a -> IO b
throwUV a
errno
       else a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
errno

-- | Throw appropriate IO exception if condition is true, otherwise ignore the
-- result.
throwUVIf_ :: (HasCallStack, Integral a) => IO a -> (a -> Bool) -> IO ()
{-# INLINABLE throwUVIf_ #-}
throwUVIf_ :: IO a -> (a -> Bool) -> IO ()
throwUVIf_ IO a
f a -> Bool
cond = IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ IO a -> (a -> Bool) -> IO a
forall a. (HasCallStack, Integral a) => IO a -> (a -> Bool) -> IO a
throwUVIf IO a
f a -> Bool
cond

-- | Throw 'ResourceVanished' with name 'ECLOSED' and description 'resource is closed'.
throwECLOSED :: HasCallStack => IO a
{-# INLINABLE throwECLOSED #-}
throwECLOSED :: IO a
throwECLOSED = ResourceVanished -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceVanished
ResourceVanished
    (Text -> Text -> CallStack -> IOEInfo
IOEInfo Text
"ECLOSED" Text
"resource is closed" CallStack
HasCallStack => CallStack
callStack))

-- | STM version of 'throwECLOSED'.
throwECLOSEDSTM :: HasCallStack => STM a
{-# INLINABLE throwECLOSEDSTM #-}
throwECLOSEDSTM :: STM a
throwECLOSEDSTM = ResourceVanished -> STM a
forall e a. Exception e => e -> STM a
throwSTM (IOEInfo -> ResourceVanished
ResourceVanished
    (Text -> Text -> CallStack -> IOEInfo
IOEInfo Text
"ECLOSED" Text
"resource is closed" CallStack
HasCallStack => CallStack
callStack))

-- | Throw 'OtherError' with custom name and description.
throwOtherError :: HasCallStack => T.Text -> T.Text -> IO a
{-# INLINABLE throwOtherError #-}
throwOtherError :: Text -> Text -> IO a
throwOtherError Text
name Text
desc = OtherError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> OtherError
OtherError (Text -> Text -> CallStack -> IOEInfo
IOEInfo Text
name Text
desc CallStack
HasCallStack => CallStack
callStack))

--------------------------------------------------------------------------------

-- | Try to unwrap a value from 'Right', throw @OtherError name desc@ with @desc == toText e@ if 'Left e'.
unwrap :: (HasCallStack, T.Print e) => T.Text -> Either e a -> IO a
{-# INLINABLE unwrap #-}
unwrap :: Text -> Either e a -> IO a
unwrap Text
_ (Right a
x) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
unwrap Text
n (Left e
e)  = Text -> Text -> IO a
forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
n (e -> Text
forall a. Print a => a -> Text
T.toText e
e)

-- | Try to unwrap a value from 'Just', throw @OtherError name desc@ if 'Nothing'.
unwrap' :: HasCallStack => T.Text -> T.Text -> Maybe a -> IO a
{-# INLINABLE unwrap' #-}
unwrap' :: Text -> Text -> Maybe a -> IO a
unwrap' Text
_ Text
_ (Just a
x) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
unwrap' Text
n Text
d Maybe a
Nothing  = Text -> Text -> IO a
forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
n Text
d

-- | Check if the given exception is synchronous
--
isSyncException :: Exception e => e -> Bool
isSyncException :: e -> Bool
isSyncException e
e =
    case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e) of
        Just (SomeAsyncException e
_) -> Bool
False
        Maybe SomeAsyncException
Nothing -> Bool
True

-- | Same as upstream 'C.catch', but will not catch asynchronous exceptions
--
catchSync :: Exception e => IO a -> (e -> IO a) -> IO a
catchSync :: IO a -> (e -> IO a) -> IO a
catchSync IO a
f e -> IO a
g = IO a
f IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \ e
e ->
    if e -> Bool
forall e. Exception e => e -> Bool
isSyncException e
e then e -> IO a
g e
e else e -> IO a
forall e a. Exception e => e -> IO a
throwIO e
e

-- | Ingore all synchronous exceptions.
--
ignoreSync :: IO a -> IO ()
ignoreSync :: IO a -> IO ()
ignoreSync IO a
f = IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catchSync (IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO a
f) (\ (SomeException
_ :: SomeException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

--------------------------------------------------------------------------------

-- | IO exceptions informations.
--
data IOEInfo = IOEInfo
    { IOEInfo -> Text
ioeName        :: T.Text      -- ^ the errno name, e.g. EADDRINUSE, etc. empty if no errno.
    , IOEInfo -> Text
ioeDescription :: T.Text      -- ^ description for this io error, can be errno description, or some custom description if no errno.
    , IOEInfo -> CallStack
ioeCallStack   :: CallStack   -- ^ lightweight partial call-stack
    }

instance Show IOEInfo where show :: IOEInfo -> String
show = IOEInfo -> String
forall a. Print a => a -> String
T.toString

instance T.Print IOEInfo where
    toUTF8BuilderP :: Int -> IOEInfo -> Builder ()
toUTF8BuilderP Int
_ (IOEInfo Text
errno Text
desc CallStack
cstack) = do
         Builder ()
"{name:"
         Text -> Builder ()
T.text Text
errno
         Builder ()
", description:"
         Text -> Builder ()
T.text Text
desc
         Builder ()
", callstack:"
         String -> Builder ()
T.stringUTF8 (CallStack -> String
prettyCallStack CallStack
cstack)
         Builder ()
"}"

-- | Throw a UV Exception with given libuv's errno.
throwUV :: (Integral a, HasCallStack) => a -> IO b
{-# INLINABLE throwUV #-}
throwUV :: a -> IO b
throwUV a
e = do
    let e' :: CInt
e' = a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
e
    Text
name <- CInt -> IO Text
uvErrName CInt
e'
    Text
desc <- CInt -> IO Text
uvStdError CInt
e'
    CInt -> IOEInfo -> IO b
forall a. CInt -> IOEInfo -> IO a
throwUVError CInt
e' (Text -> Text -> CallStack -> IOEInfo
IOEInfo Text
name Text
desc CallStack
HasCallStack => CallStack
callStack)

throwUVError :: CInt -> IOEInfo -> IO a
{-# INLINABLE throwUVError #-}
throwUVError :: CInt -> IOEInfo -> IO a
throwUVError CInt
e IOEInfo
info = case CInt
e of
    CInt
UV_EOF             -> UnexpectedEOF -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnexpectedEOF
UnexpectedEOF           IOEInfo
info)
    CInt
UV_E2BIG           -> ResourceExhausted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted       IOEInfo
info)
    CInt
UV_EACCES          -> PermissionDenied -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> PermissionDenied
PermissionDenied        IOEInfo
info)
    CInt
UV_EADDRINUSE      -> ResourceBusy -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceBusy
ResourceBusy            IOEInfo
info)
    CInt
UV_EADDRNOTAVAIL   -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_EAFNOSUPPORT    -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_EAGAIN          -> ResourceExhausted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted       IOEInfo
info)
    CInt
UV_EAI_ADDRFAMILY  -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_EAI_AGAIN       -> ResourceExhausted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted       IOEInfo
info)
    CInt
UV_EAI_BADFLAGS    -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_EAI_BADHINTS    -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_EAI_CANCELED    -> ResourceVanished -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceVanished
ResourceVanished        IOEInfo
info)
    CInt
UV_EAI_FAIL        -> OtherError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> OtherError
OtherError              IOEInfo
info)
    CInt
UV_EAI_FAMILY      -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_EAI_MEMORY      -> ResourceExhausted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted       IOEInfo
info)
    CInt
UV_EAI_NODATA      -> NoSuchThing -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> NoSuchThing
NoSuchThing             IOEInfo
info)
    CInt
UV_EAI_NONAME      -> NoSuchThing -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> NoSuchThing
NoSuchThing             IOEInfo
info)
    CInt
UV_EAI_OVERFLOW    -> InvalidArgument -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InvalidArgument
InvalidArgument         IOEInfo
info)
    CInt
UV_EAI_PROTOCOL    -> ProtocolError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ProtocolError
ProtocolError           IOEInfo
info)
    CInt
UV_EAI_SERVICE     -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_EAI_SOCKTYPE    -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_EALREADY        -> AlreadyExists -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> AlreadyExists
AlreadyExists           IOEInfo
info)
    CInt
UV_EBADF           -> InvalidArgument -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InvalidArgument
InvalidArgument         IOEInfo
info)
    CInt
UV_EBUSY           -> ResourceBusy -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceBusy
ResourceBusy            IOEInfo
info)
    CInt
UV_ECANCELED       -> ResourceVanished -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceVanished
ResourceVanished        IOEInfo
info)
    CInt
UV_ECHARSET        -> OtherError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> OtherError
OtherError              IOEInfo
info)
    CInt
UV_ECONNABORTED    -> ResourceVanished -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceVanished
ResourceVanished        IOEInfo
info)
    CInt
UV_ECONNREFUSED    -> NoSuchThing -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> NoSuchThing
NoSuchThing             IOEInfo
info)
    CInt
UV_ECONNRESET      -> ResourceVanished -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceVanished
ResourceVanished        IOEInfo
info)
    CInt
UV_EDESTADDRREQ    -> InvalidArgument -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InvalidArgument
InvalidArgument         IOEInfo
info)
    CInt
UV_EEXIST          -> AlreadyExists -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> AlreadyExists
AlreadyExists           IOEInfo
info)
    CInt
UV_EFAULT          -> OtherError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> OtherError
OtherError              IOEInfo
info)
    CInt
UV_EFBIG           -> PermissionDenied -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> PermissionDenied
PermissionDenied        IOEInfo
info)
    CInt
UV_EHOSTUNREACH    -> NoSuchThing -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> NoSuchThing
NoSuchThing             IOEInfo
info)
    CInt
UV_EINTR           -> Interrupted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> Interrupted
Interrupted             IOEInfo
info)
    CInt
UV_EINVAL          -> InvalidArgument -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InvalidArgument
InvalidArgument         IOEInfo
info)
    CInt
UV_EIO             -> HardwareFault -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> HardwareFault
HardwareFault           IOEInfo
info)
    CInt
UV_EISCONN         -> AlreadyExists -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> AlreadyExists
AlreadyExists           IOEInfo
info)
    CInt
UV_EISDIR          -> InappropriateType -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InappropriateType
InappropriateType       IOEInfo
info)
    CInt
UV_ELOOP           -> InvalidArgument -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InvalidArgument
InvalidArgument         IOEInfo
info)
    CInt
UV_EMFILE          -> ResourceExhausted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted       IOEInfo
info)
    CInt
UV_EMSGSIZE        -> InvalidArgument -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InvalidArgument
InvalidArgument         IOEInfo
info)
    CInt
UV_ENAMETOOLONG    -> InvalidArgument -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InvalidArgument
InvalidArgument         IOEInfo
info)
    CInt
UV_ENETDOWN        -> ResourceVanished -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceVanished
ResourceVanished        IOEInfo
info)
    CInt
UV_ENETUNREACH     -> NoSuchThing -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> NoSuchThing
NoSuchThing             IOEInfo
info)
    CInt
UV_ENFILE          -> ResourceExhausted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted       IOEInfo
info)
    CInt
UV_ENOBUFS         -> ResourceExhausted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted       IOEInfo
info)
    CInt
UV_ENODEV          -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_ENOENT          -> NoSuchThing -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> NoSuchThing
NoSuchThing             IOEInfo
info)
    CInt
UV_ENOMEM          -> ResourceExhausted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted       IOEInfo
info)
    CInt
UV_ENOPROTOOPT     -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_ENOSPC          -> ResourceExhausted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted       IOEInfo
info)
    CInt
UV_ENOSYS          -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_ENOTCONN        -> InvalidArgument -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InvalidArgument
InvalidArgument         IOEInfo
info)
    CInt
UV_ENOTDIR         -> InappropriateType -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InappropriateType
InappropriateType       IOEInfo
info)
    CInt
UV_ENOTEMPTY       -> UnsatisfiedConstraints -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsatisfiedConstraints
UnsatisfiedConstraints  IOEInfo
info)
    CInt
UV_ENOTSOCK        -> InvalidArgument -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> InvalidArgument
InvalidArgument         IOEInfo
info)
    CInt
UV_ENOTSUP         -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_EPERM           -> PermissionDenied -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> PermissionDenied
PermissionDenied        IOEInfo
info)
    CInt
UV_EPIPE           -> ResourceVanished -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceVanished
ResourceVanished        IOEInfo
info)
    CInt
UV_EPROTO          -> ProtocolError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ProtocolError
ProtocolError           IOEInfo
info)
    CInt
UV_EPROTONOSUPPORT -> ProtocolError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ProtocolError
ProtocolError           IOEInfo
info)
    CInt
UV_EPROTOTYPE      -> ProtocolError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ProtocolError
ProtocolError           IOEInfo
info)
    CInt
UV_ERANGE          -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_EROFS           -> PermissionDenied -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> PermissionDenied
PermissionDenied        IOEInfo
info)
    CInt
UV_ESHUTDOWN       -> IllegalOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> IllegalOperation
IllegalOperation        IOEInfo
info)
    CInt
UV_ESPIPE          -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_ESRCH           -> NoSuchThing -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> NoSuchThing
NoSuchThing             IOEInfo
info)
    CInt
UV_ETIMEDOUT       -> TimeExpired -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> TimeExpired
TimeExpired             IOEInfo
info)
    CInt
UV_ETXTBSY         -> ResourceBusy -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceBusy
ResourceBusy            IOEInfo
info)
    CInt
UV_EXDEV           -> UnsupportedOperation -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> UnsupportedOperation
UnsupportedOperation    IOEInfo
info)
    CInt
UV_UNKNOWN         -> OtherError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> OtherError
OtherError              IOEInfo
info)
    CInt
UV_ENXIO           -> NoSuchThing -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> NoSuchThing
NoSuchThing             IOEInfo
info)
    CInt
UV_EMLINK          -> ResourceExhausted -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ResourceExhausted
ResourceExhausted       IOEInfo
info)
    CInt
_                  -> OtherError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> OtherError
OtherError              IOEInfo
info)