module Foreign.HacanonLight.Common.Types where

import Language.Haskell.TH

import Foreign.HacanonLight.DIS.Types


data FFIDecl
    = FFIDecl
    {
     ffiUnique      :: Name,         -- ^ Unique name of the FFI binding.
     ffiName        :: String,       -- ^ Name of the C function.
     ffiType        :: [DIS],        -- ^ Interface scheme and hints.
     ffiCallConv    :: Callconv,     -- ^ Calling convention. Specified in the state or with hints.c
     ffiSafety      :: Safety,
     ffiPure        :: Bool
    }



--------------------------------------------------------------
-- Haskell stuff
--------------------------------------------------------------


data HsDecl
    = HsDecl
    {
     hsName        :: Name,          -- ^ Name of the generated Haskel function.
     hsFFIName     :: Name,          -- ^ Name of the raw ffi binding.
     hsType        :: TypeQ,         -- ^ Type of the generated function.
     hsBody        :: ExpQ,          -- ^ Body of the generated function.
     hsPure        :: Bool           -- ^ Is the function pure? (using unsafePerformIO if it is)
    }