bindings-common 0.2.1 → 0.2.2

raw patch · 9 files changed

+522/−34 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• .hg_archival.txt +1/−1
• bindings-common.cabal +3/−6
• example/Setup.hs +6/−0
• example/example.c +93/−0
• example/example.cabal +25/−0
• example/example.h +14/−0
• example/test.hsc +81/−0
• src/Bindings.hs +273/−21
• src/bindings.macros.h +26/−6

@@ -1,2 +1,2 @@ repo: db8906263ec6e2f02cd51ed9b583ad96027042e9-node: a03ecc91aa79505a1ba9516d1f713d9c37227a74+node: c2c4a362ae898822a6fcbc3096e88a6586d87d2e

@@ -4,12 +4,9 @@ synopsis:   Low-level library bindings, base package. description: -  The @bindings-*@ set of packages contains low level bindings-  for established libraries, and is aimed at developers of higher-  level modules that can use it as foundation. They all mimic the-  names and functionality of the original libraries. For-  a specific library, look for package @bindings-library_name@.-version: 0.2.1+  Facilities to wrap foreign C libraries. Used as basis in+  @bindings-*@ packages.+version: 0.2.2 license: BSD3 license-file: LICENSE maintainer: Maurício C. Antunes <mauricio.antunes@gmail.com>

@@ -0,0 +1,6 @@+#!/usr/bin/env runhaskell++module Main (main) where+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,93 @@+#include "example.h"+#include <stdio.h>++void translate (int what, struct unicode_translator *p)+{+  int i;+  uint32_t uni;++  switch (what)+      {+       case UNICODE_2_UTF8:+           uni = p->unicode;+           for(i=0;i<4;) p->eight_bits[i++] = 0;++           if (uni < 0x7F)+               {+                p->eight_bits[0] = uni & 0x7F;+                p->nchars = 1;+                return;+               }+           else+               {+                p->eight_bits[0] = uni & 0x3F;+                p->eight_bits[0] |= 0x80;+                uni >>= 6;+               }++           if (uni < 0x20)+               {+                p->eight_bits[1] = uni & 0x1F;+                p->eight_bits[1] |= 0xC0;+                p->nchars = 2;+                return;+               }+           else+               {+                p->eight_bits[1] = uni & 0x3F;+                p->eight_bits[1] |= 0x80;+                uni >>= 6;+               }++           if (uni < 0x10)+               {+                p->eight_bits[2] = uni & 0xF;+                p->eight_bits[2] |= 0xEF;+                p->nchars = 3;+                return;+               }+           else+               {+                p->eight_bits[2] = uni & 0x3F;+                p->eight_bits[2] |= 0x80;+                uni >>= 6;+               }++           p->eight_bits[3] = uni & 0x7;+           p->eight_bits[3] |= 0xF0;+           p->nchars = 4;+           return;++       case UTF8_2_UNICODE:+           for(i=p->nchars;i<4;) p->eight_bits[i++] = 0;+           if (p->eight_bits[0] < 0x80)+               {+                p->unicode = p->eight_bits[0];+                return;+               }+           else+               p->unicode = p->eight_bits[0] & 0x3F;++           if (p->eight_bits[1] < 0xE0)+               {+                p->unicode += (p->eight_bits[1] & 0x1F) << 6;+                return;+               }+           else+               p->unicode += (p->eight_bits[1] & 0x3F) << 6;++           if (p->eight_bits[2] < 0xF0)+               {+                p->unicode += (p->eight_bits[2] & 0xF) << 12;+                return;+               }+           else+               p->unicode += (p->eight_bits[2] & 0x3F) << 12;++           p->unicode += (p->eight_bits[3] & 0x7) << 18;+           return;++      }++}+

