Initial commit

C2HS.hs

@@ -0,0 +1,237 @@
+--  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 :: (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 :: (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 :: (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

CoreFoundation.cabal

@@ -0,0 +1,40 @@
+Name:                CoreFoundation
+Version:             0.1
+Synopsis:            Bindings to Mac OSX's CoreFoundation framework
+Description:         Bindings to Mac OSX's CoreFoudnation framework
+License:             BSD3
+License-file:        LICENSE
+Author:              Reiner Pope
+Maintainer:          reiner.pope@gmail.com
+-- Copyright:
+Category:            System
+Build-type:          Simple
+Extra-source-files:
+  cbits/cbits.h
+Cabal-version:       >=1.2
+
+Library
+  Exposed-modules:
+     CoreFoundation.Base
+     CoreFoundation.String
+     CoreFoundation.Data
+     CoreFoundation.Type
+  Frameworks:
+     CoreFoundation
+
+  Build-depends:
+     base < 5,
+     bytestring >= 0.9 && < 0.10,
+     text >= 0.7 && <0.12
+
+  Build-tools:
+    c2hs
+
+  Include-dirs:
+    cbits
+  C-Sources:
+    cbits/cbits.c
+
+  Other-modules:
+    C2HS
+  -- Build-tools:

CoreFoundation/Array.chs

@@ -0,0 +1,42 @@
+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, EmptyDataDecls #-}
+module CoreFoundation.Array(
+  CFArray,
+  fromVector,
+  toVector,
+  ) where
+
+#include "CoreFoundation/CFData.h"
+#include "cbits.h"
+
+import Control.Applicative
+
+import Foreign
+import Foreign.C.Types
+
+import CoreFoundation.Base
+
+import qualified Data.Vector as V
+
+{- |
+Arrays of 'CFType' objects.
+-}
+data CFArray
+{#pointer CFArrayRef -> CFArray#}
+
+fromVector :: V.Vector (Ref CFData) -> IO (Ref CFArray)
+fromVector = undefined -- we can do this one
+
+fromVectorManaged :: V.Vector (ForeignPtr CFData) -> Create CFArray
+
+fromByteString :: B.ByteString -> Create CFData
+fromByteString bs = Create $ B.unsafeUseAsCStringLen bs $ \(buf, len) ->
+  {#call unsafe CFDataCreate as ^ #} nullPtr (castPtr buf) (fromIntegral len)
+
+toByteString :: Ptr CFData -> IO B.ByteString
+toByteString p = do
+  buf <- {#call unsafe CFDataGetBytePtr as ^ #} p
+  len <- {#call unsafe CFDataGetLength as ^ #} p
+  B.packCStringLen (castPtr buf, fromIntegral len)
+
+instance IsCFType CFData where 
+  staticType _ = CFTypeID {#call pure unsafe CFDataGetTypeID as ^ #}