{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude #-}
module Foreign.Marshal.Error (
throwIf,
throwIf_,
throwIfNeg,
throwIfNeg_,
throwIfNull,
void
) where
import Foreign.Ptr
import GHC.Base
import GHC.Num
import GHC.IO.Exception
throwIf :: (a -> Bool)
-> (a -> String)
-> IO a
-> IO a
throwIf :: forall a. (a -> Bool) -> (a -> String) -> IO a -> IO a
throwIf a -> Bool
pred a -> String
msgfct IO a
act =
do
a
res <- IO a
act
(if a -> Bool
pred a
res then forall a. IOError -> IO a
ioError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
msgfct else forall (m :: * -> *) a. Monad m => a -> m a
return) a
res
throwIf_ :: (a -> Bool) -> (a -> String) -> IO a -> IO ()
throwIf_ :: forall a. (a -> Bool) -> (a -> String) -> IO a -> IO ()
throwIf_ a -> Bool
pred a -> String
msgfct IO a
act = forall a. IO a -> IO ()
void forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> (a -> String) -> IO a -> IO a
throwIf a -> Bool
pred a -> String
msgfct IO a
act
throwIfNeg :: (Ord a, Num a) => (a -> String) -> IO a -> IO a
throwIfNeg :: forall a. (Ord a, Num a) => (a -> String) -> IO a -> IO a
throwIfNeg = forall a. (a -> Bool) -> (a -> String) -> IO a -> IO a
throwIf (forall a. Ord a => a -> a -> Bool
< a
0)
throwIfNeg_ :: (Ord a, Num a) => (a -> String) -> IO a -> IO ()
throwIfNeg_ :: forall a. (Ord a, Num a) => (a -> String) -> IO a -> IO ()
throwIfNeg_ = forall a. (a -> Bool) -> (a -> String) -> IO a -> IO ()
throwIf_ (forall a. Ord a => a -> a -> Bool
< a
0)
throwIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull :: forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull = forall a. (a -> Bool) -> (a -> String) -> IO a -> IO a
throwIf (forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
void :: IO a -> IO ()
void :: forall a. IO a -> IO ()
void IO a
act = IO a
act forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# DEPRECATED void "use 'Control.Monad.void' instead" #-}