{-|

    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.
--
-- @
-- #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 {}