{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Foreign.Marshal.Error
-- Copyright   :  (c) The FFI task force 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  ffi@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Routines for testing return values and raising a 'userError' exception
-- in case of values indicating an error state.
--
-----------------------------------------------------------------------------

module Foreign.Marshal.Error (
  throwIf,
  throwIf_,
  throwIfNeg,
  throwIfNeg_,
  throwIfNull,

  -- Discard return value
  --
  void
) where

import Foreign.Ptr

import GHC.Base
import GHC.Num
import GHC.IO.Exception

-- exported functions
-- ------------------

-- |Execute an 'IO' action, throwing a 'userError' if the predicate yields
-- 'True' when applied to the result returned by the 'IO' action.
-- If no exception is raised, return the result of the computation.
--
throwIf :: (a -> Bool)  -- ^ error condition on the result of the 'IO' action
        -> (a -> String) -- ^ computes an error message from erroneous results
                        -- of the 'IO' action
        -> IO a         -- ^ the 'IO' action to be executed
        -> 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 IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> (a -> IOError) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IOError) -> (a -> String) -> a -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
msgfct else a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) a
res

-- |Like 'throwIf', but discarding the result
--
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  = IO a -> IO ()
forall a. IO a -> IO ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> (a -> String) -> IO a -> IO a
forall a. (a -> Bool) -> (a -> String) -> IO a -> IO a
throwIf a -> Bool
pred a -> String
msgfct IO a
act

-- |Guards against negative result values
--
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  = (a -> Bool) -> (a -> String) -> IO a -> IO a
forall a. (a -> Bool) -> (a -> String) -> IO a -> IO a
throwIf (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0)

-- |Like 'throwIfNeg', but discarding the result
--
throwIfNeg_ :: (Ord a, Num a) => (a -> String) -> IO a -> IO ()
throwIfNeg_ :: forall a. (Ord a, Num a) => (a -> String) -> IO a -> IO ()
throwIfNeg_  = (a -> Bool) -> (a -> String) -> IO a -> IO ()
forall a. (a -> Bool) -> (a -> String) -> IO a -> IO ()
throwIf_ (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0)

-- |Guards against null pointers
--
throwIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull :: forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull  = (Ptr a -> Bool) -> (Ptr a -> String) -> IO (Ptr a) -> IO (Ptr a)
forall a. (a -> Bool) -> (a -> 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) ((Ptr a -> String) -> IO (Ptr a) -> IO (Ptr a))
-> (String -> Ptr a -> String)
-> String
-> IO (Ptr a)
-> IO (Ptr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Ptr a -> String
forall a b. a -> b -> a
const

-- |Discard the return value of an 'IO' action
--
void     :: IO a -> IO ()
void :: forall a. IO a -> IO ()
void IO a
act  = IO a
act IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# DEPRECATED void "use 'Control.Monad.void' instead" #-} -- deprecated in 7.6