@@ -0,0 +1,25 @@+cabal-version: >= 1.2.3+name: example+synopsis:+  Example+description: +  Example.+version: 0.2.1+license: BSD3+license-file: LICENSE+maintainer: Maurício C. Antunes <mauricio.antunes@gmail.com>+author: Maurício C. Antunes+stability: Needs users feedback+build-type: Simple+category: FFI+executable test+  main-is: test.hs+  hs-source-dirs: .+  include-dirs: .+  c-sources: example.c+  extensions:+    ForeignFunctionInterface+    ScopedTypeVariables+    MultiParamTypeClasses+    TypeFamilies+  build-depends: base >=3 && <5, bindings-common

@@ -0,0 +1,14 @@++#include <stdint.h>++#define UNICODE_2_UTF8 1+#define UTF8_2_UNICODE 2++struct unicode_translator {+  uint32_t unicode;+  uint8_t eight_bits[4];+  int nchars;+};++void translate (int, struct unicode_translator *);+

@@ -0,0 +1,81 @@+#include <bindings.macros.h>+#include "example.h"++#bindings_initialize++module Main (main) where+import Foreign+import Foreign.C+import Data.Int+import Data.List+import Control.Monad+import System.IO.Unsafe++#bindings_num UNICODE_2_UTF8+#bindings_num UTF8_2_UNICODE++#bindings_starttype struct unicode_translator+#bindings_field unicode , Word32+#bindings_array_field eight_bits , Word8 , 4+#bindings_field nchars , CInt+#bindings_stoptype++#bindings_function translate , CInt -> Ptr Unicode_translator -> IO ()++toChar :: (Enum a, Enum b) => a -> b+toChar = toEnum . fromEnum+fromChar :: (Enum a, Num b) => a -> b+fromChar = fromIntegral . fromEnum++unicodeToUtf :: String -> IO String+unicodeToUtf string = liftM concat $ alloca $ \ptrUt ->+  (flip mapM) string $ \char -> do+      ut <- peek ptrUt+      poke ptrUt (ut {unicode_translator'unicode = toChar char})+      translate _UNICODE_2_UTF8 ptrUt+      ut <- peek ptrUt+      let nChars = fromIntegral $ unicode_translator'nchars ut+      let eightBits = unicode_translator'eight_bits ut+      return $ (map toChar) $ reverse $ take nChars eightBits++utfToUnicode :: String -> IO String+utfToUnicode =+ (. (map fromChar)) $+ (. splitCodes) $+ mapM $ \c -> do+    let ut = Unicode_translator {+               unicode_translator'nchars = fromIntegral $ length c,+               unicode_translator'eight_bits = reverse $ map fromChar c,+               unicode_translator'unicode = 0+              }+    unicode <- with ut $ \ptr -> do+        translate _UTF8_2_UNICODE ptr+        liftM unicode_translator'unicode $ peek ptr+    return $ toChar $ unicode+ where+     splitCodes :: [Word8] -> [[Word8]]+     splitCodes [] = []+     splitCodes (a:t) = if (a < 0x80)+       then+         [a]:(splitCodes t)+       else+         let i = findIndex (\c -> c < 0x80 || c > 0xBF) t+             (t1,t2) = maybe ([],t) (flip splitAt t) i+         in (a:t1):(splitCodes t2)++toUtf8 :: String -> String+toUtf8 = unsafePerformIO . unicodeToUtf++fromUtf8 :: String -> String+fromUtf8 = unsafePerformIO . utfToUnicode++printAsInt :: String -> IO ()+printAsInt s = putStrLn $ show $ map fromEnum s++main = do+ let a = "Exceção"+ printAsInt a+ printAsInt $ toUtf8 a+ printAsInt $ fromUtf8 $ toUtf8 a++

