{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}

-- -*-haskell-*-
--  GIMP Toolkit (GTK) CustomStore TreeModel
--
--  Author : Duncan Coutts, Axel Simon
--
--  Created: 19 Sep 2005
--
--  Copyright (C) 2005-2016 Duncan Coutts, Axel Simon, Hamish Mackenzie
--
--  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

-- |
-- 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
-- 'Data.GI.Gtk.ModelView.ListStore.ListStore' and
-- 'Data.GI.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 Data.GI.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
  ) where

import Prelude ()
import Prelude.Compat
import Control.Monad ((>=>), liftM, void)
import Control.Monad.IO.Class                   (MonadIO(..))
import Data.IORef                               (IORef, newIORef, readIORef, writeIORef)
import Data.Maybe                               (fromMaybe)
import Data.Int (Int32(..))
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.C.Types (CInt(..), CULong(..))
import Foreign.C.String (CString(..))
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, newForeignPtr_)
import Foreign.StablePtr (deRefStablePtr, newStablePtr, StablePtr(..))
import Foreign.Marshal (fromBool)
import Foreign.Storable (peek, poke, peekByteOff)
import System.IO.Unsafe (unsafePerformIO)
import Data.GI.Base.BasicTypes
       (ManagedPtr(..), GObject, TypedObject(..),
        GType, CGType(..), gtypeToCGType)
import Data.GI.Base.GType (gtypeInt, gtypeBoolean, gtypeString, gtypeInvalid)
import Data.GI.Base.BasicConversions (gflagsToWord, withTextCString)
import Data.GI.Base.ManagedPtr (newObject, withManagedPtr, newManagedPtr_)
import Data.GI.Base.GValue (GValue(..))
import Data.GI.Base.Overloading (HasParentTypes, ParentTypes)
import GI.GObject (Object)
import GI.GdkPixbuf.Objects (Pixbuf(..))
import GI.Gtk.Flags (TreeModelFlags(..))
import GI.Gtk.Interfaces.TreeModel (TreeModel(..), IsTreeModel(..))
import GI.Gtk.Structs (SelectionData(..), TreePath(..), TreeIter, treePathCopy, selectionDataCopy)
import Data.GI.Gtk.ModelView.Types
import GI.Gtk.Structs.TreeIter
       (getTreeIterStamp, getTreeIterUserData, getTreeIterUserData2, getTreeIterUserData3,
        setTreeIterStamp, setTreeIterUserData, setTreeIterUserData2, setTreeIterUserData3,
        TreeIter(..))
import Data.GI.Base (newBoxed, set, get)
import Data.GI.Base.Attributes (AttrOp(..))
import Data.GI.Base.Utils (maybeFromPtr)
-- import Data.GI.Gtk.General.DNDTypes         (SelectionDataM, SelectionData)

treeIterOverwrite :: MonadIO m => TreeIter -> TreeIter -> m ()
treeIterOverwrite :: forall (m :: * -> *). MonadIO m => TreeIter -> TreeIter -> m ()
treeIterOverwrite TreeIter
iterOut TreeIter
iterIn = do
    Int32
stamp <- TreeIter -> m Int32
forall (m :: * -> *). MonadIO m => TreeIter -> m Int32
getTreeIterStamp TreeIter
iterIn
    Ptr ()
ud1   <- TreeIter -> m (Ptr ())
forall (m :: * -> *). MonadIO m => TreeIter -> m (Ptr ())
getTreeIterUserData TreeIter
iterIn
    Ptr ()
ud2   <- TreeIter -> m (Ptr ())
forall (m :: * -> *). MonadIO m => TreeIter -> m (Ptr ())
getTreeIterUserData2 TreeIter
iterIn
    Ptr ()
ud3   <- TreeIter -> m (Ptr ())
forall (m :: * -> *). MonadIO m => TreeIter -> m (Ptr ())
getTreeIterUserData3 TreeIter
iterIn
    TreeIter -> Int32 -> m ()
forall (m :: * -> *). MonadIO m => TreeIter -> Int32 -> m ()
setTreeIterStamp TreeIter
iterOut Int32
stamp
    TreeIter -> Ptr () -> m ()
forall (m :: * -> *). MonadIO m => TreeIter -> Ptr () -> m ()
setTreeIterUserData TreeIter
iterOut Ptr ()
ud1
    TreeIter -> Ptr () -> m ()
forall (m :: * -> *). MonadIO m => TreeIter -> Ptr () -> m ()
setTreeIterUserData2 TreeIter
iterOut Ptr ()
ud2
    TreeIter -> Ptr () -> m ()
