module Graphics.QML.DataModel (
registerHaskellModel
, setupDataModel
, finalizeDataModel
, setRowCountCallback
, setDataCallback
, setHeaderDataCallback
, DataModel
, delegate
, FFI.HmDelegateHandle
, QtTable(..)
, SetupColumns(..)
, ColumnIndexException(..)
, RowCountCallback
, DataCallback
, HeaderDataCallback
) where
import qualified Graphics.QML.DataModel.Internal.FFI as FFI
import Graphics.QML.DataModel.Internal.Types
import Graphics.QML.DataModel.Internal.Generic
import Control.Concurrent.MVar
import Control.Monad
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
registerHaskellModel :: IO ()
registerHaskellModel = FFI.c_registerHaskellModel
traverseCallbacks
:: DataModel a
-> (FFI.HmCallbacks -> IO FFI.HmCallbacks)
-> IO ()
traverseCallbacks model action = withMVar (callbacks model)
$ \cbs'ptr -> poke cbs'ptr =<< action =<< peek cbs'ptr
setupDataModel :: forall a. (SetupColumns a, CountFields a) => IO (DataModel a)
setupDataModel = do
cbs <- FFI.HmCallbacks
<$> FFI.emptyRowCountCallback
<*> makeColumnCountCallback (return $ countFields template)
<*> FFI.emptyDataCallback
<*> FFI.emptyHeaderDataCallback
cbs'ptr <- malloc
poke cbs'ptr cbs
cbs'mv <- newMVar cbs'ptr
dlg <- FFI.c_registerHaskellModelDelegate
setupColumns dlg template
FFI.c_setHaskellModelCallbacks dlg cbs'ptr
return $ DataModel
{ callbacks = cbs'mv
, delegate = dlg
}
where template :: sing a
template = undefined
finalizeDataModel :: DataModel a -> IO ()
finalizeDataModel model = do
FFI.c_unregisterHaskellModelDelegate $ delegate model
free =<< readMVar (callbacks model)
setRowCountCallback :: DataModel a -> RowCountCallback -> IO ()
setRowCountCallback model rowCb = traverseCallbacks model $ \cbs -> do
freeHaskellFunPtr $ FFI.rowCountCallback cbs
newRowCb <- makeRowCountCallback rowCb
return cbs { FFI.rowCountCallback = newRowCb }
makeRowCountCallback :: RowCountCallback -> IO (FunPtr FFI.RowCountCallback)
makeRowCountCallback cb = FFI.c_createRowCountCallback $ fromIntegral <$> cb
makeColumnCountCallback :: ColumnCountCallback -> IO (FunPtr FFI.ColumnCountCallback)
makeColumnCountCallback cb = FFI.c_createColumnCountCallback $ fromIntegral <$> cb
setDataCallback :: QtTable a => DataModel a -> DataCallback a -> IO ()
setDataCallback model dataCb = traverseCallbacks model $ \cbs -> do
freeHaskellFunPtr $ FFI.dataCallback cbs
newDataCb <- makeDataCallback dataCb
return cbs { FFI.dataCallback = newDataCb }
makeDataCallback :: QtTable a => DataCallback a -> IO (FunPtr FFI.DataCallback)
makeDataCallback cb = FFI.c_createDataCallback
$ \row column -> getColumn (fromIntegral column) =<< cb (fromIntegral row)
setHeaderDataCallback :: DataModel a -> HeaderDataCallback -> IO ()
setHeaderDataCallback model headerDataCb = traverseCallbacks model $ \cbs -> do
freeHaskellFunPtr $ FFI.headerDataCallback cbs
newHeaderDataCb <- makeHeaderDataCallback headerDataCb
return cbs { FFI.headerDataCallback = newHeaderDataCb }
makeHeaderDataCallback :: HeaderDataCallback -> IO (FunPtr FFI.HeaderDataCallback)
makeHeaderDataCallback cb = FFI.c_createHeaderDataCallback
$ FFI.newQtString <=< cb <=< return.fromIntegral