-- | Arguments and return types
module Foreign.LibFFI.Types (
    -- * Arguments
    -- ** Integral types
    argCInt,
    argCUInt,
    argCLong,
    argCULong,
    argInt8,
    argInt16,
    argInt32,
    argInt64,
    argWord8,
    argWord16,
    argWord32,
    argWord64,
    -- ** Floating point types
    argCFloat,
    argCDouble,
    -- ** Various other C types
    argCSize,
    argCTime,
    argCChar,
    argCUChar,
    argCWchar,
    argPtr,
    argFunPtr,
    -- ** Strings
    argString,
    argByteString,
    argConstByteString,
    -- * Return types
    -- ** Integral types
    retVoid,
    retCInt,
    retCUInt,
    retCLong,
    retCULong,
    retInt8,
    retInt16,
    retInt32,
    retInt64,
    retWord8,
    retWord16,
    retWord32,
    retWord64,
    -- ** Floating point types
    retCFloat,
    retCDouble,
    -- ** Various other C types
    retCSize,
    retCTime,
    retCChar,
    retCUChar,
    retCWchar,
    retPtr,
    retFunPtr,
    -- ** Strings
    retCString,
    retString,
    retByteString,
    retMallocByteString
    ) where

import Control.Monad
import Data.List
import Data.Char
import Data.Int
import Data.Word

import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable
import Foreign.C.String
import Foreign.Marshal
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BSU

import Foreign.LibFFI.Base
import Foreign.LibFFI.FFITypes

argCInt     :: CInt -> Arg
argCInt :: CInt -> Arg
argCInt     = Ptr CType -> CInt -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_sint
argCUInt    :: CUInt -> Arg
argCUInt :: CUInt -> Arg
argCUInt    = Ptr CType -> CUInt -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_uint
argCLong    :: CLong -> Arg
argCLong :: CLong -> Arg
argCLong    = Ptr CType -> CLong -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_slong
argCULong   :: CULong -> Arg
argCULong :: CULong -> Arg
argCULong   = Ptr CType -> CULong -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_ulong

-- | Note that on e.g. x86_64, Int \/= CInt
argInt8     :: Int8 -> Arg
argInt8 :: Int8 -> Arg
argInt8     = Ptr CType -> Int8 -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_sint8
argInt16    :: Int16 -> Arg
argInt16 :: Int16 -> Arg
argInt16    = Ptr CType -> Int16 -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_sint16
argInt32    :: Int32 -> Arg
argInt32 :: Int32 -> Arg
argInt32    = Ptr CType -> Int32 -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_sint32
argInt64    :: Int64 -> Arg
argInt64 :: Int64 -> Arg
argInt64    = Ptr CType -> Int64 -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_sint64

argWord8    :: Word8 -> Arg
argWord8 :: Word8 -> Arg
argWord8    = Ptr CType -> Word8 -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_uint8
argWord16   :: Word16 -> Arg
argWord16 :: Word16 -> Arg
argWord16   = Ptr CType -> Word16 -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_uint16
argWord32   :: Word32 -> Arg
argWord32 :: Word32 -> Arg
argWord32   = Ptr CType -> Word32 -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_uint32
argWord64   :: Word64 -> Arg
argWord64 :: Word64 -> Arg
argWord64   = Ptr CType -> Word64 -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_uint64

argCFloat   :: CFloat -> Arg
argCFloat :: CFloat -> Arg
argCFloat   = Ptr CType -> CFloat -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_float
argCDouble  :: CDouble -> Arg
argCDouble :: CDouble -> Arg
argCDouble  = Ptr CType -> CDouble -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_double

argCSize    :: CSize -> Arg
argCSize :: CSize -> Arg
argCSize    = Ptr CType -> CSize -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_size
argCTime    :: CTime -> Arg
argCTime :: CTime -> Arg
argCTime    = Ptr CType -> CTime -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_size

argCChar    :: CChar -> Arg
argCChar :: CChar -> Arg
argCChar    = Ptr CType -> CChar -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_schar
argCUChar   :: CUChar -> Arg
argCUChar :: CUChar -> Arg
argCUChar   = Ptr CType -> CUChar -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_uchar

