{-# LINE 1 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, TypeFamilies #-}
{-# LINE 2 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}

module Graphics.QML.DataModel.Internal.FFI.Types where

import Foreign.C.Types
import Foreign.Storable
import Foreign.Ptr
import Graphics.QML.Marshal

-- |Identifier of a HaskellModel delegate handle.
newtype HmDelegateHandle = HmDelegateHandle CInt
-- |Pointer to a QVariant type.
newtype QtVariant = QtVariant (Ptr CChar)
-- |Identifier of a column type.
newtype HmColumnType = HmColumnType CInt
  deriving (Eq, Show)

instance Marshal HmDelegateHandle where
  type MarshalMode HmDelegateHandle c d = ModeBidi c
  marshaller = bidiMarshaller 
    (\i -> HmDelegateHandle (CInt i))
    (\(HmDelegateHandle (CInt i)) -> i)

-- |Used by QML to query the number of rows in a model.
type RowCountCallback    = IO CInt
-- |Used by QML to query the number of columns in a model.
type ColumnCountCallback = IO CInt
-- |Used by QML to obtain a row at the given index.
type DataCallback        = CInt -> CInt -> IO QtVariant
-- |Used by QML to obtain the name of the column at the given index.
type HeaderDataCallback  = CInt -> IO QtVariant

-- |C struct storing HaskellModel callbacks.
data HmCallbacks = HmCallbacks
  { rowCountCallback    :: FunPtr RowCountCallback
  , columnCountCallback :: FunPtr ColumnCountCallback
  , dataCallback        :: FunPtr DataCallback
  , headerDataCallback  :: FunPtr HeaderDataCallback
  }


{-# LINE 42 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}

instance Storable HmCallbacks where
  sizeOf     _ = (32)
{-# LINE 45 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}
  alignment  _ = alignment (undefined :: CInt)
  poke ptr hmc = do
         (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr $ rowCountCallback    hmc
{-# LINE 48 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}
         (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr $ columnCountCallback hmc
{-# LINE 49 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}
         (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr $ dataCallback        hmc
{-# LINE 50 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}
         (\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr $ headerDataCallback  hmc
{-# LINE 51 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}
  peek ptr = HmCallbacks
         <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 53 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}
         <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 54 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}
         <*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 55 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}
         <*> ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 56 "src/Graphics/QML/DataModel/Internal/FFI/Types.hsc" #-}