@@ -1,29 +1,281 @@ {-| -    Modules under "Bindings" are supposed to be low level-    links to well-known libraries. All of them follow the-    same style for consistency and predictability. Here are-    a few rules that have been followed:+    Package @bindings-common@ provides many facilities to+    do low-level FFI to C libraris, in the form of macros and modules.+    It also sets a base module under which low-level bindings to+    C libraries can be inserted. -    * All packages use cabal. Checking of dependencies is-    delegated to @pkg-config@ by listing such dependencies-    in cabal file.+-} -    * All names are as close as possible to the names in the-    original library language. To agree with Haskell case-    conventions they may be prefixed with an underscore or-    have their first letter capitalized.+module Bindings ( -    * Documentation is provided as links to the official-    homepage for a library. Due to the policy of preserving-    names and functionality, such documentation can be used-    as it is.+-- * Code facilities -    These modules are supposed to be used by developers of-    higher level modules, who should have a good understanding-    of the undeline libraries they decide to use. Of course,-    you can use them directly if you know what you are doing.+-- | See documentation for module "Bindings.Utilities". --}+-- * How to wrap a library using this package -module Bindings where {}+-- | If you want to write a comprehensive binding+-- to your favorite library, and you want to try+-- this package to see if it suits your needs, you+-- can look at this documentation and then at the+-- source code for "Bindings.C", which tries to wrap+-- the full standard C library.++-- * Macros++-- | Starting from version 0.2, package @bindings-common@+-- provides many @hsc2hs@ macros to easy C binding.+-- Here we list the most important.++-- [@#bindings_num@] Makes a C value into a Haskell+-- name with type @(Num a) => a@. Used mostly to+-- copy pre-processor macros. Note that here, as in+-- all other macros, Haskell names are automatically+-- derived from C names. Usage:+--+-- @+-- #bindings_num MY_MACRO+-- @++-- [@#bindings_int@] Like @#bindings_num@, but values+-- are typed as @CInt@.++-- [@#bindings_frac@] Like @#bindings_num@, but works+-- with floating point numbers. Values will have type+-- @(Fractional a) => a@.++-- [@#bindings_function@] Wrap C functions. Usage:+--+-- @+-- #bindings_function function_name , CInt -> CString -> IO ()+-- @++-- [@#bindings_startype , #bindings_stoptype@] Declare a+-- Haskell @data@ type after a C type. You can wrap @struct@s,+-- @union@s and types named with C @typedef@. Note that+-- you can create types with no fields. This may be usefull+-- when you don't need to reach fields, but your API requires+-- you to create values of such types.+--+-- @+-- #bindings_starttype struct my_type+-- #bindings_stoptype _+-- @+--+-- You can replace @struct@ with @union@, or remove it+-- when your type is defined with @typedef@. Note that+-- the @_@ after @#bindings_stoptype@ is needed since+-- @hsc2hs@ doesn't accept macros with no parameters.++-- [@#bindings_field , #bindings_array_field@] Describe fields+-- inside types. Supose you have a @struct@ like this:+--+-- @+-- typedef struct my_struct {+--   int index;+--   char *text;+--   char array[10];+-- } my_struct_t;+-- @+--+-- You would mimic such type like this.+--+-- @+-- #bindings_starttype my_struct_t+-- #bindings_field index , CInt+-- #bindings_field text , CString+-- #bindings_array_field , array , CChar , 10+-- #bindings_stoptype _+-- @+--+-- You get a full instance for @Storable@.+--+-- @+-- v <- peek p :: IO My_struct_t+-- poke p $ v {my_struct_t'index = 1 + (my_struct_t'index v)}+-- @+--+-- As you can see from the example above, field names+-- are translated to Haskell using @type'field@ pattern.+-- This is necessary to avoid name clashes since Haskell+-- would not allow many types with similar records, as+-- is common practice in C.++-- [@#bindings_equivalent_integer@] This gives you a Haskell+-- integer type that is the same size as a C type. Usage:+--+-- @+-- type CIntType = #bindings_equivalent_integer int_type+-- @+--+-- This is actually equivalent to @hsc2hs@ +-- @#type@, except that it is safe to use on pointers+-- (but not on floating point types).++-- [@#bindings_globalvar@] Wraps a global variable, using+-- 'Bindings.Utilities.GlobalVariable'. Usage:+--+-- @+-- #bindings_globalvar external_string , CString+-- @+--+-- Note that the internal type of that variable+-- will be a pointer to a @CString@, as you'll be+-- allowed to change its value. When touching it+-- using 'Bindings.Utilities.writeGlobalVariable'+-- this is invisible to you.+++-- * Example++-- | We'll take a small piece of C code and wrap it+-- using @hsc2hs@ macros available in @bindings-common@.+-- Our intention is to show that we can write Haskell+-- code with the help of existing C code, but using+-- a Haskell interface that is not built on the C+-- interface. This is an alternative to the usual style+-- of using adapted versions of native C calls. In our+-- opinion, the style shown here is easier to write+-- and give results that are more confortable to use+-- in Haskell.++-- ** C API++-- | This is a small (artificial, naive and ugly) API+-- for UTF-8 coding of characters. Most APIs have better+-- design, but we just want to show how to deal with it.+--+-- @+-- #define UNICODE_2_UTF8 1+-- #define UTF8_2_UNICODE 2+--+-- struct unicode_translator {+--   uint32_t unicode;+--   uint8_t eight_bits[4];+--   int nchars;+-- };+--+-- void translate (int, struct unicode_translator *);+-- @+--+-- We use it filling @unicode@ field with an unicode+-- number, and then calling @translate@ with @UNICODE_2_UTF8@;+-- or filling @eight_bits@ and calling @translate@ with+-- @UTF8_2_UNICODE@.++-- ** Haskell low level binding++-- | Now we make use of @hsc2hs@ macros inside Haskell.+--+-- #bindings_num UNICODE_2_UTF8+-- #bindings_num UTF8_2_UNICODE+--+-- #bindings_starttype struct unicode_translator+-- #bindings_field unicode , Word32+-- #bindings_array_field eight_bits , Word8 , 4+-- #bindings_field nchars , CInt+-- #bindings_stoptype+--+-- #bindings_function translate , CInt -> Ptr Unicode_translator -> IO ()+--+-- This gives us a set of declarations as below.+--+-- @+-- _UNICODE_2_UTF8 :: (Num a) => a+-- _UTF8_2_UNICODE :: (Num a) => a+--+-- data Unicode_translator = Unicode_translator {+--   unicode_translator'unicode :: Word32,+--   unicode_translator'eight_bits :: [Word8],+--   unicode_translator'nchars :: CInt+-- }+--+-- translate :: CInt -> Ptr Unicode_translator -> IO ()+-- @++-- ** Clean Haskell code++-- | Now we declare a few Haskell utilities that+-- better fit Haskell programming.+--+-- @+-- toChar :: (Enum a, Enum b) => a -> b+-- toChar = toEnum . fromEnum+-- fromChar :: (Enum a, Num b) => a -> b+-- fromChar = fromIntegral . fromEnum+-- +-- unicodeToUtf :: String -> IO String+-- unicodeToUtf string = liftM concat $ alloca $ \ptrUt ->+--   (flip mapM) string $ \char -> do+--       ut <- peek ptrUt+--       poke ptrUt (ut {unicode_translator'unicode = toChar char})+--       translate _UNICODE_2_UTF8 ptrUt+--       ut <- peek ptrUt+--       let nChars = fromIntegral $ unicode_translator'nchars ut+--       let eightBits = unicode_translator'eight_bits ut+--       return $ (map toChar) $ reverse $ take nChars eightBits+-- +-- utfToUnicode :: String -> IO String+-- utfToUnicode =+--  (. (map fromChar)) $+--  (. splitCodes) $+--  mapM $ \c -> do+--     let ut = Unicode_translator {+--                unicode_translator'nchars = fromIntegral $ length c,+--                unicode_translator'eight_bits = reverse $ map fromChar c,+--                unicode_translator'unicode = 0+--               }+--     unicode <- with ut $ \ptr -> do+--         translate _UTF8_2_UNICODE ptr+--         liftM unicode_translator'unicode $ peek ptr+--     return $ toChar $ unicode+--  where+--      splitCodes :: [Word8] -> [[Word8]]+--      splitCodes [] = []+--      splitCodes (a:t) = if (a < 0x80)+--        then+--          [a]:(splitCodes t)+--        else+--          let i = findIndex (\c -> c < 0x80 || c > 0xBF) t+--              (t1,t2) = maybe ([],t) (flip splitAt t) i+--          in (a:t1):(splitCodes t2)+-- @+--+-- @unicodeToUtf@ and @utfToUnicode@ now use Haskell+-- day-to-day types.++-- ** Better interface++-- | Our functions are effect-free.+--+-- @+-- toUtf8 :: String -> String+-- toUtf8 = unsafePerformIO . unicodeToUtf+-- +-- fromUtf8 :: String -> String+-- fromUtf8 = unsafePerformIO . utfToUnicode+-- @+--+-- And this is something we can confortably use.+--+-- @+-- printAsInt :: String -> IO ()+-- printAsInt s = putStrLn $ show $ map fromEnum s+-- +-- main = do+--   let a = "Exceção"+--   printAsInt a+--   printAsInt $ toUtf8 a+--   printAsInt $ fromUtf8 $ toUtf8 a+-- @+--+-- Outputs:+--+-- @+-- [69,120,99,101,231,227,111]+-- [69,120,99,101,195,167,195,163,111]+-- [69,120,99,101,231,227,111]+-- @++ ) where {}

@@ -117,6 +117,8 @@         int nfields = 0; \         char *fieldnames[100]; \         char *fieldtypes[100]; \+        int is_array[100]; \+        int array_size[100]; \         size_t fieldoffsets[100]; \         size_t typesize = sizeof (name); \         int i; \@@ -126,17 +128,26 @@ #define hsc_bindings_field(name,type) \         fieldnames[nfields] = # name; \         fieldtypes[nfields] = # type; \+        is_array[nfields] = 0; \         fieldoffsets[nfields] = (size_t) &(refpointer->name); \         nfields++; +#define hsc_bindings_array_field(name,type,size) \+        fieldnames[nfields] = # name; \+        fieldtypes[nfields] = # type; \+        is_array[nfields] = 1; \+        array_size[nfields] = size; \+        fieldoffsets[nfields] = (size_t) (refpointer->name); \+        nfields++;+ #define hsc_bindings_stoptype(dummy) \         printf("data %s = %s", bindings_conid(type1), \           bindings_conid(type1)); \         if (nfields>0) printf (" {"); \         for(i=0;i<nfields;i++) \         { \-            printf("%s'%s :: %s", bindings_varid(type1), \-              fieldnames[i], fieldtypes[i]); \+            printf(is_array[i]?"%s'%s :: [%s]":"%s'%s :: %s", \+              bindings_varid(type1), fieldnames[i], fieldtypes[i]); \             if (i+1<nfields) printf(" , "); \         } \         if (nfields>0) printf ("}"); \@@ -145,16 +156,25 @@           typesize); \         for(i=0;i<nfields;i++) \         { \-            printf("peekByteOff p %zu >>= \\v%d -> ", \-              fieldoffsets[i],i); \+            if (is_array[i]) \+                printf("peekArray %d (plusPtr p %zu) >>= \\v%d -> ", \+                  array_size[i],fieldoffsets[i],i); \+            else \+                printf("peekByteOff p %zu >>= \\v%d -> ", \+                  fieldoffsets[i],i); \         } \         printf("return $ %s ",bindings_conid(type1)); \         for(i=0;i<nfields;i++) printf("v%d ",i); \         printf(" ; poke p (%s ",bindings_conid(type1)); \         for(i=0;i<nfields;i++) printf("v%d ",i); \         printf(") = "); \-        for(i=0;i<nfields;i++) printf("pokeByteOff p %zu v%d >> ", \-          fieldoffsets[i],i); \+        for(i=0;i<nfields;i++) \+            if (is_array[i]) \+                printf("pokeArray (plusPtr p %zu) (take %d v%d) >> ", \+                  fieldoffsets[i],array_size[i],i); \+            else \+                printf("pokeByteOff p %zu v%d >> ", \+                  fieldoffsets[i],i); \         printf("return () }"); \     }