argCWchar   :: CWchar -> Arg
argCWchar :: CWchar -> Arg
argCWchar   = Ptr CType -> CWchar -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_wchar

argPtr      :: Ptr a -> Arg
argPtr :: Ptr a -> Arg
argPtr      = Ptr CType -> Ptr a -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_pointer

argFunPtr   :: FunPtr a -> Arg
argFunPtr :: FunPtr a -> Arg
argFunPtr   = Ptr CType -> FunPtr a -> Arg
forall a. Storable a => Ptr CType -> a -> Arg
mkStorableArg Ptr CType
ffi_type_pointer

{- | The string argument is passed to C as a char * pointer, which is freed afterwards.
     The argument should not contain zero-bytes. -}
argString   :: String -> Arg
argString :: String -> Arg
argString   = (String -> IO (Ptr CChar)) -> (Ptr CChar -> IO ()) -> String -> Arg
forall a b. (a -> IO (Ptr b)) -> (Ptr b -> IO ()) -> a -> Arg
customPointerArg String -> IO (Ptr CChar)
newCString Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free

-- | Like argString, but for ByteString's.
argByteString  :: BS.ByteString -> Arg
argByteString :: ByteString -> Arg
argByteString  = (ByteString -> IO (Ptr CChar))
-> (Ptr CChar -> IO ()) -> ByteString -> Arg
forall a b. (a -> IO (Ptr b)) -> (Ptr b -> IO ()) -> a -> Arg
customPointerArg ((ByteString -> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr CChar -> IO (Ptr CChar)) -> ByteString -> IO (Ptr CChar)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return) (IO () -> Ptr CChar -> IO ()
forall a b. a -> b -> a
const (IO () -> Ptr CChar -> IO ()) -> IO () -> Ptr CChar -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Like argByteString, but changing the string from C breaks referential transparency.
argConstByteString  :: BS.ByteString -> Arg
argConstByteString :: ByteString -> Arg
argConstByteString  = (ByteString -> IO (Ptr CChar))
-> (Ptr CChar -> IO ()) -> ByteString -> Arg
forall a b. (a -> IO (Ptr b)) -> (Ptr b -> IO ()) -> a -> Arg
customPointerArg ((ByteString -> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr CChar -> IO (Ptr CChar)) -> ByteString -> IO (Ptr CChar)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BSU.unsafeUseAsCString Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return) (IO () -> Ptr CChar -> IO ()
forall a b. a -> b -> a
const (IO () -> Ptr CChar -> IO ()) -> IO () -> Ptr CChar -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

retVoid     :: RetType ()
retVoid :: RetType ()
retVoid     = ((Ptr CType -> Ptr CValue -> IO ()) -> IO ()) -> RetType ()
forall a. ((Ptr CType -> Ptr CValue -> IO ()) -> IO a) -> RetType a
RetType (\Ptr CType -> Ptr CValue -> IO ()
write -> Ptr CType -> Ptr CValue -> IO ()
write Ptr CType
ffi_type_void Ptr CValue
forall a. Ptr a
nullPtr IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

retCInt     :: RetType CInt
retCInt :: RetType CInt
retCInt     = Ptr CType -> RetType CInt
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_sint
retCUInt    :: RetType CUInt
retCUInt :: RetType CUInt
retCUInt    = Ptr CType -> RetType CUInt
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_uint
retCLong    :: RetType CLong
retCLong :: RetType CLong
retCLong    = Ptr CType -> RetType CLong
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_slong
retCULong   :: RetType CULong
retCULong :: RetType CULong
retCULong   = Ptr CType -> RetType CULong
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_ulong

retInt8     :: RetType Int8
retInt8 :: RetType Int8
retInt8     = Ptr CType -> RetType Int8
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_sint8
retInt16    :: RetType Int16
retInt16 :: RetType Int16
retInt16    = Ptr CType -> RetType Int16
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_sint16
retInt32    :: RetType Int32
retInt32 :: RetType Int32
retInt32    = Ptr CType -> RetType Int32
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_sint32
retInt64    :: RetType Int64
retInt64 :: RetType Int64
retInt64    = Ptr CType -> RetType Int64
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_sint64

retWord8    :: RetType Word8
retWord8 :: RetType Word8
retWord8    = Ptr CType -> RetType Word8
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_uint8
retWord16   :: RetType Word16
retWord16 :: RetType Word16
retWord16   = Ptr CType -> RetType Word16
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_uint16
retWord32   :: RetType Word32
retWord32 :: RetType Word32
retWord32   = Ptr CType -> RetType Word32
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_uint32
retWord64   :: RetType Word64
retWord64 :: RetType Word64
retWord64   = Ptr CType -> RetType Word64
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_uint64

retCFloat   :: RetType CFloat
retCFloat :: RetType CFloat
retCFloat   = Ptr CType -> RetType CFloat
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_float
retCDouble  :: RetType CDouble
retCDouble :: RetType CDouble
retCDouble  = Ptr CType -> RetType CDouble
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_double

retCSize    :: RetType CSize
retCSize :: RetType CSize
retCSize    = Ptr CType -> RetType CSize
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_size
retCTime    :: RetType CTime
retCTime :: RetType CTime
retCTime    = Ptr CType -> RetType CTime
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_time

retCChar    :: RetType CChar
retCChar :: RetType CChar
retCChar    = Ptr CType -> RetType CChar
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_schar
retCUChar   :: RetType CUChar
retCUChar :: RetType CUChar
retCUChar   = Ptr CType -> RetType CUChar
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_uchar

retCWchar   :: RetType CWchar
retCWchar :: RetType CWchar
retCWchar   = Ptr CType -> RetType CWchar
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_wchar

retFunPtr   :: RetType a -> RetType (FunPtr a)
retFunPtr :: RetType a -> RetType (FunPtr a)
retFunPtr RetType a
_ = Ptr CType -> RetType (FunPtr a)
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_pointer

retPtr      :: RetType a -> RetType (Ptr a)
retPtr :: RetType a -> RetType (Ptr a)
retPtr RetType a
_    = Ptr CType -> RetType (Ptr a)
forall a. Storable a => Ptr CType -> RetType a
mkStorableRetType Ptr CType
ffi_type_pointer

retCString          :: RetType CString
retCString :: RetType (Ptr CChar)
retCString          = RetType CChar -> RetType (Ptr CChar)
forall a. RetType a -> RetType (Ptr a)
retPtr RetType CChar
retCChar

{- | Peek a String out of the returned char *. The char * is not freed. -}
retString           :: RetType String
retString :: RetType String
retString           = (Ptr CChar -> IO String) -> RetType (Ptr CChar) -> RetType String
forall a b. (a -> IO b) -> RetType a -> RetType b
withRetType Ptr CChar -> IO String
peekCString (RetType CChar -> RetType (Ptr CChar)
forall a. RetType a -> RetType (Ptr a)
retPtr RetType CChar
retCChar)

{- | Like retString, but for ByteString's -}
retByteString       :: RetType BS.ByteString
retByteString :: RetType ByteString
retByteString       = (Ptr CChar -> IO ByteString)
-> RetType (Ptr CChar) -> RetType ByteString
forall a b. (a -> IO b) -> RetType a -> RetType b
withRetType Ptr CChar -> IO ByteString
BS.packCString (RetType CChar -> RetType (Ptr CChar)
forall a. RetType a -> RetType (Ptr a)
retPtr RetType CChar
retCChar)

{- | Make a ByteString out of the returned char *.
     The char * will be free(3)ed when the ByteString is garbage collected. -}
retMallocByteString :: RetType BS.ByteString
retMallocByteString :: RetType ByteString
retMallocByteString = (Ptr CChar -> IO ByteString)
-> RetType (Ptr CChar) -> RetType ByteString
forall a b. (a -> IO b) -> RetType a -> RetType b
withRetType Ptr CChar -> IO ByteString
BSU.unsafePackMallocCString (RetType CChar -> RetType (Ptr CChar)
forall a. RetType a -> RetType (Ptr a)
retPtr RetType CChar
retCChar)