Foreign/Marshal/Error.hs

   1 {-# LANGUAGE CPP, NoImplicitPrelude #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  Foreign.Marshal.Error
   6 -- Copyright   :  (c) The FFI task force 2001
   7 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   8 --
   9 -- Maintainer  :  ffi@haskell.org
  10 -- Stability   :  provisional
  11 -- Portability :  portable
  12 --
  13 -- Routines for testing return values and raising a 'userError' exception
  14 -- in case of values indicating an error state.
  15 --
  16 -----------------------------------------------------------------------------
  17
  18 module Foreign.Marshal.Error (
  19   throwIf,       -- :: (a -> Bool) -> (a -> String) -> IO a       -> IO a
  20   throwIf_,      -- :: (a -> Bool) -> (a -> String) -> IO a       -> IO ()
  21   throwIfNeg,    -- :: (Ord a, Num a)
  22                  -- =>                (a -> String) -> IO a       -> IO a
  23   throwIfNeg_,   -- :: (Ord a, Num a)
  24                  -- =>                (a -> String) -> IO a       -> IO ()
  25   throwIfNull,   -- ::                String        -> IO (Ptr a) -> IO (Ptr a)
  26
  27   -- Discard return value
  28   --
  29   void           -- IO a -> IO ()
  30 ) where
  31
  32 import Foreign.Ptr
  33
  34 #ifdef __GLASGOW_HASKELL__
  35 #ifdef __HADDOCK__
  36 import Data.Bool
  37 import System.IO.Error
  38 #endif
  39 import GHC.Base
  40 import GHC.Num
  41 -- import GHC.IO
  42 import GHC.IO.Exception
  43 #endif
  44
  45 -- exported functions
  46 -- ------------------
  47
  48 -- |Execute an 'IO' action, throwing a 'userError' if the predicate yields
  49 -- 'True' when applied to the result returned by the 'IO' action.
  50 -- If no exception is raised, return the result of the computation.
  51 --
  52 throwIf :: (a -> Bool)  -- ^ error condition on the result of the 'IO' action
  53         -> (a -> String) -- ^ computes an error message from erroneous results
  54                         -- of the 'IO' action
  55         -> IO a         -- ^ the 'IO' action to be executed
  56         -> IO a
  57 throwIf pred msgfct act  =
  58   do
  59     res <- act
  60     (if pred res then ioError . userError . msgfct else return) res
  61
  62 -- |Like 'throwIf', but discarding the result
  63 --
  64 throwIf_                 :: (a -> Bool) -> (a -> String) -> IO a -> IO ()
  65 throwIf_ pred msgfct act  = void $ throwIf pred msgfct act
  66
  67 -- |Guards against negative result values
  68 --
  69 throwIfNeg :: (Ord a, Num a) => (a -> String) -> IO a -> IO a
  70 throwIfNeg  = throwIf (< 0)
  71
  72 -- |Like 'throwIfNeg', but discarding the result
  73 --
  74 throwIfNeg_ :: (Ord a, Num a) => (a -> String) -> IO a -> IO ()
  75 throwIfNeg_  = throwIf_ (< 0)
  76
  77 -- |Guards against null pointers
  78 --
  79 throwIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
  80 throwIfNull  = throwIf (== nullPtr) . const
  81
  82 -- |Discard the return value of an 'IO' action
  83 --
  84 void     :: IO a -> IO ()
  85 void act  = act >> return ()