    {-# LANGUAGE DeriveDataTypeable #-}

    -- | We use our own functions for throwing exceptions in order to get
    -- the actual error message via 'zmq_strerror'. 0MQ defines additional
    -- error numbers besides those defined by the operating system, so
    -- 'zmq_strerror' should be used in preference to 'strerror' which is
    -- used by the standard throw* functions in 'Foreign.C.Error'.
    --
    -- /Warning/: This is an internal module and subject
    -- to change without notice.
    module System.ZMQ4.Internal.Error where

    import Control.Applicative
    import Control.Monad
    import Control.Exception
    import Text.Printf
    import Data.Typeable (Typeable)

    import Foreign hiding (throwIf, throwIf_, void)
    import Foreign.C.Error
    import Foreign.C.String
    import Foreign.C.Types (CInt)
    import Prelude

    import System.ZMQ4.Internal.Base

    -- | ZMQError encapsulates information about errors, which occur
    -- when using the native 0MQ API, such as error number and message.
    data ZMQError = ZMQError
        { ZMQError -> Int
    errno   :: Int     -- ^ Error number value.
        , ZMQError -> String
    source  :: String  -- ^ Source where this error originates from.
        , ZMQError -> String
    message :: String  -- ^ Actual error message.
        } deriving (ZMQError -> ZMQError -> Bool
    (ZMQError -> ZMQError -> Bool)
    -> (ZMQError -> ZMQError -> Bool) -> Eq ZMQError
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ZMQError -> ZMQError -> Bool
    == :: ZMQError -> ZMQError -> Bool
    $c/= :: ZMQError -> ZMQError -> Bool
    /= :: ZMQError -> ZMQError -> Bool
    Eq, Eq ZMQError
    Eq ZMQError =>
    (ZMQError -> ZMQError -> Ordering)
    -> (ZMQError -> ZMQError -> Bool)
    -> (ZMQError -> ZMQError -> Bool)
    -> (ZMQError -> ZMQError -> Bool)
    -> (ZMQError -> ZMQError -> Bool)
    -> (ZMQError -> ZMQError -> ZMQError)
    -> (ZMQError -> ZMQError -> ZMQError)
    -> Ord ZMQError
    ZMQError -> ZMQError -> Bool
    ZMQError -> ZMQError -> Ordering
    ZMQError -> ZMQError -> ZMQError
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ZMQError -> ZMQError -> Ordering
    compare :: ZMQError -> ZMQError -> Ordering
    $c< :: ZMQError -> ZMQError -> Bool
    < :: ZMQError -> ZMQError -> Bool
    $c<= :: ZMQError -> ZMQError -> Bool
    <= :: ZMQError -> ZMQError -> Bool
    $c> :: ZMQError -> ZMQError -> Bool
    > :: ZMQError -> ZMQError -> Bool
    $c>= :: ZMQError -> ZMQError -> Bool
    >= :: ZMQError -> ZMQError -> Bool
    $cmax :: ZMQError -> ZMQError -> ZMQError
    max :: ZMQError -> ZMQError -> ZMQError
    $cmin :: ZMQError -> ZMQError -> ZMQError
    min :: ZMQError -> ZMQError -> ZMQError
    Ord, Typeable)

    instance Show ZMQError where
        show :: ZMQError -> String
    show ZMQError
    e = String -> Int -> String -> ShowS
    forall r. PrintfType r => String -> r
    printf String
    "ZMQError { errno = %d, source = \"%s\", message = \"%s\" }"
                    (ZMQError -> Int
    errno ZMQError
    e) (ZMQError -> String
    source ZMQError
    e) (ZMQError -> String
    message ZMQError
    e)

    instance Exception ZMQError

    throwError :: String -> IO a
    throwError :: forall a. String -> IO a
    throwError String
    src = do
        (Errno e) <- IO Errno
    zmqErrno
        msg       <- zmqErrnoMessage e
        throwIO $ ZMQError (fromIntegral e) src msg

    throwIf :: (a -> Bool) -> String -> IO a -> IO a
    throwIf :: forall a. (a -> Bool) -> String -> IO a -> IO a
    throwIf a -> Bool
    p String
    src IO a
    act = do
        r <- IO a
    act
        if p r then throwError src else return r

    throwIf_ :: (a -> Bool) -> String -> IO a -> IO ()
    throwIf_ :: forall a. (a -> Bool) -> String -> IO a -> IO ()
    throwIf_ a -> Bool
    p String
    src IO a
    act = 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
    $ (a -> Bool) -> String -> IO a -> IO a
    forall a. (a -> Bool) -> String -> IO a -> IO a
    throwIf a -> Bool
    p String
    src IO a
    act

    throwIfRetry :: (a -> Bool) -> String -> IO a -> IO a
    throwIfRetry :: forall a. (a -> Bool) -> String -> IO a -> IO a
    throwIfRetry a -> Bool
    p String
    src IO a
    act = do
        r <- IO a
    act
        if p r then zmqErrno >>= k else return r
      where
        k :: Errno -> IO a
    k Errno
    e | Errno
    e Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    eINTR = (a -> Bool) -> String -> IO a -> IO a
    forall a. (a -> Bool) -> String -> IO a -> IO a
    throwIfRetry a -> Bool
    p String
    src IO a
    act
            | Bool
    otherwise  = String -> IO a
    forall a. String -> IO a
    throwError String
    src

    throwIfRetry_ :: (a -> Bool) -> String -> IO a -> IO ()
    throwIfRetry_ :: forall a. (a -> Bool) -> String -> IO a -> IO ()
    throwIfRetry_ a -> Bool
    p String
    src IO a
    act = 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
    $ (a -> Bool) -> String -> IO a -> IO a
    forall a. (a -> Bool) -> String -> IO a -> IO a
    throwIfRetry a -> Bool
    p String
    src IO a
    act

    throwIfMinus1 :: (Eq a, Num a) => String -> IO a -> IO a
    throwIfMinus1 :: forall a. (Eq a, Num a) => String -> IO a -> IO a
    throwIfMinus1 = (a -> Bool) -> String -> IO a -> IO a
    forall a. (a -> Bool) -> String -> IO a -> IO a
    throwIf (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == -a
    1)

    throwIfMinus1_ :: (Eq a, Num a) => String -> IO a -> IO ()
    throwIfMinus1_ :: forall a. (Eq a, Num a) => String -> IO a -> IO ()
    throwIfMinus1_ = (a -> Bool) -> String -> IO a -> IO ()
    forall a. (a -> Bool) -> String -> IO a -> IO ()
    throwIf_ (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == -a
    1)

    throwIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
    throwIfNull :: forall a. String -> IO (Ptr a) -> IO (Ptr a)
    throwIfNull = (Ptr a -> Bool) -> String -> IO (Ptr a) -> IO (Ptr a)
    forall a. (a -> Bool) -> String -> IO a -> IO a
    throwIf (Ptr a -> Ptr a -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ptr a
    forall a. Ptr a
    nullPtr)

    throwIfMinus1Retry :: (Eq a, Num a) => String -> IO a -> IO a
    throwIfMinus1Retry :: forall a. (Eq a, Num a) => String -> IO a -> IO a
    throwIfMinus1Retry = (a -> Bool) -> String -> IO a -> IO a
    forall a. (a -> Bool) -> String -> IO a -> IO a
    throwIfRetry (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == -a
    1)

    throwIfMinus1Retry_ :: (Eq a, Num a) => String -> IO a -> IO ()
    throwIfMinus1Retry_ :: forall a. (Eq a, Num a) => String -> IO a -> IO ()
    throwIfMinus1Retry_ = (a -> Bool) -> String -> IO a -> IO ()
    forall a. (a -> Bool) -> String -> IO a -> IO ()
    throwIfRetry_ (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == -a
    1)

    throwIfRetryMayBlock :: (a -> Bool) -> String -> IO a -> IO b -> IO a
    throwIfRetryMayBlock :: forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO a
    throwIfRetryMayBlock a -> Bool
    p String
    src IO a
    f IO b
    on_block = do
        r <- IO a
    f
        if p r then zmqErrno >>= k else return r
      where
        k :: Errno -> IO a
    k Errno
    e | Errno
    e Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    eINTR                      = (a -> Bool) -> String -> IO a -> IO b -> IO a
    forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO a
    throwIfRetryMayBlock a -> Bool
    p String
    src IO a
    f IO b
    on_block
            | Errno
    e Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    eWOULDBLOCK Bool -> Bool -> Bool
    || Errno
    e Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    eAGAIN = IO b
    on_block IO b -> IO a -> IO a
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (a -> Bool) -> String -> IO a -> IO b -> IO a
    forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO a
    throwIfRetryMayBlock a -> Bool
    p String
    src IO a
    f IO b
    on_block
            | Bool
    otherwise                       = String -> IO a
    forall a. String -> IO a
    throwError String
    src

    throwIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()
    throwIfRetryMayBlock_ :: forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO ()
    throwIfRetryMayBlock_ a -> Bool
    p String
    src IO a
    f IO b
    on_block = 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
    $ (a -> Bool) -> String -> IO a -> IO b -> IO a
    forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO a
    throwIfRetryMayBlock a -> Bool
    p String
    src IO a
    f IO b
    on_block

    throwIfMinus1RetryMayBlock :: (Eq a, Num a) => String -> IO a -> IO b -> IO a
    throwIfMinus1RetryMayBlock :: forall a b. (Eq a, Num a) => String -> IO a -> IO b -> IO a
    throwIfMinus1RetryMayBlock = (a -> Bool) -> String -> IO a -> IO b -> IO a
    forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO a
    throwIfRetryMayBlock (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == -a
    1)

    throwIfMinus1RetryMayBlock_ :: (Eq a, Num a) => String -> IO a -> IO b -> IO ()
    throwIfMinus1RetryMayBlock_ :: forall a b. (Eq a, Num a) => String -> IO a -> IO b -> IO ()
    throwIfMinus1RetryMayBlock_ = (a -> Bool) -> String -> IO a -> IO b -> IO ()
    forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO ()
    throwIfRetryMayBlock_ (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == -a
    1)

    zmqErrnoMessage :: CInt -> IO String
    zmqErrnoMessage :: CInt -> IO String
    zmqErrnoMessage CInt
    e = CInt -> IO CString
    c_zmq_strerror CInt
    e IO CString -> (CString -> IO String) -> IO String
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= CString -> IO String
    peekCString

    zmqErrno :: IO Errno
    zmqErrno :: IO Errno
    zmqErrno = CInt -> Errno
    Errno (CInt -> Errno) -> IO CInt -> IO Errno
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO CInt
    c_zmq_errno