-- GENERATED by C->Haskell Compiler, version 0.13.13 (gtk2hs branch) "Bin IO", 27 May 2012 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Graphics/UI/Gtk/ModelView/CustomStore.chs" #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) CustomStore TreeModel
--
--  Author : Duncan Coutts, Axel Simon
--
--  Created: 19 Sep 2005
--
--  Copyright (C) 2005 Duncan Coutts, Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
-- #prune

-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Allows a custom data structure to be used with the 'TreeView' and other
-- widgets that follow the model-view-controller paradigm. The two models
-- 'Graphics.UI.Gtk.ModelView.ListStore.ListStore' and
-- 'Graphics.UI.Gtk.ModelView.TreeStore.TreeStore' are based on the
-- 'CustomStore'. Even if no application-specific tree model
-- should be implemented, this module is relevant in that it provides the
-- functions 'customStoreSetColumn' and
-- 'customStoreGetRow' functions.
--
module Graphics.UI.Gtk.ModelView.CustomStore (
  -- * The definition of a row-based store.
  CustomStore,
  TreeModelFlags(..),
  TreeModelIface(..),
  DragSourceIface(..),
  DragDestIface(..),
  customStoreNew,
  customStoreGetRow,
  customStoreSetColumn,
  customStoreGetPrivate,
  customStoreGetStamp,
  customStoreInvalidateIters,
  -- for backwards compatability, not documented
  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" #-}

-- | These flags indicate various properties of a
-- 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel'.
--
-- * If a model has 'TreeModelItersPersist' set, iterators remain valid after
--   a 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel' signal was emitted.
--
-- * The 'TreeModelListOnly' flag is set if the rows are arranged in a simple
--   flat list. This is set in the
--   'Graphics.UI.Gtk.ModelView.ListStore.ListStore' implementation.
--
data TreeModelFlags = TreeModelItersPersist
                    | TreeModelListOnly
                    deriving (TreeModelFlags
TreeModelFlags -> TreeModelFlags -> Bounded TreeModelFlags
forall a. a -> a -> Bounded a
$cminBound :: TreeModelFlags
minBound :: TreeModelFlags
$cmaxBound :: TreeModelFlags
maxBound :: TreeModelFlags
Bounded)
instance Enum TreeModelFlags where
  fromEnum :: TreeModelFlags -> Int
fromEnum TreeModelFlags
TreeModelItersPersist = Int
1
  fromEnum TreeModelFlags
TreeModelListOnly = Int
2

  toEnum :: Int -> TreeModelFlags
toEnum Int
1 = TreeModelFlags
TreeModelItersPersist
  toEnum Int
2 = TreeModelFlags
TreeModelListOnly
  toEnum Int
unmatched = [Char] -> TreeModelFlags
forall a. HasCallStack => [Char] -> a
error ([Char]
"TreeModelFlags.toEnum: Cannot match " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
unmatched)

  succ :: TreeModelFlags -> TreeModelFlags
succ TreeModelFlags
TreeModelItersPersist = TreeModelFlags
TreeModelListOnly
  succ TreeModelFlags
_ = TreeModelFlags
forall a. HasCallStack => a
undefined

  pred :: TreeModelFlags -> TreeModelFlags
pred TreeModelFlags
TreeModelListOnly = TreeModelFlags
TreeModelItersPersist
  pred TreeModelFlags
_ = TreeModelFlags
forall a. HasCallStack => a
undefined

  enumFromTo x y | fromEnum x == fromEnum y = [ y ]
                 | otherwise = x : enumFromTo (succ x) y
  enumFrom :: TreeModelFlags -> [TreeModelFlags]
enumFrom TreeModelFlags
x = TreeModelFlags -> TreeModelFlags -> [TreeModelFlags]
forall a. Enum a => a -> a -> [a]
enumFromTo TreeModelFlags
x TreeModelFlags
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

-- A 'CustomStore' is backed by a Gtk2HsStore
-- which is an instance of the GtkTreeModel GInterface
-- it also stores some extra per-model-type private data

-- | A 'CustomStore' is an instance of a Gtk+ 'TreeModel' and can thus be used
--   for any widget that stores data in a 'TreeModel'. The user may either
--   create an instance of a 'CustomStore' or use one of the pre-defined
--   models 'Graphics.UI.Gtk.ModelView.ListStore.ListStore' or
--   'Graphics.UI.Gtk.ModelView.TreeStore.TreeStore'.
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 synonym for viewing the store as a set of columns.
type ColumnMap row = IORef [ColumnAccess row]

-- | Create a new 'ColumnMap' value.
columnMapNew :: IO (ColumnMap row)
columnMapNew :: forall row. IO (ColumnMap row)
columnMapNew = [ColumnAccess row] -> IO (IORef [ColumnAccess row])
forall a. a -> IO (IORef a)
newIORef []

-- | Set or update a column mapping. This function should be used before
--   the model is installed into a widget since the number of defined
--   columns are only checked once by widgets.
customStoreSetColumn :: TypedTreeModelClass model
        => model row -- ^ the store in which to allocate a new column
        -> (ColumnId row ty) -- ^ the column that should be set
        -> (row -> ty) -- ^ the function that sets the property
        -> IO ()
customStoreSetColumn :: forall (model :: * -> *) row ty.
TypedTreeModelClass model =>
model row -> ColumnId row ty -> (row -> ty) -> IO ()
customStoreSetColumn model row
model (ColumnId GValue -> IO ty
_ (row -> ty) -> ColumnAccess row
setter Int
colId) row -> ty
acc | Int
colIdInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                                         | Bool
otherwise =
  case model row -> TypedTreeModel row
forall (model :: * -> *) row.
TypedTreeModelClass model =>
model row -> TypedTreeModel row
toTypedTreeModel model row
model of
    TypedTreeModel ForeignPtr (TypedTreeModel row)
model -> do
      StablePtr (CustomStoreImplementation Any row)
ptr <- ForeignPtr (TypedTreeModel row)
-> (Ptr (TypedTreeModel row)
    -> IO (StablePtr (CustomStoreImplementation Any row)))
-> IO (StablePtr (CustomStoreImplementation Any row))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (TypedTreeModel row)
model Ptr (TypedTreeModel row)
-> IO (StablePtr (CustomStoreImplementation Any row))
forall row (model :: * -> *).
Ptr (TypedTreeModel row)
-> IO (StablePtr (CustomStoreImplementation model row))
gtk2hs_store_get_impl
      CustomStoreImplementation Any row
impl <- StablePtr (CustomStoreImplementation Any row)
-> IO (CustomStoreImplementation Any row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation Any row)
ptr
      let cMap :: ColumnMap row
cMap = CustomStoreImplementation Any row -> ColumnMap row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> ColumnMap row
customStoreColumns CustomStoreImplementation Any row
impl
      [ColumnAccess row]
cols <- ColumnMap row -> IO [ColumnAccess row]
forall a. IORef a -> IO a
readIORef ColumnMap row
cMap
      let l :: Int
l = [ColumnAccess row] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColumnAccess row]
cols
      if Int
colIdInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
l then do
         let fillers :: [ColumnAccess row]
fillers = Int -> ColumnAccess row -> [ColumnAccess row]
forall a. Int -> a -> [a]
replicate (Int
colIdInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l) ColumnAccess row
forall row. ColumnAccess row
CAInvalid
         ColumnMap row -> [ColumnAccess row] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef ColumnMap row
cMap ([ColumnAccess row]
cols[ColumnAccess row] -> [ColumnAccess row] -> [ColumnAccess row]
forall a. [a] -> [a] -> [a]
++[ColumnAccess row]
forall {row}. [ColumnAccess row]
fillers[ColumnAccess row] -> [ColumnAccess row] -> [ColumnAccess row]
forall a. [a] -> [a] -> [a]
++[(row -> ty) -> ColumnAccess row
setter row -> ty
acc])
       else do
         let ([ColumnAccess row]
beg,ColumnAccess row
_:[ColumnAccess row]
end) = Int
-> [ColumnAccess row] -> ([ColumnAccess row], [ColumnAccess row])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
colId [ColumnAccess row]
cols
         ColumnMap row -> [ColumnAccess row] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef ColumnMap row
cMap ([ColumnAccess row]
beg[ColumnAccess row] -> [ColumnAccess row] -> [ColumnAccess row]
forall a. [a] -> [a] -> [a]
++(row -> ty) -> ColumnAccess row
setter row -> ty
accColumnAccess row -> [ColumnAccess row] -> [ColumnAccess row]
forall a. a -> [a] -> [a]
:[ColumnAccess row]
end)

-- this is a backwards compatability definition
treeModelSetColumn :: TypedTreeModelClass model
        => model row -- ^ the store in which to allocate a new column
        -> (ColumnId row ty) -- ^ the column that should be set
        -> (row -> ty) -- ^ the function that sets the property
        -> IO ()
treeModelSetColumn :: forall (model :: * -> *) row ty.
TypedTreeModelClass model =>
model row -> ColumnId row ty -> (row -> ty) -> IO ()
treeModelSetColumn = model row -> ColumnId row ty -> (row -> ty) -> IO ()
forall (model :: * -> *) row ty.
TypedTreeModelClass model =>
model row -> ColumnId row ty -> (row -> ty) -> IO ()
customStoreSetColumn

data CustomStoreImplementation model row = CustomStoreImplementation {
    forall (model :: * -> *) row.
CustomStoreImplementation model row -> ColumnMap row
customStoreColumns          :: ColumnMap row,                       -- provide access via columns
    forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface            :: TreeModelIface row,            -- functions implementing a tree model
    forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragSourceIface model row
customTreeDragSourceIface   :: DragSourceIface model row,     -- the drag and drop source interface
    forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragDestIface model row
customTreeDragDestIface     :: DragDestIface model row        -- the drag and drop dest interface
  }

-- | The 'TreeModelIface' structure contains all functions that are required
-- to implement an application-specific 'TreeModel'.
data TreeModelIface row = TreeModelIface {
    -- | Return the flags that are valid for this model.
    forall row. TreeModelIface row -> IO [TreeModelFlags]
treeModelIfaceGetFlags      :: IO [TreeModelFlags],
    -- | Convert an path into the tree into a more concise 'TreeIter'.
    --   Return @Nothing@ if the path does not exit.
    forall row. TreeModelIface row -> TreePath -> IO (Maybe TreeIter)
treeModelIfaceGetIter       :: TreePath -> IO (Maybe TreeIter),              -- convert a path to an iterator
    -- | Convert an iterator to a path. The iterator will always be valid.
    forall row. TreeModelIface row -> TreeIter -> IO TreePath
treeModelIfaceGetPath       :: TreeIter -> IO TreePath,                      -- convert an interator to a path
    -- | Retrieve a row at the given iterator.
    forall row. TreeModelIface row -> TreeIter -> IO row
treeModelIfaceGetRow        :: TreeIter -> IO row,                           -- get the row at an iter
    -- | Advance the given iterator to the next node at the same level.
    --   Return @Nothing@ if there is no next node at this level.
    forall row. TreeModelIface row -> TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterNext      :: TreeIter -> IO (Maybe TreeIter),              -- following row (if any)
    -- | Advance the given iterator to the first child of this iterator.
    --   Return @Notihing@ if the node at this iterator has no children.
    forall row.
TreeModelIface row -> Maybe TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterChildren  :: Maybe TreeIter -> IO (Maybe TreeIter),        -- first child row (if any)
    -- | Check if the node at the given iterator has children.
    forall row. TreeModelIface row -> TreeIter -> IO Bool
treeModelIfaceIterHasChild  :: TreeIter -> IO Bool,                          -- row has any children at all
    -- | Query the number of children the the node at the given iteratore has.
    forall row. TreeModelIface row -> Maybe TreeIter -> IO Int
treeModelIfaceIterNChildren :: Maybe TreeIter -> IO Int,                     -- number of children of a row
    -- | Ask for an iterator to the @n@th child. Return @Nothing@ if
    --   no such child exists.
    forall row.
TreeModelIface row -> Maybe TreeIter -> Int -> IO (Maybe TreeIter)
treeModelIfaceIterNthChild  :: Maybe TreeIter -> Int -> IO (Maybe TreeIter), -- nth child row of a given row
    -- | Ask for an iterator to the parent of the node.
    forall row. TreeModelIface row -> TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterParent    :: TreeIter -> IO (Maybe TreeIter),              -- parent row of a row
    -- | Increase a reference count for this node. A positive reference count
    --   indicates that the node is used (that is, most likely it is visible)
    --   in at least one widget. Tracking reference counts for nodes is
    --   optional but may be useful to infer when a given row can be discarded
        --   if it was retrieved from an external source.
    forall row. TreeModelIface row -> TreeIter -> IO ()
treeModelIfaceRefNode       :: TreeIter -> IO (),                            -- caching hint
    -- | Decrement the reference count of the given node.
    forall row. TreeModelIface row -> TreeIter -> IO ()
treeModelIfaceUnrefNode     :: TreeIter -> IO ()                             -- caching hint
  }

