Foreign/Marshal/Error.hs

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