{-# LINE 2 "./Graphics/UI/Gtk/ModelView/TreeRowReference.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Class TreeRowReference
--
-- Author : Duncan Coutts
--
-- Created: 14 April 2005
--
-- Copyright (C) 2005 Axel Simon, Duncan Coutts
--
-- 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.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- A persistent index into a tree model.
--
module Graphics.UI.Gtk.ModelView.TreeRowReference (
-- * Detail
--
-- | A 'RowReference' is an index into a
-- 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel' that is persistent even if
-- rows are inserted, deleted or reordered.
--

-- * Types
  TreeRowReference,

-- * Constructors
  treeRowReferenceNew,

-- * Methods
  treeRowReferenceGetPath,
  treeRowReferenceValid,
  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Types
{-# LINE 51 "./Graphics/UI/Gtk/ModelView/TreeRowReference.chs" #-}
import Graphics.UI.Gtk.ModelView.Types
{-# LINE 52 "./Graphics/UI/Gtk/ModelView/TreeRowReference.chs" #-}


{-# LINE 54 "./Graphics/UI/Gtk/ModelView/TreeRowReference.chs" #-}

-- | Tree Row Reference : like a 'TreePath' it points to a subtree or node, but
-- it is persistent. It identifies the same node (so long as it exists) even
-- when items are added, removed, or reordered.
--
newtype TreeRowReference = TreeRowReference (ForeignPtr (TreeRowReference))
{-# LINE 60 "./Graphics/UI/Gtk/ModelView/TreeRowReference.chs" #-}

--------------------
-- Constructors

-- | Creates a row reference based on a path. This reference will keep pointing
-- to the node pointed to by the given path, so long as it exists. Returns @Nothing@ if there is no node at the given path.
--
treeRowReferenceNew :: TreeModelClass self => self
 -> TreePath
 -> IO (Maybe TreeRowReference)
treeRowReferenceNew :: forall self.
TreeModelClass self =>
self -> TreePath -> IO (Maybe TreeRowReference)
treeRowReferenceNew self
self TreePath
path = TreePath
-> (NativeTreePath -> IO (Maybe TreeRowReference))
-> IO (Maybe TreeRowReference)
forall a. TreePath -> (NativeTreePath -> IO a) -> IO a
withTreePath TreePath
path ((NativeTreePath -> IO (Maybe TreeRowReference))
 -> IO (Maybe TreeRowReference))
-> (NativeTreePath -> IO (Maybe TreeRowReference))
-> IO (Maybe TreeRowReference)
forall a b. (a -> b) -> a -> b
$ \NativeTreePath
path -> do
  Ptr TreeRowReference
rowRefPtr <-
    (\(TreeModel ForeignPtr TreeModel
arg1) (NativeTreePath Ptr NativeTreePath
arg2) -> ForeignPtr TreeModel
-> (Ptr TreeModel -> IO (Ptr TreeRowReference))
-> IO (Ptr TreeRowReference)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeModel
arg1 ((Ptr TreeModel -> IO (Ptr TreeRowReference))
 -> IO (Ptr TreeRowReference))
-> (Ptr TreeModel -> IO (Ptr TreeRowReference))
-> IO (Ptr TreeRowReference)
forall a b. (a -> b) -> a -> b
$ \Ptr TreeModel
argPtr1 ->Ptr TreeModel -> Ptr NativeTreePath -> IO (Ptr TreeRowReference)
gtk_tree_row_reference_new Ptr TreeModel
argPtr1 Ptr NativeTreePath
arg2) (self -> TreeModel
forall o. TreeModelClass o => o -> TreeModel
toTreeModel self
self) NativeTreePath
path
  if Ptr TreeRowReference
rowRefPtrPtr TreeRowReference -> Ptr TreeRowReference -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr TreeRowReference
forall a. Ptr a
nullPtr then Maybe TreeRowReference -> IO (Maybe TreeRowReference)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeRowReference
forall a. Maybe a
Nothing else
    (ForeignPtr TreeRowReference -> Maybe TreeRowReference)
-> IO (ForeignPtr TreeRowReference) -> IO (Maybe TreeRowReference)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (TreeRowReference -> Maybe TreeRowReference
forall a. a -> Maybe a
Just (TreeRowReference -> Maybe TreeRowReference)
-> (ForeignPtr TreeRowReference -> TreeRowReference)
-> ForeignPtr TreeRowReference
-> Maybe TreeRowReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr TreeRowReference -> TreeRowReference
TreeRowReference) (IO (ForeignPtr TreeRowReference) -> IO (Maybe TreeRowReference))
-> IO (ForeignPtr TreeRowReference) -> IO (Maybe TreeRowReference)
forall a b. (a -> b) -> a -> b
$
    Ptr TreeRowReference
-> FinalizerPtr TreeRowReference
-> IO (ForeignPtr TreeRowReference)
forall a. Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
newForeignPtr Ptr TreeRowReference
rowRefPtr FinalizerPtr TreeRowReference
tree_row_reference_free

--------------------
-- Methods

-- | Returns a path that the row reference currently points to.
--
-- * The returned path may be the empty list if the reference was invalid.
--
treeRowReferenceGetPath :: TreeRowReference -> IO TreePath
treeRowReferenceGetPath :: TreeRowReference -> IO TreePath
treeRowReferenceGetPath TreeRowReference
ref =
  (\(TreeRowReference ForeignPtr TreeRowReference
arg1) -> ForeignPtr TreeRowReference
-> (Ptr TreeRowReference -> IO (Ptr NativeTreePath))
-> IO (Ptr NativeTreePath)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeRowReference
arg1 ((Ptr TreeRowReference -> IO (Ptr NativeTreePath))
 -> IO (Ptr NativeTreePath))
-> (Ptr TreeRowReference -> IO (Ptr NativeTreePath))
-> IO (Ptr NativeTreePath)
forall a b. (a -> b) -> a -> b
$ \Ptr TreeRowReference
argPtr1 ->Ptr TreeRowReference -> IO (Ptr NativeTreePath)
gtk_tree_row_reference_get_path Ptr TreeRowReference
argPtr1) TreeRowReference
ref
  IO (Ptr NativeTreePath)
-> (Ptr NativeTreePath -> IO TreePath) -> IO TreePath
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr NativeTreePath -> IO TreePath
fromTreePath -- path must be freed

-- | Returns True if the reference refers to a current valid path.
--
treeRowReferenceValid :: TreeRowReference -> IO Bool
treeRowReferenceValid :: TreeRowReference -> IO Bool
treeRowReferenceValid TreeRowReference
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(TreeRowReference ForeignPtr TreeRowReference
arg1) -> ForeignPtr TreeRowReference
-> (Ptr TreeRowReference -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeRowReference
arg1 ((Ptr TreeRowReference -> IO CInt) -> IO CInt)
-> (Ptr TreeRowReference -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TreeRowReference
argPtr1 ->Ptr TreeRowReference -> IO CInt
gtk_tree_row_reference_valid Ptr TreeRowReference
argPtr1)
{-# LINE 95 "./Graphics/UI/Gtk/ModelView/TreeRowReference.chs" #-}
    self

foreign import ccall unsafe "&gtk_tree_row_reference_free"
  tree_row_reference_free :: FinalizerPtr TreeRowReference

foreign import ccall safe "gtk_tree_row_reference_new"
  gtk_tree_row_reference_new :: ((Ptr TreeModel) -> ((Ptr NativeTreePath) -> (IO (Ptr TreeRowReference))))

foreign import ccall unsafe "gtk_tree_row_reference_get_path"
  gtk_tree_row_reference_get_path :: ((Ptr TreeRowReference) -> (IO (Ptr NativeTreePath)))

foreign import ccall unsafe "gtk_tree_row_reference_valid"
  gtk_tree_row_reference_valid :: ((Ptr TreeRowReference) -> (IO CInt))