-- | A structure containing functions that enable this widget to be used
--   as a source in drag-and-drop.
data DragSourceIface model row = DragSourceIface {
    -- | Determine if the row at the given path is draggable. Return
    --   @False@ if for some reason this row should not be dragged by
    --   the user.
    forall (model :: * -> *) row.
DragSourceIface model row -> model row -> TreePath -> IO Bool
treeDragSourceRowDraggable  :: model row -> TreePath -> IO Bool,                 -- query if the row is draggable
    -- | Fill in the 'SelectionDataM' structure with information on
    --   the given node using
    --   'Graphics.UI.Gtk.General.Selection.selectionDataSet'.
    forall (model :: * -> *) row.
DragSourceIface model row
-> model row -> TreePath -> SelectionDataM Bool
treeDragSourceDragDataGet   :: model row -> TreePath -> SelectionDataM Bool,     -- store row in selection object
    -- | The widget is informed that the row at the given path should
    --   be deleted as the result of this drag.
    forall (model :: * -> *) row.
DragSourceIface model row -> model row -> TreePath -> IO Bool
treeDragSourceDragDataDelete:: model row -> TreePath -> IO Bool                  -- instruct store to delete the row
  }

-- | A structure containing functions that enable this widget to be used
--   as a target in drag-and-drop.
data DragDestIface model row = DragDestIface {
    -- | Tell the drag-and-drop mechanism if the row can be dropped at the
    --   given path.
    forall (model :: * -> *) row.
DragDestIface model row
-> model row -> TreePath -> SelectionDataM Bool
treeDragDestRowDropPossible :: model row -> TreePath -> SelectionDataM Bool,     -- query if row drop is possible
    -- | The data in the 'SelectionDataM' structure should be read using
    --   'Graphics.UI.Gtk.General.Selection.selectionDataGet' and
    --   its information be used to insert a new row at the given path.
    forall (model :: * -> *) row.
DragDestIface model row
-> model row -> TreePath -> SelectionDataM Bool
treeDragDestDragDataReceived:: model row -> TreePath -> SelectionDataM Bool      -- insert row from selection object
  }

-- | Create a new store that implements the 'TreeModelIface' interface and
-- optionally the 'DragSourceIface' and the 'DragDestIface'. If the latter two
-- are set to @Nothing@ a dummy interface is substituted that rejects every
-- drag and drop.
customStoreNew :: (TreeModelClass (model row), TypedTreeModelClass model) =>
     private   -- ^ Any private data the store needs to store. Usually an 'IORef'.
  -> ((CustomStore private row) -> model row)
  -> TreeModelIface row         -- ^ Functions necessary to implement the 'TreeModel' interface.
  -> Maybe (DragSourceIface model row)
                                -- ^ Functions to enable this store to generate drag events.
  -> Maybe (DragDestIface model row)
                                -- ^ Functions to enable this store to receive drag events.
  -> IO (model row)