forall (m :: * -> *). MonadIO m => TreeIter -> Ptr () -> m ()
setTreeIterUserData3 TreeIter
iterOut Ptr ()
ud3

-- 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 'Data.GI.Gtk.ModelView.ListStore.ListStore' or
--   'Data.GI.Gtk.ModelView.TreeStore.TreeStore'.
newtype CustomStore private row = CustomStore (ManagedPtr (CustomStore private row))

instance HasParentTypes (CustomStore private row)
type instance ParentTypes (CustomStore private row) = '[ TreeModel ]

instance TypedObject (CustomStore private row) where
  glibType :: IO GType
glibType = forall a. TypedObject a => IO GType
glibType @TreeModel

instance GObject (CustomStore private row) where

-- | Type synonym for viewing the store as a set of columns.
type ColumnMap row = IORef [ColumnAccess row]

-- | Create a new 'ColumnMap' value.
columnMapNew :: MonadIO m => m (ColumnMap row)
columnMapNew :: forall (m :: * -> *) row. MonadIO m => m (ColumnMap row)
columnMapNew = IO (ColumnMap row) -> m (ColumnMap row)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ColumnMap row) -> m (ColumnMap row))
-> IO (ColumnMap row) -> m (ColumnMap row)
forall a b. (a -> b) -> a -> b
$ [ColumnAccess row] -> IO (ColumnMap 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 :: (MonadIO m, IsTypedTreeModel 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
        -> m ()
customStoreSetColumn :: forall (m :: * -> *) (model :: * -> *) row ty.
(MonadIO m, IsTypedTreeModel model) =>
model row -> ColumnId row ty -> (row -> ty) -> m ()
customStoreSetColumn model row
model (ColumnId GValue -> IO ty
_ (row -> ty) -> ColumnAccess row
setter Int32
colId) row -> ty
acc | Int32
colIdInt32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<Int32
0 = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                                         | Bool
otherwise = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  StablePtr (CustomStoreImplementation Any row)
ptr <- TypedTreeModel row
-> (Ptr (TypedTreeModel row)
    -> IO (StablePtr (CustomStoreImplementation Any row)))
-> IO (StablePtr (CustomStoreImplementation Any row))
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr (model row -> TypedTreeModel row
forall (model :: * -> *) row.
IsTypedTreeModel model =>
model row -> TypedTreeModel row
toTypedTreeModel model 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 :: Int32
l = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [ColumnAccess row] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColumnAccess row]
cols
  if Int32
colIdInt32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>=Int32
l then do
     let fillers :: [ColumnAccess row]
fillers = Int -> ColumnAccess row -> [ColumnAccess row]
forall a. Int -> a -> [a]
replicate (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Int32 -> Int
forall a b. (a -> b) -> a -> b
$ Int32
colIdInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
-Int32
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]
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 (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
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)

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
customDragSourceRowDraggable  :: model row -> TreePath -> IO Bool,                 -- query if the row is draggable
    -- | Fill in the 'SelectionData' structure with information on
    --   the given node using
    --   'Data.GI.Gtk.General.Selection.selectionDataSet'.
    forall (model :: * -> *) row.
DragSourceIface model row
-> model row -> TreePath -> SelectionData -> IO Bool
customDragSourceDragDataGet   :: model row -> TreePath -> SelectionData -> IO 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
customDragSourceDragDataDelete:: 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 -> SelectionData -> IO Bool
customDragDestRowDropPossible :: model row -> TreePath -> SelectionData -> IO Bool,     -- query if row drop is possible
    -- | The data in the 'SelectionDataM' structure should be read using
    --   'Data.GI.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 -> SelectionData -> IO Bool
customDragDestDragDataReceived:: model row -> TreePath -> SelectionData -> IO 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 :: (MonadIO m, IsTreeModel (model row), IsTypedTreeModel 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.
  -> m (model row)
customStoreNew :: forall (m :: * -> *) (model :: * -> *) row private.
(MonadIO m, IsTreeModel (model row), IsTypedTreeModel model) =>
private
-> (CustomStore private row -> model row)
-> TreeModelIface row
-> Maybe (DragSourceIface model row)
-> Maybe (DragDestIface model row)
-> m (model row)
customStoreNew private
priv CustomStore private row -> model row
con TreeModelIface row
tmIface Maybe (DragSourceIface model row)
mDragSource Maybe (DragDestIface model row)
mDragDest = IO (model row) -> m (model row)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (model row) -> m (model row))
-> IO (model row) -> m (model row)
forall a b. (a -> b) -> a -> b
$ do
  ColumnMap row
cMap <- IO (ColumnMap row)
forall (m :: * -> *) row. MonadIO m => m (ColumnMap row)
columnMapNew
  let dummyDragSource :: DragSourceIface model row
dummyDragSource = DragSourceIface { customDragSourceRowDraggable :: model row -> TreePath -> IO Bool
customDragSourceRowDraggable = \model row
_ TreePath
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
                                          customDragSourceDragDataGet :: model row -> TreePath -> SelectionData -> IO Bool
customDragSourceDragDataGet  = \model row
_ TreePath
_ SelectionData
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
                                          customDragSourceDragDataDelete :: model row -> TreePath -> IO Bool
customDragSourceDragDataDelete = \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 { customDragDestRowDropPossible :: model row -> TreePath -> SelectionData -> IO Bool
customDragDestRowDropPossible = \model row
_ TreePath
_ SelectionData
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
                                      customDragDestDragDataReceived :: model row -> TreePath -> SelectionData -> IO Bool
customDragDestDragDataReceived = \model row
_ TreePath
_ SelectionData
_ -> Bool -> IO Bool
forall a. a -> 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
  Ptr (CustomStore private row)
storePtr <- 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
  CustomStore private row -> model row
con (CustomStore private row -> model row)
-> IO (CustomStore private row) -> IO (model row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr (CustomStore private row) -> CustomStore private row)
-> Ptr (CustomStore private row) -> IO (CustomStore private row)
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr (CustomStore private row) -> CustomStore private row
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore Ptr (CustomStore private row)
storePtr


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 :: (MonadIO m, IsTypedTreeModel model) => model row -> TreeIter -> m row
customStoreGetRow :: forall (m :: * -> *) (model :: * -> *) row.
(MonadIO m, IsTypedTreeModel model) =>
model row -> TreeIter -> m row
customStoreGetRow model row
model TreeIter
iter = IO row -> m row
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO row -> m row) -> IO row -> m row
forall a b. (a -> b) -> a -> b
$ do
  CustomStoreImplementation Any row
impl <- TypedTreeModel row
-> (Ptr (TypedTreeModel row)
    -> IO (StablePtr (CustomStoreImplementation Any row)))
-> IO (StablePtr (CustomStoreImplementation Any row))
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr (model row -> TypedTreeModel row
forall (model :: * -> *) row.
IsTypedTreeModel model =>
model row -> TypedTreeModel row
toTypedTreeModel model 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

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 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
  CustomStore private row
-> (Ptr (CustomStore private row) -> IO (StablePtr private))
-> IO (StablePtr private)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr 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 :: MonadIO m => CustomStore private row -> m Int32
customStoreGetStamp :: forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m Int32
customStoreGetStamp CustomStore private row
model = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ CInt -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int32) -> IO CInt -> IO Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  CustomStore private row
-> (Ptr (CustomStore private row) -> IO CInt) -> IO CInt
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr 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 :: MonadIO m => CustomStore private row -> m ()
customStoreInvalidateIters :: forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m ()
customStoreInvalidateIters CustomStore private row
model = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
  CustomStore private row
-> (Ptr (CustomStore private row) -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr 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 -> Int32
_) = GType
gtypeInt
caToGType (CABool row -> Bool
_) = GType
gtypeBoolean
caToGType (CAString row -> Text
_) = GType
gtypeString
caToGType (CAPixbuf row -> Pixbuf
_) = GType
gtypePixbuf
caToGType ColumnAccess row
CAInvalid = GType
gtypeInt -- to avoid warnings of functions that iterate through all columns

gtypePixbuf :: GType
gtypePixbuf :: GType
gtypePixbuf = IO GType -> GType
forall a. IO a -> a
unsafePerformIO (IO GType -> GType) -> IO GType -> GType
forall a b. (a -> b) -> a -> b
$ forall a. TypedObject a => IO GType
glibType @Pixbuf
{-# NOINLINE gtypePixbuf #-}

treeModelIfaceGetColumnType_static :: StablePtr (CustomStoreImplementation model row) -> CInt -> IO CGType
treeModelIfaceGetColumnType_static :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> CInt -> IO CGType
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)
  CGType -> IO CGType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CGType -> IO CGType) -> (GType -> CGType) -> GType -> IO CGType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GType -> CGType
gtypeToCGType (GType -> IO CGType) -> GType -> IO CGType
forall a b. (a -> b) -> a -> b
$
    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
gtypeInvalid
      (ColumnAccess row
ca:[ColumnAccess row]
_) -> 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 CGType


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
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 (Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> CInt)
-> ([TreeModelFlags] -> Integer) -> [TreeModelFlags] -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TreeModelFlags] -> Integer
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord) (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 TreePath -> IO CInt
treeModelIfaceGetIter_static :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> Ptr TreePath -> IO CInt
treeModelIfaceGetIter_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr Ptr TreePath
pathPtr = do
  TreeIter
iterOut <- ManagedPtr TreeIter -> TreeIter
TreeIter (ManagedPtr TreeIter -> TreeIter)
-> IO (ManagedPtr TreeIter) -> IO TreeIter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr TreeIter -> IO (ManagedPtr TreeIter)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreeIter
iterPtr  -- Take care not to use this outside of this function
  TreeModelIface row
store <- CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  IORef Bool
isOwned' <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  TreePath
path <- TreePath -> IO TreePath
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TreePath -> m TreePath
treePathCopy (TreePath -> IO TreePath)
-> (ManagedPtr TreePath -> TreePath)
-> ManagedPtr TreePath
-> IO TreePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagedPtr TreePath -> TreePath
TreePath (ManagedPtr TreePath -> IO TreePath)
-> IO (ManagedPtr TreePath) -> IO TreePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TreePath -> IO (ManagedPtr TreePath)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreePath
pathPtr
  TreeModelIface row -> TreePath -> IO (Maybe TreeIter)
forall row. TreeModelIface row -> TreePath -> IO (Maybe TreeIter)
treeModelIfaceGetIter TreeModelIface row
store TreePath
path IO (Maybe TreeIter) -> (Maybe TreeIter -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    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 TreeIter -> TreeIter -> IO ()
forall (m :: * -> *). MonadIO m => TreeIter -> TreeIter -> m ()
treeIterOverwrite TreeIter
iterOut 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 TreePath -> IO CInt

foreign import ccall "gtk_tree_path_copy" gtk_tree_path_copy :: Ptr TreePath -> IO (Ptr TreePath)

treeModelIfaceGetPath_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO (Ptr TreePath)
treeModelIfaceGetPath_static :: forall (model :: * -> *) row.
StablePtr (CustomStoreImplementation model row)
-> Ptr TreeIter -> IO (Ptr TreePath)
treeModelIfaceGetPath_static StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreeIter
iterPtr = do
  TreeModelIface row
store <- CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- (ManagedPtr TreeIter -> TreeIter) -> Ptr TreeIter -> IO TreeIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TreeIter -> TreeIter
TreeIter Ptr TreeIter
iterPtr
  TreePath
path <- TreeModelIface row -> TreeIter -> IO TreePath
forall row. TreeModelIface row -> TreeIter -> IO TreePath
treeModelIfaceGetPath TreeModelIface row
store TreeIter
iter
  TreePath
-> (Ptr TreePath -> IO (Ptr TreePath)) -> IO (Ptr TreePath)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TreePath
path Ptr TreePath -> IO (Ptr TreePath)
gtk_tree_path_copy

foreign export ccall "gtk2hs_store_get_path_impl"
  treeModelIfaceGetPath_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO (Ptr TreePath)


foreign import ccall "g_value_init" g_value_init ::
    Ptr GValue -> CGType -> IO (Ptr GValue)

foreign import ccall unsafe "g_value_set_int" _set_int32 ::
    Ptr GValue -> Int32 -> IO ()

foreign import ccall unsafe "g_value_set_boolean" _set_boolean ::
    Ptr GValue -> CInt -> IO ()

foreign import ccall "g_value_set_string" _set_string ::
    Ptr GValue -> CString -> IO ()

foreign import ccall "g_value_set_object" _set_object ::
    Ptr GValue -> Ptr a -> IO ()

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
gVal = 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 <- (ManagedPtr TreeIter -> TreeIter) -> Ptr TreeIter -> IO TreeIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TreeIter -> TreeIter
TreeIter 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)
  -- TODO add code to do this check
  -- 0 <-  {# get GValue->g_type #} gVal
  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
    [] -> IO (Ptr GValue) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Ptr GValue) -> IO ()) -> IO (Ptr GValue) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr GValue -> CGType -> IO (Ptr GValue)
