{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
----------------------------------------------------------------
--                                                    2021.10.17
-- |
-- Module      :  Foreign.C.Error.Safe
-- Copyright   :  2010--2022 wren romano
-- License     :  BSD-3-Clause
-- Maintainer  :  wren@cpan.org
-- Stability   :  provisional
-- Portability :  portable (H98+FFI)
--
-- Provides a variant of the "Foreign.C.Error" API which returns
-- errors explicitly, instead of throwing exceptions.
--
-- /Since: 0.3.5/
----------------------------------------------------------------
module Foreign.C.Error.Safe
    (
    -- * Primitive handlers
      eitherErrnoIf
    , eitherErrnoIfRetry
    , eitherErrnoIfRetryMayBlock
    -- * Derived handlers
    -- ** With predicate @(-1 ==)@
    , eitherErrnoIfMinus1
    , eitherErrnoIfMinus1Retry
    , eitherErrnoIfMinus1RetryMayBlock
    -- ** With predicate @(nullPtr ==)@
    , eitherErrnoIfNull
    , eitherErrnoIfNullRetry
    , eitherErrnoIfNullRetryMayBlock
    ) where

import qualified Foreign.C.Error as C
import qualified Foreign.Ptr     as FFI

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

-- | A variant of 'C.throwErrnoIf' which returns @Either@ instead
-- of throwing an errno error.
eitherErrnoIf
    :: (a -> Bool)  -- ^ Predicate to apply to the result value of
                    --   the @IO@ operation.
    -> IO a         -- ^ The @IO@ operation to be executed.
    -> IO (Either C.Errno a)
eitherErrnoIf :: forall a. (a -> Bool) -> IO a -> IO (Either Errno a)
eitherErrnoIf a -> Bool
p IO a
io = do
    a
a <- IO a
io
    if a -> Bool
p a
a
        then do
            Errno
errno <- IO Errno
C.getErrno
            Either Errno a -> IO (Either Errno a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Errno -> Either Errno a
forall a b. a -> Either a b
Left Errno
errno)
        else Either Errno a -> IO (Either Errno a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either Errno a
forall a b. b -> Either a b
Right a
a)


-- | A variant of 'C.throwErrnoIfRetry' which returns @Either@
-- instead of throwing an errno error.
eitherErrnoIfRetry
    :: (a -> Bool)  -- ^ Predicate to apply to the result value of
                    --   the @IO@ operation.
    -> IO a         -- ^ The @IO@ operation to be executed.
    -> IO (Either C.Errno a)
eitherErrnoIfRetry :: forall a. (a -> Bool) -> IO a -> IO (Either Errno a)
eitherErrnoIfRetry a -> Bool
p IO a
io = IO (Either Errno a)
loop
    where
    loop :: IO (Either Errno a)
loop = do
        a
a <- IO a
io
        if a -> Bool
p a
a
            then do
                Errno
errno <- IO Errno
C.getErrno
                if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
C.eINTR
                    then IO (Either Errno a)
loop
                    else Either Errno a -> IO (Either Errno a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Errno -> Either Errno a
forall a b. a -> Either a b
Left Errno
errno)
            else Either Errno a -> IO (Either Errno a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either Errno a
forall a b. b -> Either a b
Right a
a)


-- | A variant of 'C.throwErrnoIfRetryMayBlock' which returns
-- @Either@ instead of throwing an errno error.
eitherErrnoIfRetryMayBlock
    :: (a -> Bool)  -- ^ Predicate to apply to the result value of
                    --   the @IO@ operation.
    -> IO a         -- ^ The @IO@ operation to be executed.
    -> IO b         -- ^ Action to execute before retrying if an
                    --   immediate retry would block.
    -> IO (Either C.Errno a)
eitherErrnoIfRetryMayBlock :: forall a b. (a -> Bool) -> IO a -> IO b -> IO (Either Errno a)
eitherErrnoIfRetryMayBlock a -> Bool
p IO a
f IO b
on_block = IO (Either Errno a)
loop
    where
    loop :: IO (Either Errno a)
loop = do
        a
a <- IO a
f
        if a -> Bool
p a
a
            then do
                Errno
errno <- IO Errno
C.getErrno
                if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
C.eINTR
                    then IO (Either Errno a)
loop
                    else if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
C.eWOULDBLOCK Bool -> Bool -> Bool
|| Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
C.eAGAIN
                         then IO b
on_block IO b -> IO (Either Errno a) -> IO (Either Errno a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Either Errno a)
loop
                         else Either Errno a -> IO (Either Errno a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Errno -> Either Errno a
forall a b. a -> Either a b
Left Errno
errno)
            else Either Errno a -> IO (Either Errno a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either Errno a
forall a b. b -> Either a b
Right a
a)

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

eitherErrnoIfMinus1 :: (Eq a, Num a) => IO a -> IO (Either C.Errno a)
eitherErrnoIfMinus1 :: forall a. (Eq a, Num a) => IO a -> IO (Either Errno a)
eitherErrnoIfMinus1 = (a -> Bool) -> IO a -> IO (Either Errno a)
forall a. (a -> Bool) -> IO a -> IO (Either Errno a)
eitherErrnoIf (-a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)

eitherErrnoIfMinus1Retry :: (Eq a, Num a) => IO a -> IO (Either C.Errno a)
eitherErrnoIfMinus1Retry :: forall a. (Eq a, Num a) => IO a -> IO (Either Errno a)
eitherErrnoIfMinus1Retry = (a -> Bool) -> IO a -> IO (Either Errno a)
forall a. (a -> Bool) -> IO a -> IO (Either Errno a)
eitherErrnoIfRetry (-a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)

eitherErrnoIfMinus1RetryMayBlock
    :: (Eq a, Num a) => IO a -> IO b -> IO (Either C.Errno a)
eitherErrnoIfMinus1RetryMayBlock :: forall a b. (Eq a, Num a) => IO a -> IO b -> IO (Either Errno a)
eitherErrnoIfMinus1RetryMayBlock =
    (a -> Bool) -> IO a -> IO b -> IO (Either Errno a)
forall a b. (a -> Bool) -> IO a -> IO b -> IO (Either Errno a)
eitherErrnoIfRetryMayBlock (-a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)


eitherErrnoIfNull :: IO (FFI.Ptr a) -> IO (Either C.Errno (FFI.Ptr a))
eitherErrnoIfNull :: forall a. IO (Ptr a) -> IO (Either Errno (Ptr a))
eitherErrnoIfNull = (Ptr a -> Bool) -> IO (Ptr a) -> IO (Either Errno (Ptr a))
forall a. (a -> Bool) -> IO a -> IO (Either Errno a)
eitherErrnoIf (Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
FFI.nullPtr)

eitherErrnoIfNullRetry :: IO (FFI.Ptr a) -> IO (Either C.Errno (FFI.Ptr a))
eitherErrnoIfNullRetry :: forall a. IO (Ptr a) -> IO (Either Errno (Ptr a))
eitherErrnoIfNullRetry = (Ptr a -> Bool) -> IO (Ptr a) -> IO (Either Errno (Ptr a))
forall a. (a -> Bool) -> IO a -> IO (Either Errno a)
eitherErrnoIfRetry (Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
FFI.nullPtr)

eitherErrnoIfNullRetryMayBlock
    :: IO (FFI.Ptr a) -> IO b -> IO (Either C.Errno (FFI.Ptr a))
eitherErrnoIfNullRetryMayBlock :: forall a b. IO (Ptr a) -> IO b -> IO (Either Errno (Ptr a))
eitherErrnoIfNullRetryMayBlock =
    (Ptr a -> Bool) -> IO (Ptr a) -> IO b -> IO (Either Errno (Ptr a))
forall a b. (a -> Bool) -> IO a -> IO b -> IO (Either Errno a)
eitherErrnoIfRetryMayBlock (Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
FFI.nullPtr)

----------------------------------------------------------------
----------------------------------------------------------- fin.