content: --  C->Haskell Compiler: Marshalling library
  --
  --  Copyright (c) [1999...2005] Manuel M T Chakravarty
  --
  --  Redistribution and use in source and binary forms, with or without
  --  modification, are permitted provided that the following conditions are met:
  -- 
  --  1. Redistributions of source code must retain the above copyright notice,
  --     this list of conditions and the following disclaimer. 
  --  2. Redistributions in binary form must reproduce the above copyright
  --     notice, this list of conditions and the following disclaimer in the
  --     documentation and/or other materials provided with the distribution. 
  --  3. The name of the author may not be used to endorse or promote products
  --     derived from this software without specific prior written permission. 
  --
  --  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
  --  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  --  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
  --  NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  --  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
  --  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  --  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  --  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  --  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  --  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  --
  --- Description ---------------------------------------------------------------
  --
  --  Language: Haskell 98
  --
  --  This module provides the marshaling routines for Haskell files produced by 
  --  C->Haskell for binding to C library interfaces.  It exports all of the
  --  low-level FFI (language-independent plus the C-specific parts) together
  --  with the C->HS-specific higher-level marshalling routines.
  --
  
  module C2HS (
  
    -- * Re-export the language-independent component of the FFI 
    module Foreign,
  
    -- * Re-export the C language component of the FFI
    module Foreign.C,
  
    -- * Composite marshalling functions
    withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,
    peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,
  
    -- * Conditional results using 'Maybe'
    nothingIf, nothingIfNull,
  
    -- * Bit masks
    combineBitMasks, containsBitMask, extractBitMasks,
  
    -- * Conversion between C and Haskell types
    cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum
  ) where 
  
  
  import Foreign
  import Foreign.C
  
  import Control.Monad (liftM)
  
  
  -- Composite marshalling functions
  -- -------------------------------
  
  -- Strings with explicit length
  --
  withCStringLenIntConv :: Num n => String -> ((CString, n) -> IO a) -> IO a
  withCStringLenIntConv s f    = withCStringLen s $ \(p, n) -> f (p, fromIntegral n)
  
  peekCStringLenIntConv :: Integral n => (CString, n) -> IO String
  peekCStringLenIntConv (s, n) = peekCStringLen (s, fromIntegral n)
  
  -- Marshalling of numerals
  --
  
  withIntConv   :: (Storable b, Integral a, Integral b) 
                => a -> (Ptr b -> IO c) -> IO c
  withIntConv    = with . fromIntegral
  
  withFloatConv :: (Storable b, RealFloat a, RealFloat b) 
                => a -> (Ptr b -> IO c) -> IO c
  withFloatConv  = with . realToFrac
  
  peekIntConv   :: (Storable a, Integral a, Integral b) 
                => Ptr a -> IO b
  peekIntConv    = liftM fromIntegral . peek
  
  peekFloatConv :: (Storable a, RealFloat a, RealFloat b) 
                => Ptr a -> IO b
  peekFloatConv  = liftM realToFrac . peek
  
  
  -- Everything else below is deprecated.
  -- These functions are not used by code generated by c2hs.
  
  {-# DEPRECATED withBool        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED peekBool        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED withEnum        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED peekEnum        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED nothingIf       "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED nothingIfNull   "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED combineBitMasks "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED containsBitMask "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED extractBitMasks "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED cIntConv        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED cFloatConv      "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED cFromBool       "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED cToBool         "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED cToEnum         "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  {-# DEPRECATED cFromEnum       "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
  
  
  -- Passing Booleans by reference
  --
  
  withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b
  withBool  = with . fromBool
  
  peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool
  peekBool  = liftM toBool . peek
  
  
  -- Passing enums by reference
  --
  
  withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c
  withEnum  = with . cFromEnum
  
  peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a
  peekEnum  = liftM cToEnum . peek
  
  
  -- Storing of 'Maybe' values
  -- -------------------------
  
  --TODO: kill off this orphan instance!
  
  instance Storable a => Storable (Maybe a) where
    sizeOf    _ = sizeOf    (undefined :: Ptr ())
    alignment _ = alignment (undefined :: Ptr ())
  
    peek p = do
               ptr <- peek (castPtr p)
               if ptr == nullPtr
                 then return Nothing
                 else liftM Just $ peek ptr
  
    poke p v = do
                 ptr <- case v of
                          Nothing -> return nullPtr
                          Just v' -> new v'
                 poke (castPtr p) ptr
  
  
  -- Conditional results using 'Maybe'
  -- ---------------------------------
  
  -- Wrap the result into a 'Maybe' type.
  --
  -- * the predicate determines when the result is considered to be non-existing,
  --   ie, it is represented by `Nothing'
  --
  -- * the second argument allows to map a result wrapped into `Just' to some
  --   other domain
  --
  nothingIf       :: (a -> Bool) -> (a -> b) -> a -> Maybe b
  nothingIf p f x  = if p x then Nothing else Just $ f x
  
  -- |Instance for special casing null pointers.
  --
  nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b
  nothingIfNull  = nothingIf (== nullPtr)
  
  
  -- Support for bit masks
  -- ---------------------
  
  -- Given a list of enumeration values that represent bit masks, combine these
  -- masks using bitwise disjunction.
  --
  combineBitMasks :: (Num b, Enum a, Bits b) => [a] -> b
  combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)
  
  -- Tests whether the given bit mask is contained in the given bit pattern
  -- (i.e., all bits set in the mask are also set in the pattern).
  --
  containsBitMask :: (Num a, Bits a, Enum b) => a -> b -> Bool
  bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm
                              in
                              bm' .&. bits == bm'
  
  -- |Given a bit pattern, yield all bit masks that it contains.
  --
  -- * This does *not* attempt to compute a minimal set of bit masks that when
  --   combined yield the bit pattern, instead all contained bit masks are
  --   produced.
  --
  extractBitMasks :: (Num a, Bits a, Enum b, Bounded b) => a -> [b]
  extractBitMasks bits = 
    [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]
  
  
  -- Conversion routines
  -- -------------------
  
  -- |Integral conversion
  --
  cIntConv :: (Integral a, Integral b) => a -> b
  cIntConv  = fromIntegral
  
  -- |Floating conversion
  --
  cFloatConv :: (RealFloat a, RealFloat b) => a -> b
  cFloatConv  = realToFrac
  
  -- |Obtain C value from Haskell 'Bool'.
  --
  cFromBool :: Num a => Bool -> a
  cFromBool  = fromBool
  
  -- |Obtain Haskell 'Bool' from C value.
  --
  cToBool :: (Eq a, Num a) => a -> Bool
  cToBool  = toBool
  
  -- |Convert a C enumeration to Haskell.
  --
  cToEnum :: (Integral i, Enum e) => i -> e
  cToEnum  = toEnum . fromIntegral
  
  -- |Convert a Haskell enumeration to C.
  --
  cFromEnum :: (Enum e, Integral i) => e -> i
  cFromEnum  = fromIntegral . fromEnum
  