g_value_init Ptr GValue
gVal (GType -> CGType
gtypeToCGType GType
gtypeInvalid) -- column number out of range
    (ColumnAccess row
acc:[ColumnAccess row]
_) -> case ColumnAccess row
acc of
      (CAInt row -> Int32
ca) -> Ptr GValue -> CGType -> IO (Ptr GValue)
g_value_init Ptr GValue
gVal (GType -> CGType
gtypeToCGType GType
gtypeInt) IO (Ptr GValue) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GValue -> Int32 -> IO ()
_set_int32 Ptr GValue
gVal (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int32) -> Int32 -> Int32
forall a b. (a -> b) -> a -> b
$ row -> Int32
ca row
row)
      (CABool row -> Bool
ca) -> Ptr GValue -> CGType -> IO (Ptr GValue)
g_value_init Ptr GValue
gVal (GType -> CGType
gtypeToCGType GType
gtypeBoolean) IO (Ptr GValue) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GValue -> CInt -> IO ()
_set_boolean Ptr GValue
gVal (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool -> CInt) -> Bool -> CInt
forall a b. (a -> b) -> a -> b
$ row -> Bool
ca row
row)
      (CAString row -> Text
ca) -> Ptr GValue -> CGType -> IO (Ptr GValue)
g_value_init Ptr GValue
gVal (GType -> CGType
gtypeToCGType GType
gtypeString) IO (Ptr GValue) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Text -> (CString -> IO ()) -> IO ()
forall a. Text -> (CString -> IO a) -> IO a
withTextCString (row -> Text
ca row
row) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr GValue -> CString -> IO ()
_set_string Ptr GValue
gVal)
      (CAPixbuf row -> Pixbuf
ca) -> Ptr GValue -> CGType -> IO (Ptr GValue)
g_value_init Ptr GValue
gVal (GType -> CGType
gtypeToCGType GType
gtypePixbuf) IO (Ptr GValue) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr (row -> Pixbuf
ca row
row) ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr GValue -> Ptr Pixbuf -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
_set_object Ptr GValue
gVal)
      ColumnAccess row
