{-| 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. -} module Bindings ( -- * Code facilities -- | See documentation for module "Bindings.Utilities". -- * How to wrap a library using this package -- | 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. -- In real world, if we wanted, it would obviously be -- easier to write a UTF-8 handler in Haskell than -- this interface. -- -- > #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 () -- ** Cleaner Haskell interface -- | 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 {}