{-# LINE 1 "./Graphics/UI/Gtk/ModelView/CustomStore.chs" #-}
module Graphics.UI.Gtk.ModelView.CustomStore (
  
  CustomStore,
  TreeModelFlags(..),
  TreeModelIface(..),
  DragSourceIface(..),
  DragDestIface(..),
  customStoreNew,
  customStoreGetRow,
  customStoreSetColumn,
  customStoreGetPrivate,
  customStoreGetStamp,
  customStoreInvalidateIters,
  
  treeModelGetRow,
  treeModelSetColumn,
  ) where
import Control.Monad                            (liftM)
import Control.Monad.Reader                     (runReaderT)
import Data.IORef                               (IORef, newIORef, readIORef, writeIORef)
import Data.Maybe                               (fromMaybe)
import System.Glib.FFI                  hiding  (maybeNull)
import System.Glib.Flags                        (Flags, fromFlags)
import Graphics.UI.Gtk.Types
{-# LINE 59 "./Graphics/UI/Gtk/ModelView/CustomStore.chs" #-}
import Graphics.UI.Gtk.ModelView.Types
{-# LINE 60 "./Graphics/UI/Gtk/ModelView/CustomStore.chs" #-}
import Graphics.UI.Gtk.General.DNDTypes         (SelectionDataM, SelectionData)
import System.Glib.GValue                   (GValue(GValue))
import System.Glib.GType                    (GType)
import qualified System.Glib.GTypeConstants as GConst
import System.Glib.GValueTypes
{-# LINE 66 "./Graphics/UI/Gtk/ModelView/CustomStore.chs" #-}
import System.Glib.GValue                   (valueInit)
{-# LINE 69 "./Graphics/UI/Gtk/ModelView/CustomStore.chs" #-}
data TreeModelFlags = TreeModelItersPersist
                    | TreeModelListOnly
                    deriving (Bounded)
instance Enum TreeModelFlags where
  fromEnum TreeModelItersPersist = 1
  fromEnum TreeModelListOnly = 2
  toEnum 1 = TreeModelItersPersist
  toEnum 2 = TreeModelListOnly
  toEnum unmatched = error ("TreeModelFlags.toEnum: Cannot match " ++ show unmatched)
  succ TreeModelItersPersist = TreeModelListOnly
  succ _ = undefined
  pred TreeModelListOnly = TreeModelItersPersist
  pred _ = undefined
  enumFromTo x y | fromEnum x == fromEnum y = [ y ]
                 | otherwise = x : enumFromTo (succ x) y
  enumFrom x = enumFromTo x TreeModelListOnly
  enumFromThen _ _ =     error "Enum TreeModelFlags: enumFromThen not implemented"
  enumFromThenTo _ _ _ =     error "Enum TreeModelFlags: enumFromThenTo not implemented"
{-# LINE 81 "./Graphics/UI/Gtk/ModelView/CustomStore.chs" #-}
instance Flags TreeModelFlags
newtype CustomStore private row = CustomStore (ForeignPtr (CustomStore private row))
instance TreeModelClass (CustomStore private row)
instance GObjectClass (CustomStore private row) where
  toGObject (CustomStore tm) = GObject (castForeignPtr tm)
  unsafeCastGObject = CustomStore . castForeignPtr . unGObject
type ColumnMap row = IORef [ColumnAccess row]
columnMapNew :: IO (ColumnMap row)
columnMapNew = newIORef []
customStoreSetColumn :: TypedTreeModelClass model
        => model row 
        -> (ColumnId row ty) 
        -> (row -> ty) 
        -> IO ()
customStoreSetColumn model (ColumnId _ setter colId) acc | colId<0 = return ()
                                                         | otherwise =
  case toTypedTreeModel model of
    TypedTreeModel model -> do
      ptr <- withForeignPtr model gtk2hs_store_get_impl
      impl <- deRefStablePtr ptr
      let cMap = customStoreColumns impl
      cols <- readIORef cMap
      let l = length cols
      if colId>=l then do
         let fillers = replicate (colId-l) CAInvalid
         writeIORef cMap (cols++fillers++[setter acc])
       else do
         let (beg,_:end) = splitAt colId cols
         writeIORef cMap (beg++setter acc:end)
treeModelSetColumn :: TypedTreeModelClass model
        => model row 
        -> (ColumnId row ty) 
        -> (row -> ty) 
        -> IO ()
treeModelSetColumn = customStoreSetColumn
data CustomStoreImplementation model row = CustomStoreImplementation {
    customStoreColumns          :: ColumnMap row,                       
    customStoreIface            :: TreeModelIface row,            
    customTreeDragSourceIface   :: DragSourceIface model row,     
    customTreeDragDestIface     :: DragDestIface model row        
  }
data TreeModelIface row = TreeModelIface {
    
    treeModelIfaceGetFlags      :: IO [TreeModelFlags],
    
    
    treeModelIfaceGetIter       :: TreePath -> IO (Maybe TreeIter),              
    
    treeModelIfaceGetPath       :: TreeIter -> IO TreePath,                      
    
    treeModelIfaceGetRow        :: TreeIter -> IO row,                           
    
    
    treeModelIfaceIterNext      :: TreeIter -> IO (Maybe TreeIter),              
    
    
    treeModelIfaceIterChildren  :: Maybe TreeIter -> IO (Maybe TreeIter),        
    
    treeModelIfaceIterHasChild  :: TreeIter -> IO Bool,                          
    
    treeModelIfaceIterNChildren :: Maybe TreeIter -> IO Int,                     
    
    
    treeModelIfaceIterNthChild  :: Maybe TreeIter -> Int -> IO (Maybe TreeIter), 
    
    treeModelIfaceIterParent    :: TreeIter -> IO (Maybe TreeIter),              
    
    
    
    
        
    treeModelIfaceRefNode       :: TreeIter -> IO (),                            
    
    treeModelIfaceUnrefNode     :: TreeIter -> IO ()                             
  }
data DragSourceIface model row = DragSourceIface {
    
    
    
    treeDragSourceRowDraggable  :: model row -> TreePath -> IO Bool,                 
    
    
    
    treeDragSourceDragDataGet   :: model row -> TreePath -> SelectionDataM Bool,     
    
    
    treeDragSourceDragDataDelete:: model row -> TreePath -> IO Bool                  
  }
data DragDestIface model row = DragDestIface {
    
    
    treeDragDestRowDropPossible :: model row -> TreePath -> SelectionDataM Bool,     
    
    
    
    treeDragDestDragDataReceived:: model row -> TreePath -> SelectionDataM Bool      
  }
customStoreNew :: (TreeModelClass (model row), TypedTreeModelClass model) =>
     private   
  -> ((CustomStore private row) -> model row)
  -> TreeModelIface row         
  -> Maybe (DragSourceIface model row)
                                
  -> Maybe (DragDestIface model row)
                                
  -> IO (model row)
customStoreNew priv con tmIface mDragSource mDragDest = do
  cMap <- columnMapNew
  let dummyDragSource = DragSourceIface { treeDragSourceRowDraggable = \_ _ -> return False,
                                          treeDragSourceDragDataGet  = \_ _ -> return False,
                                          treeDragSourceDragDataDelete = \_ _ -> return False }
  let dummyDragDest = DragDestIface { treeDragDestRowDropPossible = \_ _ -> return False,
                                      treeDragDestDragDataReceived = \_ _ -> return False }
  implPtr <- newStablePtr CustomStoreImplementation {
        customStoreColumns = cMap,
        customStoreIface = tmIface,
        customTreeDragSourceIface = fromMaybe dummyDragSource mDragSource,
        customTreeDragDestIface = fromMaybe dummyDragDest mDragDest }
  privPtr <- newStablePtr priv
  liftM con $ wrapNewGObject (CustomStore, objectUnref) $
    gtk2hs_store_new implPtr privPtr
foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_new"
  gtk2hs_store_new :: StablePtr (CustomStoreImplementation model row)
                   -> StablePtr private
                   -> IO (Ptr (CustomStore private row))
customStoreGetRow :: TypedTreeModelClass model => model row -> TreeIter -> IO row
customStoreGetRow model iter =
  case toTypedTreeModel model of
    TypedTreeModel model -> do
      impl <- withForeignPtr model gtk2hs_store_get_impl >>= deRefStablePtr
      treeModelIfaceGetRow (customStoreIface impl) iter
treeModelGetRow :: TypedTreeModelClass model => model row -> TreeIter -> IO row
treeModelGetRow = customStoreGetRow
foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_get_impl"
  gtk2hs_store_get_impl :: Ptr (TypedTreeModel row) -> IO (StablePtr (CustomStoreImplementation model row))
customStoreGetPrivate :: CustomStore private row -> private
customStoreGetPrivate (CustomStore model) =
  unsafePerformIO $ 
                    
  withForeignPtr model gtk2hs_store_get_priv >>= deRefStablePtr
foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_get_priv"
  gtk2hs_store_get_priv :: Ptr (CustomStore private row) -> IO (StablePtr private)
customStoreGetStamp :: CustomStore private row -> IO CInt
customStoreGetStamp (CustomStore model) =
  withForeignPtr model gtk2hs_store_get_stamp
foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_get_stamp"
  gtk2hs_store_get_stamp :: Ptr (CustomStore private row) -> IO CInt
customStoreInvalidateIters :: CustomStore private row -> IO ()
customStoreInvalidateIters (CustomStore model) =
  withForeignPtr model gtk2hs_store_increment_stamp
foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_increment_stamp"
  gtk2hs_store_increment_stamp :: Ptr (CustomStore private row) -> IO ()
treeModelIfaceGetNColumns_static :: StablePtr (CustomStoreImplementation model row) -> IO CInt
treeModelIfaceGetNColumns_static storePtr = do
  store <- deRefStablePtr storePtr
  cmap <- readIORef (customStoreColumns store)
  return (fromIntegral (length cmap))
foreign export ccall "gtk2hs_store_get_n_columns_impl"
  treeModelIfaceGetNColumns_static :: StablePtr (CustomStoreImplementation model row) -> IO CInt
caToGType :: ColumnAccess row -> GType
caToGType (CAInt _) = GConst.int
caToGType (CABool _) = GConst.bool
caToGType (CAString _) = GConst.string
caToGType (CAPixbuf _) = gdk_pixbuf_get_type
{-# LINE 310 "./Graphics/UI/Gtk/ModelView/CustomStore.chs" #-}
caToGType CAInvalid = GConst.int 
treeModelIfaceGetColumnType_static :: StablePtr (CustomStoreImplementation model row) -> CInt -> IO GType
treeModelIfaceGetColumnType_static storePtr column = do
  store <- deRefStablePtr storePtr
  cols <- readIORef (customStoreColumns store)
  case drop (fromIntegral column) cols of
     [] -> return GConst.invalid
     (ca:_) -> return (caToGType ca)
foreign export ccall "gtk2hs_store_get_column_type_impl"
  treeModelIfaceGetColumnType_static :: StablePtr (CustomStoreImplementation model row) -> CInt -> IO GType
treeModelIfaceGetFlags_static :: StablePtr (CustomStoreImplementation model row) -> IO CInt
treeModelIfaceGetFlags_static storePtr = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  liftM (fromIntegral . fromFlags) $ treeModelIfaceGetFlags store
foreign export ccall "gtk2hs_store_get_flags_impl"
  treeModelIfaceGetFlags_static :: StablePtr (CustomStoreImplementation model row) -> IO CInt
treeModelIfaceGetIter_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr NativeTreePath -> IO CInt
treeModelIfaceGetIter_static storePtr iterPtr pathPtr = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  path <- peekTreePath pathPtr
  iter <- treeModelIfaceGetIter store path
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)
foreign export ccall "gtk2hs_store_get_iter_impl"
  treeModelIfaceGetIter_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr NativeTreePath -> IO CInt
treeModelIfaceGetPath_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO (Ptr NativeTreePath)
treeModelIfaceGetPath_static storePtr iterPtr = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  iter <- peek iterPtr
  path <- treeModelIfaceGetPath store iter
  NativeTreePath pathPtr <- newTreePath path
  return pathPtr
foreign export ccall "gtk2hs_store_get_path_impl"
  treeModelIfaceGetPath_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO (Ptr NativeTreePath)
treeModelIfaceGetValue_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> CInt -> Ptr GValue -> IO ()
treeModelIfaceGetValue_static storePtr iterPtr column gvaluePtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  row <- treeModelIfaceGetRow (customStoreIface store) iter
  cols <- readIORef (customStoreColumns store)
  let gVal = (GValue gvaluePtr)
  0 <- (\ptr -> do {peekByteOff ptr 0 ::IO CULong}) gvaluePtr
  case drop (fromIntegral column) cols of
    [] -> valueInit gVal GConst.invalid 
    (acc:_) -> case acc of
      (CAInt ca) -> valueInit gVal GConst.int >> valueSetInt gVal (ca row)
      (CABool ca) -> valueInit gVal GConst.bool >> valueSetBool gVal (ca row)
      (CAString ca) -> valueInit gVal GConst.string >> valueSetString gVal (ca row)
      (CAPixbuf ca) -> valueInit gVal gdk_pixbuf_get_type >>
                        valueSetGObject gVal (ca row)
      CAInvalid -> valueInit gVal GConst.int >> valueSetInt gVal 0
foreign export ccall "gtk2hs_store_get_value_impl"
  treeModelIfaceGetValue_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> CInt -> Ptr GValue -> IO ()
treeModelIfaceIterNext_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt
treeModelIfaceIterNext_static storePtr iterPtr = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  iter <- peek iterPtr
  iter' <- treeModelIfaceIterNext store iter
  case iter' of
    Nothing    -> return (fromBool False)
    Just iter' -> do poke iterPtr iter'
                     return (fromBool True)
foreign export ccall "gtk2hs_store_iter_next_impl"
  treeModelIfaceIterNext_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt
treeModelIfaceIterChildren_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> IO CInt
treeModelIfaceIterChildren_static storePtr iterPtr parentIterPtr = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  parentIter <- maybeNull peek parentIterPtr
  iter <- treeModelIfaceIterChildren store parentIter
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)
foreign export ccall "gtk2hs_store_iter_children_impl"
  treeModelIfaceIterChildren_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> IO CInt
treeModelIfaceIterHasChild_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt
treeModelIfaceIterHasChild_static storePtr iterPtr = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  iter <- peek iterPtr
  liftM fromBool $ treeModelIfaceIterHasChild store iter
foreign export ccall "gtk2hs_store_iter_has_child_impl"
  treeModelIfaceIterHasChild_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt
treeModelIfaceIterNChildren_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt
treeModelIfaceIterNChildren_static storePtr iterPtr = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  iter <- maybeNull peek iterPtr
  liftM fromIntegral $ treeModelIfaceIterNChildren store iter
foreign export ccall "gtk2hs_store_iter_n_children_impl"
  treeModelIfaceIterNChildren_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt
treeModelIfaceIterNthChild_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> CInt -> IO CInt
treeModelIfaceIterNthChild_static storePtr iterPtr parentIterPtr n = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  parentIter <- maybeNull peek parentIterPtr
  iter <- treeModelIfaceIterNthChild store parentIter (fromIntegral n)
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)
foreign export ccall "gtk2hs_store_iter_nth_child_impl"
  treeModelIfaceIterNthChild_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> CInt -> IO CInt
treeModelIfaceIterParent_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> IO CInt
treeModelIfaceIterParent_static  storePtr iterPtr childIterPtr = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  childIter <- peek childIterPtr
  iter <- treeModelIfaceIterParent store childIter
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)
foreign export ccall "gtk2hs_store_iter_parent_impl"
  treeModelIfaceIterParent_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> IO CInt
treeModelIfaceRefNode_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO ()
treeModelIfaceRefNode_static storePtr iterPtr = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  iter <- peek iterPtr
  treeModelIfaceRefNode store iter
foreign export ccall "gtk2hs_store_ref_node_impl"
  treeModelIfaceRefNode_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO ()
treeModelIfaceUnrefNode_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO ()
treeModelIfaceUnrefNode_static storePtr iterPtr = do
  store <- liftM customStoreIface $ deRefStablePtr storePtr
  iter <- peek iterPtr
  treeModelIfaceUnrefNode store iter
foreign export ccall "gtk2hs_store_unref_node_impl"
  treeModelIfaceUnrefNode_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO ()
treeDragSourceRowDraggable_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> IO CInt
treeDragSourceRowDraggable_static mPtr storePtr pathPtr = do
  model <- makeNewGObject mkTreeModel (return mPtr)
  store <- liftM customTreeDragSourceIface $ deRefStablePtr storePtr
  path <- peekTreePath pathPtr
  liftM fromBool $ treeDragSourceRowDraggable store (unsafeTreeModelToGeneric model) path
foreign export ccall "gtk2hs_store_row_draggable_impl"
  treeDragSourceRowDraggable_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> IO CInt
treeDragSourceDragDataGet_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt
treeDragSourceDragDataGet_static mPtr storePtr pathPtr selectionPtr = do
  model <- makeNewGObject mkTreeModel (return mPtr)
  store <- liftM customTreeDragSourceIface $ deRefStablePtr storePtr
  path <- peekTreePath pathPtr
  liftM fromBool $ runReaderT (treeDragSourceDragDataGet store (unsafeTreeModelToGeneric model) path) selectionPtr
foreign export ccall "gtk2hs_store_drag_data_get_impl"
  treeDragSourceDragDataGet_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt
treeDragSourceDragDataDelete_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> IO CInt
treeDragSourceDragDataDelete_static mPtr storePtr pathPtr = do
  model <- makeNewGObject mkTreeModel (return mPtr)
  store <- liftM customTreeDragSourceIface $ deRefStablePtr storePtr
  path <- peekTreePath pathPtr
  liftM fromBool $ treeDragSourceDragDataDelete store (unsafeTreeModelToGeneric model) path
foreign export ccall "gtk2hs_store_drag_data_delete_impl"
  treeDragSourceDragDataDelete_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> IO CInt
treeDragDestDragDataReceived_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt
treeDragDestDragDataReceived_static mPtr storePtr pathPtr selectionPtr = do
  model <- makeNewGObject mkTreeModel (return mPtr)
  store <- liftM customTreeDragDestIface $ deRefStablePtr storePtr
  path <- peekTreePath pathPtr
  liftM fromBool $ runReaderT (treeDragDestDragDataReceived store (unsafeTreeModelToGeneric model) path) selectionPtr
foreign export ccall "gtk2hs_store_drag_data_received_impl"
  treeDragDestDragDataReceived_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt
treeDragDestRowDropPossible_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt
treeDragDestRowDropPossible_static mPtr storePtr pathPtr selectionPtr = do
  model <- makeNewGObject mkTreeModel (return mPtr)
  store <- liftM customTreeDragDestIface $ deRefStablePtr storePtr
  path <- peekTreePath pathPtr
  liftM fromBool $ runReaderT (treeDragDestRowDropPossible store (unsafeTreeModelToGeneric model) path) selectionPtr
foreign export ccall "gtk2hs_store_row_drop_possible_impl"
  treeDragDestRowDropPossible_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt
maybeNull :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybeNull marshal ptr
  | ptr == nullPtr = return Nothing
  | otherwise      = liftM Just (marshal ptr)
foreign import ccall unsafe "gdk_pixbuf_get_type"
  gdk_pixbuf_get_type :: CULong