--  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 Physics.Bullet.Raw.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
       hiding       (Word)
		    -- Should also hide the Foreign.Marshal.Pool exports in
		    -- compilers that export them
import Foreign.C
import Foreign.ForeignPtr.Unsafe

import Control.Monad        (when, liftM)


-- Composite marshalling functions
-- -------------------------------

-- Strings with explicit length
--
withCStringLenIntConv :: String -> ((Ptr CChar, b) -> IO a) -> IO a
withCStringLenIntConv s :: String
s f :: (Ptr CChar, b) -> IO a
f    = String -> (CStringLen -> IO a) -> IO a
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
s ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(p :: Ptr CChar
p, n :: Int
n) -> (Ptr CChar, b) -> IO a
f (Ptr CChar
p, Int -> b
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
n)
peekCStringLenIntConv :: (Ptr CChar, a) -> IO String
peekCStringLenIntConv (s :: Ptr CChar
s, n :: a
n) = CStringLen -> IO String
peekCStringLen (Ptr CChar
s, a -> Int
forall a b. (Integral a, Integral b) => a -> b
cIntConv a
n)

-- Marshalling of numerals
--

withIntConv   :: (Storable b, Integral a, Integral b) 
	      => a -> (Ptr b -> IO c) -> IO c
withIntConv :: a -> (Ptr b -> IO c) -> IO c
withIntConv    = b -> (Ptr b -> IO c) -> IO c
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (b -> (Ptr b -> IO c) -> IO c)
-> (a -> b) -> a -> (Ptr b -> IO c) -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. (Integral a, Integral b) => a -> b
cIntConv

withFloatConv :: (Storable b, RealFloat a, RealFloat b) 
	      => a -> (Ptr b -> IO c) -> IO c
withFloatConv :: a -> (Ptr b -> IO c) -> IO c
withFloatConv  = b -> (Ptr b -> IO c) -> IO c
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (b -> (Ptr b -> IO c) -> IO c)
-> (a -> b) -> a -> (Ptr b -> IO c) -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. (RealFloat a, RealFloat b) => a -> b
cFloatConv

peekIntConv   :: (Storable a, Integral a, Integral b) 
	      => Ptr a -> IO b
peekIntConv :: Ptr a -> IO b
peekIntConv    = (a -> b) -> IO a -> IO b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
forall a b. (Integral a, Integral b) => a -> b
cIntConv (IO a -> IO b) -> (Ptr a -> IO a) -> Ptr a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek

peekFloatConv :: (Storable a, RealFloat a, RealFloat b) 
	      => Ptr a -> IO b
peekFloatConv :: Ptr a -> IO b
peekFloatConv  = (a -> b) -> IO a -> IO b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
forall a b. (RealFloat a, RealFloat b) => a -> b
cFloatConv (IO a -> IO b) -> (Ptr a -> IO a) -> Ptr a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek

-- Passing Booleans by reference
--

withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b
withBool :: Bool -> (Ptr a -> IO b) -> IO b
withBool  = a -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (a -> (Ptr a -> IO b) -> IO b)
-> (Bool -> a) -> Bool -> (Ptr a -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a
forall a. Num a => Bool -> a
fromBool

peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool
peekBool :: Ptr a -> IO Bool
peekBool  = (a -> Bool) -> IO a -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO a -> IO Bool) -> (Ptr a -> IO a) -> Ptr a -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek


-- Passing enums by reference
--

withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c
withEnum :: a -> (Ptr b -> IO c) -> IO c
withEnum  = b -> (Ptr b -> IO c) -> IO c
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (b -> (Ptr b -> IO c) -> IO c)
-> (a -> b) -> a -> (Ptr b -> IO c) -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall e i. (Enum e, Integral i) => e -> i
cFromEnum

peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a
peekEnum :: Ptr b -> IO a
peekEnum  = (b -> a) -> IO b -> IO a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> a
forall i e. (Integral i, Enum e) => i -> e
cToEnum (IO b -> IO a) -> (Ptr b -> IO b) -> Ptr b -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek


-- Storing of 'Maybe' values
-- -------------------------

instance Storable a => Storable (Maybe a) where
  sizeOf :: Maybe a -> Int
sizeOf    _ = Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf    (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ())
  alignment :: Maybe a -> Int