customStoreNew :: forall (model :: * -> *) row private.
(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 private
priv CustomStore private row -> model row
con TreeModelIface row
tmIface Maybe (DragSourceIface model row)
mDragSource Maybe (DragDestIface model row)
mDragDest = do
  ColumnMap row
cMap <- IO (ColumnMap row)
forall row. IO (ColumnMap row)
columnMapNew
  let dummyDragSource :: DragSourceIface model row
dummyDragSource = DragSourceIface { treeDragSourceRowDraggable :: model row -> TreePath -> IO Bool
treeDragSourceRowDraggable = \model row
_ TreePath
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
                                          treeDragSourceDragDataGet :: model row -> TreePath -> SelectionDataM Bool
treeDragSourceDragDataGet  = \model row
_ TreePath
_ -> Bool -> SelectionDataM Bool
forall a. a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
                                          treeDragSourceDragDataDelete :: model row -> TreePath -> IO Bool
treeDragSourceDragDataDelete = \model row
_ TreePath
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False }
  let dummyDragDest :: DragDestIface model row
dummyDragDest = DragDestIface { treeDragDestRowDropPossible :: model row -> TreePath -> SelectionDataM Bool
treeDragDestRowDropPossible = \model row
_ TreePath
_ -> Bool -> SelectionDataM Bool
forall a. a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
                                      treeDragDestDragDataReceived :: model row -> TreePath -> SelectionDataM Bool
treeDragDestDragDataReceived = \model row
_ TreePath
_ -> Bool -> SelectionDataM Bool
forall a. a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False }
  StablePtr (CustomStoreImplementation model row)
implPtr <- CustomStoreImplementation model row
-> IO (StablePtr (CustomStoreImplementation model row))
forall a. a -> IO (StablePtr a)
newStablePtr CustomStoreImplementation {
        customStoreColumns :: ColumnMap row
customStoreColumns = ColumnMap row
cMap,
        customStoreIface :: TreeModelIface row
customStoreIface = TreeModelIface row
tmIface,
        customTreeDragSourceIface :: DragSourceIface model row
customTreeDragSourceIface = DragSourceIface model row
-> Maybe (DragSourceIface model row) -> DragSourceIface model row
forall a. a -> Maybe a -> a
fromMaybe DragSourceIface model row
forall {model :: * -> *} {row}. DragSourceIface model row
dummyDragSource Maybe (DragSourceIface model row)
mDragSource,
        customTreeDragDestIface :: DragDestIface model row
customTreeDragDestIface = DragDestIface model row
-> Maybe (DragDestIface model row) -> DragDestIface model row
forall a. a -> Maybe a -> a
fromMaybe DragDestIface model row
forall {model :: * -> *} {row}. DragDestIface model row
dummyDragDest Maybe (DragDestIface model row)
mDragDest }
  StablePtr private
privPtr <- private -> IO (StablePtr private)
forall a. a -> IO (StablePtr a)
newStablePtr private
priv
  (CustomStore private row -> model row)
-> IO (CustomStore private row) -> IO (model row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStore private row -> model row
con (IO (CustomStore private row) -> IO (model row))
-> IO (CustomStore private row) -> IO (model row)
forall a b. (a -> b) -> a -> b
$ (ForeignPtr (CustomStore private row) -> CustomStore private row,
 FinalizerPtr (CustomStore private row))
-> IO (Ptr (CustomStore private row))
-> IO (CustomStore private row)
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr (CustomStore private row) -> CustomStore private row
forall private row.
ForeignPtr (CustomStore private row) -> CustomStore private row
CustomStore, FinalizerPtr (CustomStore private row)
forall a. FinalizerPtr a
objectUnref) (IO (Ptr (CustomStore private row))
 -> IO (CustomStore private row))
-> IO (Ptr (CustomStore private row))
-> IO (CustomStore private row)
forall a b. (a -> b) -> a -> b
$
    StablePtr (CustomStoreImplementation model row)
-> StablePtr private -> IO (Ptr (CustomStore private row))
forall (model :: * -> *) row private.
StablePtr (CustomStoreImplementation model row)
-> StablePtr private -> IO (Ptr (CustomStore private row))
gtk2hs_store_new StablePtr (CustomStoreImplementation model row)
implPtr StablePtr private
privPtr

foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_new"
  gtk2hs_store_new :: StablePtr (CustomStoreImplementation model row)
                   -> StablePtr private
                   -> IO (Ptr (CustomStore private row))

-- | Extract a row of the given model at the given 'TreeIter'.
--
customStoreGetRow :: TypedTreeModelClass model => model row -> TreeIter -> IO row
customStoreGetRow :: forall (model :: * -> *) row.
TypedTreeModelClass model =>
model row -> TreeIter -> IO row
customStoreGetRow model row
model TreeIter
iter =
  case model row -> TypedTreeModel row
forall (model :: * -> *) row.
TypedTreeModelClass model =>
model row -> TypedTreeModel row
toTypedTreeModel model row
model of
    TypedTreeModel ForeignPtr (TypedTreeModel row)
model -> do
      CustomStoreImplementation Any row
impl <- ForeignPtr (TypedTreeModel row)
-> (Ptr (TypedTreeModel row)
    -> IO (StablePtr (CustomStoreImplementation Any row)))
-> IO (StablePtr (CustomStoreImplementation Any row))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (TypedTreeModel row)
model Ptr (TypedTreeModel row)
-> IO (StablePtr (CustomStoreImplementation Any row))
forall row (model :: * -> *).
Ptr (TypedTreeModel row)
-> IO (StablePtr (CustomStoreImplementation model row))
gtk2hs_store_get_impl IO (StablePtr (CustomStoreImplementation Any row))
-> (StablePtr (CustomStoreImplementation Any row)
    -> IO (CustomStoreImplementation Any row))
-> IO (CustomStoreImplementation Any row)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StablePtr (CustomStoreImplementation Any row)
-> IO (CustomStoreImplementation Any row)
forall a. StablePtr a -> IO a
deRefStablePtr
      TreeModelIface row -> TreeIter -> IO row
forall row. TreeModelIface row -> TreeIter -> IO row
treeModelIfaceGetRow (CustomStoreImplementation Any row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface CustomStoreImplementation Any row
impl) TreeIter
iter

-- this is a backwards compatability definition
treeModelGetRow :: TypedTreeModelClass model => model row -> TreeIter -> IO row
treeModelGetRow :: forall (model :: * -> *) row.
TypedTreeModelClass model =>
model row -> TreeIter -> IO row
treeModelGetRow = model row -> TreeIter -> IO row
forall (model :: * -> *) row.
TypedTreeModelClass model =>
model row -> TreeIter -> IO row
customStoreGetRow

foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_get_impl"
  gtk2hs_store_get_impl :: Ptr (TypedTreeModel row) -> IO (StablePtr (CustomStoreImplementation model row))

-- | Return the private data stored in this 'CustomStore'. The private data
--   is meant as a container for the data stored in this model.
customStoreGetPrivate :: CustomStore private row -> private
customStoreGetPrivate :: forall private row. CustomStore private row -> private
customStoreGetPrivate (CustomStore ForeignPtr (CustomStore private row)
model) =
  IO private -> private
forall a. IO a -> a
unsafePerformIO (IO private -> private) -> IO private -> private
forall a b. (a -> b) -> a -> b
$ -- this is safe because the priv member is set at
                    -- construction time and never modified after that
  ForeignPtr (CustomStore private row)
-> (Ptr (CustomStore private row) -> IO (StablePtr private))
-> IO (StablePtr private)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CustomStore private row)
model Ptr (CustomStore private row) -> IO (StablePtr private)
forall private row.
Ptr (CustomStore private row) -> IO (StablePtr private)
gtk2hs_store_get_priv IO (StablePtr private)
-> (StablePtr private -> IO private) -> IO private
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StablePtr private -> IO private
forall a. StablePtr a -> IO a
deRefStablePtr

foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_get_priv"
  gtk2hs_store_get_priv :: Ptr (CustomStore private row) -> IO (StablePtr private)

-- | Query the current value of the stamp that is used to create
--   'TreeIter' iterators. The stamp is compared each time a view
--   accesses this store. If the stamp doesn't match, a warning
--   is emitted. The stamp should be updated each time a the data
--   in the model changes. The rationale is that a view should never
--   use a stale 'TreeIter', i.e., one that refers to an old model.
--
customStoreGetStamp :: CustomStore private row -> IO CInt
customStoreGetStamp :: forall private row. CustomStore private row -> IO CInt
customStoreGetStamp (CustomStore ForeignPtr (CustomStore private row)
model) =
  ForeignPtr (CustomStore private row)