CAInvalid -> Ptr GValue -> CGType -> IO (Ptr GValue)
g_value_init Ptr GValue
gVal (GType -> CGType
gtypeToCGType GType
gtypeInvalid) IO (Ptr GValue) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GValue -> Int32 -> IO ()
_set_int32 Ptr GValue
gVal Int32
0 -- to avoid warnings of functions that iterate through all columns

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
  TreeIter
iterOut <- ManagedPtr TreeIter -> TreeIter
TreeIter (ManagedPtr TreeIter -> TreeIter)
-> IO (ManagedPtr TreeIter) -> IO TreeIter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr TreeIter -> IO (ManagedPtr TreeIter)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreeIter
iterPtr -- Take care not to use this outside of this function
  TreeModelIface row
store <- CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- (ManagedPtr TreeIter -> TreeIter) -> Ptr TreeIter -> IO TreeIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TreeIter -> TreeIter
TreeIter Ptr TreeIter
iterPtr
  TreeModelIface row -> TreeIter -> IO (Maybe TreeIter)
forall row. TreeModelIface row -> TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterNext TreeModelIface row
store TreeIter
iter IO (Maybe TreeIter) -> (Maybe TreeIter -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    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 TreeIter -> TreeIter -> IO ()
forall (m :: * -> *). MonadIO m => TreeIter -> TreeIter -> m ()
treeIterOverwrite TreeIter
iterOut 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
  TreeIter
iterOut <- ManagedPtr TreeIter -> TreeIter
TreeIter (ManagedPtr TreeIter -> TreeIter)
-> IO (ManagedPtr TreeIter) -> IO TreeIter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr TreeIter -> IO (ManagedPtr TreeIter)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreeIter
iterPtr -- Take care not to use this outside of this function
  TreeModelIface row
store <- CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 ((ManagedPtr TreeIter -> TreeIter) -> Ptr TreeIter -> IO TreeIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TreeIter -> TreeIter
TreeIter) Ptr TreeIter
parentIterPtr
  TreeModelIface row -> Maybe TreeIter -> IO (Maybe TreeIter)
forall row.
TreeModelIface row -> Maybe TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterChildren TreeModelIface row
store Maybe TreeIter
parentIter IO (Maybe TreeIter) -> (Maybe TreeIter -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    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 TreeIter -> TreeIter -> IO ()
forall (m :: * -> *). MonadIO m => TreeIter -> TreeIter -> m ()
treeIterOverwrite TreeIter
iterOut 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
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- (ManagedPtr TreeIter -> TreeIter) -> Ptr TreeIter -> IO TreeIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TreeIter -> TreeIter
TreeIter Ptr TreeIter
iterPtr
  Bool -> CInt
forall a. Num a => Bool -> a
fromBool (Bool -> CInt) -> IO Bool -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 ((ManagedPtr TreeIter -> TreeIter) -> Ptr TreeIter -> IO TreeIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TreeIter -> TreeIter
TreeIter) Ptr TreeIter
iterPtr
  Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> IO Int -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
  TreeIter
iterOut <- ManagedPtr TreeIter -> TreeIter
TreeIter (ManagedPtr TreeIter -> TreeIter)
-> IO (ManagedPtr TreeIter) -> IO TreeIter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr TreeIter -> IO (ManagedPtr TreeIter)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreeIter
iterPtr -- Take care not to use this outside of this function
  TreeModelIface row
store <- CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 ((ManagedPtr TreeIter -> TreeIter) -> Ptr TreeIter -> IO TreeIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TreeIter -> TreeIter
TreeIter) Ptr TreeIter
parentIterPtr
  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) IO (Maybe TreeIter) -> (Maybe TreeIter -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    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 TreeIter -> TreeIter -> IO ()
forall (m :: * -> *). MonadIO m => TreeIter -> TreeIter -> m ()
treeIterOverwrite TreeIter
iterOut 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
  TreeIter
iterOut <- ManagedPtr TreeIter -> TreeIter
TreeIter (ManagedPtr TreeIter -> TreeIter)
-> IO (ManagedPtr TreeIter) -> IO TreeIter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr TreeIter -> IO (ManagedPtr TreeIter)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreeIter
iterPtr -- Take care not to use this outside of this function
  TreeModelIface row
store <- CustomStoreImplementation model row -> TreeModelIface row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
childIter <- (ManagedPtr TreeIter -> TreeIter) -> Ptr TreeIter -> IO TreeIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TreeIter -> TreeIter
TreeIter 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 TreeIter -> TreeIter -> IO ()
forall (m :: * -> *). MonadIO m => TreeIter -> TreeIter -> m ()
treeIterOverwrite TreeIter
iterOut 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
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- (ManagedPtr TreeIter -> TreeIter) -> Ptr TreeIter -> IO TreeIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TreeIter -> TreeIter
TreeIter 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
forall (model :: * -> *) row.
CustomStoreImplementation model row -> TreeModelIface row
customStoreIface (CustomStoreImplementation model row -> TreeModelIface row)
-> IO (CustomStoreImplementation model row)
-> IO (TreeModelIface row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreeIter
iter <- (ManagedPtr TreeIter -> TreeIter) -> Ptr TreeIter -> IO TreeIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TreeIter -> TreeIter
TreeIter 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 ()

customDragSourceRowDraggable_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr TreePath -> IO CInt
customDragSourceRowDraggable_static :: forall (model :: * -> *) row.
Ptr TreeModel
-> StablePtr (CustomStoreImplementation model row)
-> Ptr TreePath
-> IO CInt
customDragSourceRowDraggable_static Ptr TreeModel
mPtr StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreePath
pathPtr = do
  TreeModel
model <- (ManagedPtr TreeModel -> TreeModel)
-> Ptr TreeModel -> IO TreeModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TreeModel -> TreeModel
TreeModel Ptr TreeModel
mPtr
  DragSourceIface model row
store <- CustomStoreImplementation model row -> DragSourceIface model row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragSourceIface model row
customTreeDragSourceIface (CustomStoreImplementation model row -> DragSourceIface model row)
-> IO (CustomStoreImplementation model row)
-> IO (DragSourceIface model row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- TreePath -> IO TreePath
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TreePath -> m TreePath
treePathCopy (TreePath -> IO TreePath)
-> (ManagedPtr TreePath -> TreePath)
-> ManagedPtr TreePath
-> IO TreePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagedPtr TreePath -> TreePath
TreePath (ManagedPtr TreePath -> IO TreePath)
-> IO (ManagedPtr TreePath) -> IO TreePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TreePath -> IO (ManagedPtr TreePath)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreePath
pathPtr
  Bool -> CInt
forall a. Num a => Bool -> a
fromBool (Bool -> CInt) -> IO Bool -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DragSourceIface model row -> model row -> TreePath -> IO Bool
forall (model :: * -> *) row.
DragSourceIface model row -> model row -> TreePath -> IO Bool
customDragSourceRowDraggable 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"
  customDragSourceRowDraggable_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr TreePath -> IO CInt

customDragSourceDragDataGet_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr TreePath -> Ptr SelectionData -> IO CInt
customDragSourceDragDataGet_static :: forall (model :: * -> *) row.
Ptr TreeModel
-> StablePtr (CustomStoreImplementation model row)
-> Ptr TreePath
-> Ptr SelectionData
-> IO CInt
customDragSourceDragDataGet_static Ptr TreeModel
mPtr StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreePath
pathPtr Ptr SelectionData
selectionPtr = do
  TreeModel
model <- (ManagedPtr TreeModel -> TreeModel)
-> Ptr TreeModel -> IO TreeModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TreeModel -> TreeModel
TreeModel Ptr TreeModel
mPtr
  DragSourceIface model row
store <- CustomStoreImplementation model row -> DragSourceIface model row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragSourceIface model row
customTreeDragSourceIface (CustomStoreImplementation model row -> DragSourceIface model row)
-> IO (CustomStoreImplementation model row)
-> IO (DragSourceIface model row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- TreePath -> IO TreePath
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TreePath -> m TreePath
treePathCopy (TreePath -> IO TreePath)
-> (ManagedPtr TreePath -> TreePath)
-> ManagedPtr TreePath
-> IO TreePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagedPtr TreePath -> TreePath
TreePath (ManagedPtr TreePath -> IO TreePath)
-> IO (ManagedPtr TreePath) -> IO TreePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TreePath -> IO (ManagedPtr TreePath)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreePath
pathPtr
  SelectionData
selection <- ManagedPtr SelectionData -> SelectionData
SelectionData (ManagedPtr SelectionData -> SelectionData)
-> IO (ManagedPtr SelectionData) -> IO SelectionData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr SelectionData -> IO (ManagedPtr SelectionData)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr SelectionData
selectionPtr
  Bool -> CInt
forall a. Num a => Bool -> a
fromBool (Bool -> CInt) -> IO Bool -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DragSourceIface model row
-> model row -> TreePath -> SelectionData -> IO Bool
forall (model :: * -> *) row.
DragSourceIface model row
-> model row -> TreePath -> SelectionData -> IO Bool
customDragSourceDragDataGet DragSourceIface model row
store (TreeModel -> model row
forall (model :: * -> *) row. TreeModel -> model row
unsafeTreeModelToGeneric TreeModel
model) TreePath
path SelectionData
selection

foreign export ccall "gtk2hs_store_drag_data_get_impl"
  customDragSourceDragDataGet_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr TreePath -> Ptr SelectionData -> IO CInt

customDragSourceDragDataDelete_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr TreePath -> IO CInt
customDragSourceDragDataDelete_static :: forall (model :: * -> *) row.
Ptr TreeModel
-> StablePtr (CustomStoreImplementation model row)
-> Ptr TreePath
-> IO CInt
customDragSourceDragDataDelete_static Ptr TreeModel
mPtr StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreePath
pathPtr = do
  TreeModel
model <- (ManagedPtr TreeModel -> TreeModel)
-> Ptr TreeModel -> IO TreeModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TreeModel -> TreeModel
TreeModel Ptr TreeModel
mPtr
  DragSourceIface model row
store <- CustomStoreImplementation model row -> DragSourceIface model row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragSourceIface model row
customTreeDragSourceIface (CustomStoreImplementation model row -> DragSourceIface model row)
-> IO (CustomStoreImplementation model row)
-> IO (DragSourceIface model row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- TreePath -> IO TreePath
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TreePath -> m TreePath
treePathCopy (TreePath -> IO TreePath)
-> (ManagedPtr TreePath -> TreePath)
-> ManagedPtr TreePath
-> IO TreePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagedPtr TreePath -> TreePath
TreePath (ManagedPtr TreePath -> IO TreePath)
-> IO (ManagedPtr TreePath) -> IO TreePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TreePath -> IO (ManagedPtr TreePath)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreePath
pathPtr
  Bool -> CInt
forall a. Num a => Bool -> a
fromBool (Bool -> CInt) -> IO Bool -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DragSourceIface model row -> model row -> TreePath -> IO Bool
forall (model :: * -> *) row.
DragSourceIface model row -> model row -> TreePath -> IO Bool
customDragSourceDragDataDelete 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"
  customDragSourceDragDataDelete_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr TreePath -> IO CInt

customDragDestDragDataReceived_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr TreePath -> Ptr SelectionData -> IO CInt
customDragDestDragDataReceived_static :: forall (model :: * -> *) row.
Ptr TreeModel
-> StablePtr (CustomStoreImplementation model row)
-> Ptr TreePath
-> Ptr SelectionData
-> IO CInt
customDragDestDragDataReceived_static Ptr TreeModel
mPtr StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreePath
pathPtr Ptr SelectionData
selectionPtr = do
  TreeModel
model <- (ManagedPtr TreeModel -> TreeModel)
-> Ptr TreeModel -> IO TreeModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TreeModel -> TreeModel
TreeModel Ptr TreeModel
mPtr
  DragDestIface model row
store <- CustomStoreImplementation model row -> DragDestIface model row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragDestIface model row
customTreeDragDestIface (CustomStoreImplementation model row -> DragDestIface model row)
-> IO (CustomStoreImplementation model row)
-> IO (DragDestIface model row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- TreePath -> IO TreePath
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TreePath -> m TreePath
treePathCopy (TreePath -> IO TreePath)
-> (ManagedPtr TreePath -> TreePath)
-> ManagedPtr TreePath
-> IO TreePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagedPtr TreePath -> TreePath
TreePath (ManagedPtr TreePath -> IO TreePath)
-> IO (ManagedPtr TreePath) -> IO TreePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TreePath -> IO (ManagedPtr TreePath)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreePath
pathPtr
  SelectionData
selection <- SelectionData -> IO SelectionData
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SelectionData -> m SelectionData
selectionDataCopy (SelectionData -> IO SelectionData)
-> (ManagedPtr SelectionData -> SelectionData)
-> ManagedPtr SelectionData
-> IO SelectionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagedPtr SelectionData -> SelectionData
SelectionData (ManagedPtr SelectionData -> IO SelectionData)
-> IO (ManagedPtr SelectionData) -> IO SelectionData
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr SelectionData -> IO (ManagedPtr SelectionData)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr SelectionData
selectionPtr
  Bool -> CInt
forall a. Num a => Bool -> a
fromBool (Bool -> CInt) -> IO Bool -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DragDestIface model row
-> model row -> TreePath -> SelectionData -> IO Bool
forall (model :: * -> *) row.
DragDestIface model row
-> model row -> TreePath -> SelectionData -> IO Bool
customDragDestDragDataReceived DragDestIface model row
store (TreeModel -> model row
forall (model :: * -> *) row. TreeModel -> model row
unsafeTreeModelToGeneric TreeModel
model) TreePath
path SelectionData
selection

foreign export ccall "gtk2hs_store_drag_data_received_impl"
  customDragDestDragDataReceived_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr TreePath -> Ptr SelectionData -> IO CInt

customDragDestRowDropPossible_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr TreePath -> Ptr SelectionData -> IO CInt
customDragDestRowDropPossible_static :: forall (model :: * -> *) row.
Ptr TreeModel
-> StablePtr (CustomStoreImplementation model row)
-> Ptr TreePath
-> Ptr SelectionData
-> IO CInt
customDragDestRowDropPossible_static Ptr TreeModel
mPtr StablePtr (CustomStoreImplementation model row)
storePtr Ptr TreePath
pathPtr Ptr SelectionData
selectionPtr = do
  TreeModel
model <- (ManagedPtr TreeModel -> TreeModel)
-> Ptr TreeModel -> IO TreeModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TreeModel -> TreeModel
TreeModel Ptr TreeModel
mPtr
  DragDestIface model row
store <- CustomStoreImplementation model row -> DragDestIface model row
forall (model :: * -> *) row.
CustomStoreImplementation model row -> DragDestIface model row
customTreeDragDestIface (CustomStoreImplementation model row -> DragDestIface model row)
-> IO (CustomStoreImplementation model row)
-> IO (DragDestIface model row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr (CustomStoreImplementation model row)
-> IO (CustomStoreImplementation model row)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (CustomStoreImplementation model row)
storePtr
  TreePath
path <- TreePath -> IO TreePath
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TreePath -> m TreePath
treePathCopy (TreePath -> IO TreePath)
-> (ManagedPtr TreePath -> TreePath)
-> ManagedPtr TreePath
-> IO TreePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagedPtr TreePath -> TreePath
TreePath (ManagedPtr TreePath -> IO TreePath)
-> IO (ManagedPtr TreePath) -> IO TreePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TreePath -> IO (ManagedPtr TreePath)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr TreePath
pathPtr
  SelectionData
selection <- SelectionData -> IO SelectionData
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SelectionData -> m SelectionData
selectionDataCopy (SelectionData -> IO SelectionData)
-> (ManagedPtr SelectionData -> SelectionData)
-> ManagedPtr SelectionData
-> IO SelectionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagedPtr SelectionData -> SelectionData
SelectionData (ManagedPtr SelectionData -> IO SelectionData)
-> IO (ManagedPtr SelectionData) -> IO SelectionData
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr SelectionData -> IO (ManagedPtr SelectionData)
forall a. Ptr a -> IO (ManagedPtr a)
newManagedPtr_ Ptr SelectionData
selectionPtr
  Bool -> CInt
forall a. Num a => Bool -> a
fromBool (Bool -> CInt) -> IO Bool -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DragDestIface model row
-> model row -> TreePath -> SelectionData -> IO Bool
forall (model :: * -> *) row.
DragDestIface model row
-> model row -> TreePath -> SelectionData -> IO Bool
customDragDestRowDropPossible DragDestIface model row
store (TreeModel -> model row
forall (model :: * -> *) row. TreeModel -> model row
unsafeTreeModelToGeneric TreeModel
model) TreePath
path SelectionData
selection

foreign export ccall "gtk2hs_store_row_drop_possible_impl"
  customDragDestRowDropPossible_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr TreePath -> Ptr 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)