{-# OPTIONS_HADDOCK show-extensions #-}

{-# LANGUAGE
    ExplicitForAll
  , ScopedTypeVariables
  #-}

{-|
Module      : Graphics.QML.DataModel
Copyright   : (c) Marcin Mrotek, 2015
License     : BSD3
Maintainer  : marcin.jan.mrotek@gmail.com
Stability   : experimental

Main module. Should be enough for most uses.
-}


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 ()
-- ^Register the HaskellModel in QML's type system, so it can be used in .qml documents.
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)
-- ^Create a data model handle that can be passed to HaskellModel.
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 ()
-- ^Free a data model handle.
finalizeDataModel model = do
  FFI.c_unregisterHaskellModelDelegate $ delegate model
  free =<< readMVar (callbacks model)

setRowCountCallback :: DataModel a -> RowCountCallback -> IO ()
-- ^Replace the row count callback of a data model handle.
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

{-
setColumnCountCallback :: DataModel a -> ColumnCountCallback -> IO ()
setColumnCountCallback model columnCb = traverseCallbacks model $ \cbs -> do
  freeHaskellFunPtr $ FFI.columnCountCallback cbs
  newColumnCb <- makeColumnCountCallback columnCb
  return cbs { FFI.columnCountCallback = newColumnCb }
-}

makeColumnCountCallback :: ColumnCountCallback -> IO (FunPtr FFI.ColumnCountCallback)
makeColumnCountCallback cb = FFI.c_createColumnCountCallback $ fromIntegral <$> cb

setDataCallback :: QtTable a => DataModel a -> DataCallback a -> IO ()
-- ^Replace the data callback of a data model handle.
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 ()
-- ^Replace the header data callback of a data model handle. Not used by any QML views.
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