-> (Ptr (CustomStore private row) -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CustomStore private row)
model Ptr (CustomStore private row) -> IO CInt
forall private row. Ptr (CustomStore private row) -> IO CInt
gtk2hs_store_get_stamp

foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_get_stamp"
  gtk2hs_store_get_stamp :: Ptr (CustomStore private row) -> IO CInt

-- | Create a new stamp. See 'customStoreGetStamp'.
--
customStoreInvalidateIters :: CustomStore private row -> IO ()
customStoreInvalidateIters :: forall private row. CustomStore private row -> IO ()
customStoreInvalidateIters (CustomStore ForeignPtr (CustomStore private row)
model) =
  ForeignPtr (CustomStore private row)
-> (Ptr (CustomStore private row) -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CustomStore private row)
model Ptr (CustomStore private row) -> IO ()
forall private row. Ptr (CustomStore private row) -> IO ()
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row) -> IO CInt
treeModelIfaceGetNColumns_static StablePtr (CustomStoreImplementation model row)
storePtr = do
  CustomStoreImplementation model row
store <- StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  [ColumnAccess row]
cmap <- IORef [ColumnAccess row] -> IO [ColumnAccess row]
forall a. IORef a -> IO a
readIORef (CustomStoreImplementation model row -> IORef [ColumnAccess row]
forall (model :: * -> *) row.
CustomStoreImplementation model row -> ColumnMap row
customStoreColumns CustomStoreImplementation model row
store)
  CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([ColumnAccess row] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColumnAccess row]
cmap))

foreign export ccall "gtk2hs_store_get_n_columns_impl"
  treeModelIfaceGetNColumns_static :: StablePtr (CustomStoreImplementation model row) -> IO CInt

-- Get the 'GType' for a given 'ColumnAccess'.
caToGType :: ColumnAccess row -> GType
caToGType :: forall row. ColumnAccess row -> GType
caToGType (CAInt row -> Int
_) = GType
GConst.int
caToGType (CABool row -> Bool
_) = GType
GConst.bool
caToGType (CAString row -> string
_) = GType
GConst.string
caToGType (CAPixbuf row -> Pixbuf
_) = GType
gdk_pixbuf_get_type
{-# LINE 310 "./Graphics/UI/Gtk/ModelView/CustomStore.chs" #-}
caToGType CAInvalid = GConst.int -- to avoid warnings of functions that iterate through all columns

treeModelIfaceGetColumnType_static :: StablePtr (CustomStoreImplementation model row) -> CInt -> IO GType
treeModelIfaceGetColumnType_static :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row) -> CInt -> IO GType
treeModelIfaceGetColumnType_static StablePtr (CustomStoreImplementation model row)
storePtr CInt
column = do
  CustomStoreImplementation model row
store <- StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  [ColumnAccess row]
cols <- IORef [ColumnAccess row] -> IO [ColumnAccess row]
forall a. IORef a -> IO a
readIORef (CustomStoreImplementation model row -> IORef [ColumnAccess row]
forall (model :: * -> *) row.
CustomStoreImplementation model row -> ColumnMap row
customStoreColumns CustomStoreImplementation model row
store)
  case Int -> [ColumnAccess row] -> [ColumnAccess row]
forall a. Int -> [a] -> [a]
drop (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
column) [ColumnAccess row]
cols of
     [] -> GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
GConst.invalid
     (ColumnAccess row
ca:[ColumnAccess row]
_) -> GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ColumnAccess row -> GType
forall row. ColumnAccess row -> GType
caToGType ColumnAccess row
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row) -> IO CInt
treeModelIfaceGetFlags_static StablePtr (CustomStoreImplementation model row)
storePtr = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  ([TreeModelFlags] -> CInt) -> IO [TreeModelFlags] -> IO CInt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> ([TreeModelFlags] -> Int) -> [TreeModelFlags] -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TreeModelFlags] -> Int
forall a. Flags a => [a] -> Int
fromFlags) (IO [TreeModelFlags] -> IO CInt) -> IO [TreeModelFlags] -> IO CInt
forall a b. (a -> b) -> a -> b
$ TreeModelIface row -> IO [TreeModelFlags]
forall row. TreeModelIface row -> IO [TreeModelFlags]
treeModelIfaceGetFlags TreeModelIface row
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> Ptr NativeTreePath -> IO CInt
treeModelIfaceGetIter_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr Ptr NativeTreePath
pathPtr = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- Ptr NativeTreePath -> IO TreePath
peekTreePath Ptr NativeTreePath
pathPtr
  Maybe TreeIter
iter <- TreeModelIface row -> TreePath -> IO (Maybe TreeIter)
forall row. TreeModelIface row -> TreePath -> IO (Maybe TreeIter)
treeModelIfaceGetIter TreeModelIface row
store TreePath
path
  case Maybe TreeIter
iter of
    Maybe TreeIter
Nothing   -> CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
False)
    Just TreeIter
iter -> do Ptr TreeIter -> TreeIter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr TreeIter
iterPtr TreeIter
iter
                    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> IO (Ptr NativeTreePath)
treeModelIfaceGetPath_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
iterPtr
  TreePath
path <- TreeModelIface row -> TreeIter -> IO TreePath
forall row. TreeModelIface row -> TreeIter -> IO TreePath
treeModelIfaceGetPath TreeModelIface row
store TreeIter
iter
  NativeTreePath Ptr NativeTreePath