alignment _ = Ptr () -> Int
forall a. Storable a => a -> Int
alignment (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ())

  peek :: Ptr (Maybe a) -> IO (Maybe a)
peek p :: Ptr (Maybe a)
p = do
	     Ptr a
ptr <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (Maybe a) -> Ptr (Ptr a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (Maybe a)
p)
	     if Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr
	       then Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
	       else (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just (IO a -> IO (Maybe a)) -> IO a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr

  poke :: Ptr (Maybe a) -> Maybe a -> IO ()
poke p :: Ptr (Maybe a)
p v :: Maybe a
v = do
	       Ptr a
ptr <- case Maybe a
v of
		        Nothing -> Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
forall a. Ptr a
nullPtr
			Just v' :: a
v' -> a -> IO (Ptr a)
forall a. Storable a => a -> IO (Ptr a)
new a
v'
               Ptr (Ptr a) -> Ptr a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Maybe a) -> Ptr (Ptr a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (Maybe a)
p) Ptr a
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 :: (a -> Bool) -> (a -> b) -> a -> Maybe b
nothingIf p :: a -> Bool
p f :: a -> b
f x :: a
x  = if a -> Bool
p a
x then Maybe b
forall a. Maybe a
Nothing else b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

-- |Instance for special casing null pointers.
--
nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b
nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b
nothingIfNull  = (Ptr a -> Bool) -> (Ptr a -> b) -> Ptr a -> Maybe b
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
nothingIf (Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr)


-- Support for bit masks
-- ---------------------

-- Given a list of enumeration values that represent bit masks, combine these
-- masks using bitwise disjunction.
--
combineBitMasks :: (Enum a, Bits b, Num b) => [a] -> b
combineBitMasks :: [a] -> b
combineBitMasks = (b -> b -> b) -> b -> [b] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> b -> b
forall a. Bits a => a -> a -> a
(.|.) 0 ([b] -> b) -> ([a] -> [b]) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (a -> Int) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
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 :: (Bits a, Enum b, Num a) => a -> b -> Bool
bits :: a
bits containsBitMask :: a -> b -> Bool
`containsBitMask` bm :: b
bm = let bm' :: a
bm' = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> (b -> Int) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a. Enum a => a -> Int
fromEnum (b -> a) -> b -> a
forall a b. (a -> b) -> a -> b
$ b
bm
			    in
			    a
bm' a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
bits a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
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 :: (Bits a, Enum b, Bounded b, Num a) => a -> [b]
extractBitMasks :: a -> [b]
extractBitMasks bits :: a
bits = 
  [b
bm | b
bm <- [b
forall a. Bounded a => a
minBound..b
forall a. Bounded a => a
maxBound], a
bits a -> b -> Bool
forall a b. (Bits a, Enum b, Num a) => a -> b -> Bool
`containsBitMask` b
bm]


-- Conversion routines
-- -------------------

-- |Integral conversion
--
cIntConv :: (Integral a, Integral b) => a -> b
cIntConv :: a -> b
cIntConv  = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- |Floating conversion
--
cFloatConv :: (RealFloat a, RealFloat b) => a -> b
cFloatConv :: a -> b
cFloatConv  = a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac
-- As this conversion by default goes via `Rational', it can be very slow...
{-# RULES 
  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;
  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
 #-}

-- |Obtain C value from Haskell 'Bool'.
--
cFromBool :: Num a => Bool -> a
cFromBool :: Bool -> a
cFromBool  = Bool -> a
forall a. Num a => Bool -> a
fromBool

-- |Obtain Haskell 'Bool' from C value.
--
cToBool :: (Eq a, Num a) => a -> Bool
cToBool :: a -> Bool
cToBool  = a -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool

-- |Convert a C enumeration to Haskell.
--
cToEnum :: (Integral i, Enum e) => i -> e
cToEnum :: i -> e
cToEnum  = Int -> e
forall a. Enum a => Int -> a
toEnum (Int -> e) -> (i -> Int) -> i -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Int
forall a b. (Integral a, Integral b) => a -> b
cIntConv

-- |Convert a Haskell enumeration to C.
--
cFromEnum :: (Enum e, Integral i) => e -> i
cFromEnum :: e -> i
cFromEnum  = Int -> i
forall a b. (Integral a, Integral b) => a -> b
cIntConv (Int -> i) -> (e -> Int) -> e -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Int
forall a. Enum a => a -> Int
fromEnum