pathPtr <- TreePath -> IO NativeTreePath
newTreePath TreePath
path
  Ptr NativeTreePath -> IO (Ptr NativeTreePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr NativeTreePath
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> CInt -> Ptr GValue -> IO ()
treeModelIfaceGetValue_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr CInt
column Ptr GValue
gvaluePtr = do
  CustomStoreImplementation model row
store <- StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
iterPtr
  row
row <- TreeModelIface row -> TreeIter -> IO row
forall row. TreeModelIface row -> TreeIter -> IO row
treeModelIfaceGetRow (CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface CustomStoreImplementation model row
store) TreeIter
iter
  [ColumnAccess row]
cols <- IORef [ColumnAccess row] -> IO [ColumnAccess row]
forall a. IORef a -> IO a
readIORef (CustomStoreImplementation model row -> IORef [ColumnAccess row]
forall (model :: * -> *) row.
CustomStoreImplementation model row -> ColumnMap row
customStoreColumns CustomStoreImplementation model row
store)
  let gVal :: GValue
gVal = (Ptr GValue -> GValue
GValue Ptr GValue
gvaluePtr)
  GType
0 <- (\Ptr GValue
ptr -> do {Ptr GValue -> Int -> IO GType
forall b. Ptr b -> Int -> IO GType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GValue
ptr Int
0 ::IO CUInt}) Ptr GValue
gvaluePtr
  case Int -> [ColumnAccess row] -> [ColumnAccess row]
forall a. Int -> [a] -> [a]
drop (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
column) [ColumnAccess row]
cols of
    [] -> GValue -> GType -> IO ()
valueInit GValue
gVal GType
GConst.invalid -- column number out of range
    (ColumnAccess row
acc:[ColumnAccess row]
_) -> case ColumnAccess row
acc of
      (CAInt row -> Int
ca) -> GValue -> GType -> IO ()
valueInit GValue
gVal GType
GConst.int IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GValue -> Int -> IO ()
valueSetInt GValue
gVal (row -> Int
ca row
row)
      (CABool row -> Bool
ca) -> GValue -> GType -> IO ()
valueInit GValue
gVal GType
GConst.bool IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GValue -> Bool -> IO ()
valueSetBool GValue
gVal (row -> Bool
ca row
row)
      (CAString row -> string
ca) -> GValue -> GType -> IO ()
valueInit GValue
gVal GType
GConst.string IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GValue -> string -> IO ()
forall string. GlibString string => GValue -> string -> IO ()
valueSetString GValue
gVal (row -> string
ca row
row)
      (CAPixbuf row -> Pixbuf
ca) -> GValue -> GType -> IO ()
valueInit GValue
gVal GType
gdk_pixbuf_get_type IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                        GValue -> Pixbuf -> IO ()
forall gobj. GObjectClass gobj => GValue -> gobj -> IO ()
valueSetGObject GValue
gVal (row -> Pixbuf
ca row
row)
      ColumnAccess row
CAInvalid -> GValue -> GType -> IO ()
valueInit GValue
gVal GType
GConst.int IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GValue -> Int -> IO ()
valueSetInt GValue
gVal Int
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> IO CInt
treeModelIfaceIterNext_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
iterPtr
  Maybe TreeIter
iter' <- TreeModelIface row -> TreeIter -> IO (Maybe TreeIter)
forall row. TreeModelIface row -> TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterNext TreeModelIface row
store TreeIter
iter
  case Maybe TreeIter
iter' of
    Maybe TreeIter
Nothing    -> CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
False)
    Just TreeIter
iter' -> do Ptr TreeIter -> TreeIter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr TreeIter
iterPtr TreeIter
iter'
                     CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> Ptr TreeIter -> IO CInt
treeModelIfaceIterChildren_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr Ptr TreeIter
parentIterPtr = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  Maybe TreeIter
parentIter <- (Ptr TreeIter -> IO TreeIter)
-> Ptr TreeIter -> IO (Maybe TreeIter)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybeNull Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
parentIterPtr
  Maybe TreeIter
iter <- TreeModelIface row -> Maybe TreeIter -> IO (Maybe TreeIter)
forall row.
TreeModelIface row -> Maybe TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterChildren TreeModelIface row
store Maybe TreeIter
parentIter
  case Maybe TreeIter
iter of
    Maybe TreeIter
Nothing   -> CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
False)
    Just TreeIter
iter -> do Ptr TreeIter -> TreeIter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr TreeIter
iterPtr TreeIter
iter
                    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> IO CInt
treeModelIfaceIterHasChild_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
iterPtr
  (Bool -> CInt) -> IO Bool -> IO CInt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> CInt
forall a. Num a => Bool -> a
fromBool (IO Bool -> IO CInt) -> IO Bool -> IO CInt
forall a b. (a -> b) -> a -> b
$ TreeModelIface row -> TreeIter -> IO Bool
forall row. TreeModelIface row -> TreeIter -> IO Bool
treeModelIfaceIterHasChild TreeModelIface row
store TreeIter
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> IO CInt
treeModelIfaceIterNChildren_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  Maybe TreeIter
iter <- (Ptr TreeIter -> IO TreeIter)
-> Ptr TreeIter -> IO (Maybe TreeIter)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybeNull Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
iterPtr
  (Int -> CInt) -> IO Int -> IO CInt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Int -> IO CInt) -> IO Int -> IO CInt
forall a b. (a -> b) -> a -> b
$ TreeModelIface row -> Maybe TreeIter -> IO Int
forall row. TreeModelIface row -> Maybe TreeIter -> IO Int
treeModelIfaceIterNChildren TreeModelIface row
store Maybe TreeIter
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> Ptr TreeIter -> CInt -> IO CInt
treeModelIfaceIterNthChild_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr Ptr TreeIter
parentIterPtr CInt
n = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  Maybe TreeIter
parentIter <- (Ptr TreeIter -> IO TreeIter)
-> Ptr TreeIter -> IO (Maybe TreeIter)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybeNull Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
parentIterPtr
  Maybe TreeIter
iter <- TreeModelIface row -> Maybe TreeIter -> Int -> IO (Maybe TreeIter)
forall row.
TreeModelIface row -> Maybe TreeIter -> Int -> IO (Maybe TreeIter)
treeModelIfaceIterNthChild TreeModelIface row
store Maybe TreeIter
parentIter (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n)
  case Maybe TreeIter
iter of
    Maybe TreeIter
Nothing   -> CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
False)
    Just TreeIter
iter -> do Ptr TreeIter -> TreeIter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr TreeIter
iterPtr TreeIter
iter
                    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> Ptr TreeIter -> IO CInt
treeModelIfaceIterParent_static  StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr Ptr TreeIter
childIterPtr = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
childIter <- Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
childIterPtr
  Maybe TreeIter
iter <- TreeModelIface row -> TreeIter -> IO (Maybe TreeIter)
forall row. TreeModelIface row -> TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterParent TreeModelIface row
store TreeIter
childIter
  case Maybe TreeIter
iter of
    Maybe TreeIter
Nothing   -> CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
False)
    Just TreeIter
iter -> do Ptr TreeIter -> TreeIter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr TreeIter
iterPtr TreeIter
iter
                    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> IO ()
treeModelIfaceRefNode_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
iterPtr
  TreeModelIface row -> TreeIter -> IO ()
forall row. TreeModelIface row -> TreeIter -> IO ()
treeModelIfaceRefNode TreeModelIface row
store TreeIter
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 :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> IO ()
treeModelIfaceUnrefNode_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr = do
  TreeModelIface row
store <- (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (IO (CustomStoreImplementation model row)
 -> IO (TreeModelIface row))
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
iterPtr
  TreeModelIface row -> TreeIter -> IO ()
forall row. TreeModelIface row -> TreeIter -> IO ()
treeModelIfaceUnrefNode TreeModelIface row
store TreeIter
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 :: forall (model :: * -> *) row.
Ptr TreeModel
-> StablePtr (CustomStoreImplementation model row)
-> Ptr NativeTreePath
-> IO CInt
treeDragSourceRowDraggable_static Ptr TreeModel
mPtr StablePtr (CustomStoreImplementation model row)
storePtr Ptr NativeTreePath
pathPtr = do
  TreeModel
model <- (ForeignPtr TreeModel -> TreeModel, FinalizerPtr TreeModel)
-> IO (Ptr TreeModel) -> IO TreeModel
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr TreeModel -> TreeModel, FinalizerPtr TreeModel)
forall {a}. (ForeignPtr TreeModel -> TreeModel, FinalizerPtr a)
mkTreeModel (Ptr TreeModel -> IO (Ptr TreeModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeModel
mPtr)
  DragSourceIface model row
store <- (CustomStoreImplementation model row -> DragSourceIface model row)
-> IO (CustomStoreImplementation model row)
-> IO (DragSourceIface model row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> DragSourceIface model row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragSourceIface model row
customTreeDragSourceIface (IO (CustomStoreImplementation model row)
 -> IO (DragSourceIface model row))
-> IO (CustomStoreImplementation model row)
-> IO (DragSourceIface model row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- Ptr NativeTreePath -> IO TreePath
peekTreePath Ptr NativeTreePath
pathPtr
  (Bool -> CInt) -> IO Bool -> IO CInt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> CInt
forall a. Num a => Bool -> a
fromBool (IO Bool -> IO CInt) -> IO Bool -> IO CInt
forall a b. (a -> b) -> a -> b
$ DragSourceIface model row -> model row -> TreePath -> IO Bool
forall (model :: * -> *) row.
DragSourceIface model row -> model row -> TreePath -> IO Bool
treeDragSourceRowDraggable DragSourceIface model row
store (TreeModel -> model row
forall (model :: * -> *) row. TreeModel -> model row
unsafeTreeModelToGeneric TreeModel
model) TreePath
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 :: forall (model :: * -> *) row.
Ptr TreeModel
-> StablePtr (CustomStoreImplementation model row)
-> Ptr NativeTreePath
-> Ptr ()
-> IO CInt
treeDragSourceDragDataGet_static Ptr TreeModel
mPtr StablePtr (CustomStoreImplementation model row)
storePtr Ptr NativeTreePath
pathPtr Ptr ()
selectionPtr = do
  TreeModel
model <- (ForeignPtr TreeModel -> TreeModel, FinalizerPtr TreeModel)
-> IO (Ptr TreeModel) -> IO TreeModel
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr TreeModel -> TreeModel, FinalizerPtr TreeModel)
forall {a}. (ForeignPtr TreeModel -> TreeModel, FinalizerPtr a)
mkTreeModel (Ptr TreeModel -> IO (Ptr TreeModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeModel
mPtr)
  DragSourceIface model row
store <- (CustomStoreImplementation model row -> DragSourceIface model row)
-> IO (CustomStoreImplementation model row)
-> IO (DragSourceIface model row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> DragSourceIface model row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragSourceIface model row
customTreeDragSourceIface (IO (CustomStoreImplementation model row)
 -> IO (DragSourceIface model row))
-> IO (CustomStoreImplementation model row)
-> IO (DragSourceIface model row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- Ptr NativeTreePath -> IO TreePath
peekTreePath Ptr NativeTreePath
pathPtr
  (Bool -> CInt) -> IO Bool -> IO CInt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> CInt
forall a. Num a => Bool -> a
fromBool (IO Bool -> IO CInt) -> IO Bool -> IO CInt
forall a b. (a -> b) -> a -> b
$ SelectionDataM Bool -> Ptr () -> IO Bool
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (DragSourceIface model row
-> model row -> TreePath -> SelectionDataM Bool
forall (model :: * -> *) row.
DragSourceIface model row
-> model row -> TreePath -> SelectionDataM Bool
treeDragSourceDragDataGet DragSourceIface model row
store (TreeModel -> model row
forall (model :: * -> *) row. TreeModel -> model row
unsafeTreeModelToGeneric TreeModel
model) TreePath
path) Ptr ()
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 :: forall (model :: * -> *) row.
Ptr TreeModel
-> StablePtr (CustomStoreImplementation model row)
-> Ptr NativeTreePath
-> IO CInt
treeDragSourceDragDataDelete_static Ptr TreeModel
mPtr StablePtr (CustomStoreImplementation model row)
storePtr Ptr NativeTreePath
pathPtr = do
  TreeModel
model <- (ForeignPtr TreeModel -> TreeModel, FinalizerPtr TreeModel)
-> IO (Ptr TreeModel) -> IO TreeModel
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr TreeModel -> TreeModel, FinalizerPtr TreeModel)
forall {a}. (ForeignPtr TreeModel -> TreeModel, FinalizerPtr a)
mkTreeModel (Ptr TreeModel -> IO (Ptr TreeModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeModel
mPtr)
  DragSourceIface model row
store <- (CustomStoreImplementation model row -> DragSourceIface model row)
-> IO (CustomStoreImplementation model row)
-> IO (DragSourceIface model row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> DragSourceIface model row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragSourceIface model row
customTreeDragSourceIface (IO (CustomStoreImplementation model row)
 -> IO (DragSourceIface model row))
-> IO (CustomStoreImplementation model row)
-> IO (DragSourceIface model row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- Ptr NativeTreePath -> IO TreePath
peekTreePath Ptr NativeTreePath
pathPtr
  (Bool -> CInt) -> IO Bool -> IO CInt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> CInt
forall a. Num a => Bool -> a
fromBool (IO Bool -> IO CInt) -> IO Bool -> IO CInt
forall a b. (a -> b) -> a -> b
$ DragSourceIface model row -> model row -> TreePath -> IO Bool
forall (model :: * -> *) row.
DragSourceIface model row -> model row -> TreePath -> IO Bool
treeDragSourceDragDataDelete DragSourceIface model row
store (TreeModel -> model row
forall (model :: * -> *) row. TreeModel -> model row
unsafeTreeModelToGeneric TreeModel
model) TreePath
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 :: forall (model :: * -> *) row.
Ptr TreeModel
-> StablePtr (CustomStoreImplementation model row)
-> Ptr NativeTreePath
-> Ptr ()
-> IO CInt
treeDragDestDragDataReceived_static Ptr TreeModel
mPtr StablePtr (CustomStoreImplementation model row)
storePtr Ptr NativeTreePath
pathPtr Ptr ()
selectionPtr = do
  TreeModel
model <- (ForeignPtr TreeModel -> TreeModel, FinalizerPtr TreeModel)
-> IO (Ptr TreeModel) -> IO TreeModel
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr TreeModel -> TreeModel, FinalizerPtr TreeModel)
forall {a}. (ForeignPtr TreeModel -> TreeModel, FinalizerPtr a)
mkTreeModel (Ptr TreeModel -> IO (Ptr TreeModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeModel
mPtr)
  DragDestIface model row
store <- (CustomStoreImplementation model row -> DragDestIface model row)
-> IO (CustomStoreImplementation model row)
-> IO (DragDestIface model row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> DragDestIface model row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragDestIface model row
customTreeDragDestIface (IO (CustomStoreImplementation model row)
 -> IO (DragDestIface model row))
-> IO (CustomStoreImplementation model row)
-> IO (DragDestIface model row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- Ptr NativeTreePath -> IO TreePath
peekTreePath Ptr NativeTreePath
pathPtr
  (Bool -> CInt) -> IO Bool -> IO CInt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> CInt
forall a. Num a => Bool -> a
fromBool (IO Bool -> IO CInt) -> IO Bool -> IO CInt
forall a b. (a -> b) -> a -> b
$ SelectionDataM Bool -> Ptr () -> IO Bool
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (DragDestIface model row
-> model row -> TreePath -> SelectionDataM Bool
forall (model :: * -> *) row.
DragDestIface model row
-> model row -> TreePath -> SelectionDataM Bool
treeDragDestDragDataReceived DragDestIface model row
store (TreeModel -> model row
forall (model :: * -> *) row. TreeModel -> model row
unsafeTreeModelToGeneric TreeModel
model) TreePath
path) Ptr ()
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 :: forall (model :: * -> *) row.
Ptr TreeModel
-> StablePtr (CustomStoreImplementation model row)
-> Ptr NativeTreePath
-> Ptr ()
-> IO CInt
treeDragDestRowDropPossible_static Ptr TreeModel
mPtr StablePtr (CustomStoreImplementation model row)
storePtr Ptr NativeTreePath
pathPtr Ptr ()
selectionPtr = do
  TreeModel
model <- (ForeignPtr TreeModel -> TreeModel, FinalizerPtr TreeModel)
-> IO (Ptr TreeModel) -> IO TreeModel
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr TreeModel -> TreeModel, FinalizerPtr TreeModel)
forall {a}. (ForeignPtr TreeModel -> TreeModel, FinalizerPtr a)
mkTreeModel (Ptr TreeModel -> IO (Ptr TreeModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeModel
mPtr)
  DragDestIface model row
store <- (CustomStoreImplementation model row -> DragDestIface model row)
-> IO (CustomStoreImplementation model row)
-> IO (DragDestIface model row)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CustomStoreImplementation model row -> DragDestIface model row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragDestIface model row
customTreeDragDestIface (IO (CustomStoreImplementation model row)
 -> IO (DragDestIface model row))
-> IO (CustomStoreImplementation model row)
-> IO (DragDestIface model row)
forall a b. (a -> b) -> a -> b
$ StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- Ptr NativeTreePath -> IO TreePath
peekTreePath Ptr NativeTreePath
pathPtr
  (Bool -> CInt) -> IO Bool -> IO CInt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> CInt
forall a. Num a => Bool -> a
fromBool (IO Bool -> IO CInt) -> IO Bool -> IO CInt
forall a b. (a -> b) -> a -> b
$ SelectionDataM Bool -> Ptr () -> IO Bool
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (DragDestIface model row
-> model row -> TreePath -> SelectionDataM Bool
forall (model :: * -> *) row.
DragDestIface model row
-> model row -> TreePath -> SelectionDataM Bool
treeDragDestRowDropPossible DragDestIface model row
store (TreeModel -> model row
forall (model :: * -> *) row. TreeModel -> model row
unsafeTreeModelToGeneric TreeModel
model) TreePath
path) Ptr ()
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 :: forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybeNull Ptr a -> IO b
marshal Ptr a
ptr
  | Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr = Maybe b -> IO (Maybe b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
  | Bool
otherwise      = (b -> Maybe b) -> IO b -> IO (Maybe b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Maybe b
forall a. a -> Maybe a
Just (Ptr a -> IO b
marshal Ptr a
ptr)

foreign import ccall unsafe "gdk_pixbuf_get_type"
  gdk_pixbuf_get_type :: CUInt