module Graphics.UI.Gtk.Generics.TreeView where
	
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Generics.ListStore
import Control.Monad( forM )

{-
	Convenience function for getting the selected element of a
	ListStore contained within a TreeView.
-}
treeViewGetSingleSelection :: TreeView -> ListStore a -> IO ( Maybe a )
treeViewGetSingleSelection tree store = treeViewGetSelection tree >>= treeSelectionGetSelectedRows >>= ( \s ->
    case ( length s ) of
        0 -> return ( Nothing )
        _ -> listStoreGetValueAtPath ( head s ) store >>= (\r -> return ( Just r ) ) )

{-
	Convenience function for getting multiple selected elements of
	a ListStore contained within a TreeView.
	
	NB: Some elements of the resulting list may be Nothing.
-}

treeViewGetMultipleSelections :: TreeView -> ListStore a -> IO ( Maybe [a] )
treeViewGetMultipleSelections tree store = treeViewGetSelection tree >>= 
	treeSelectionGetSelectedRows >>= ( \s ->
		case ( length s ) of
			0 -> return ( Nothing )
			_ -> (\r -> return ( Just r ) ) 
					=<< ( forM s $ \path -> listStoreGetValueAtPath path store ) )

{-
	Convenience function for carrying out a function 
	on the selected element of a ListStore. The ListStore must be
	contained within the supplied TreeView.
-}

treeViewOperateOnSelection :: TreeView -> ListStore a -> ( a -> b ) -> IO ( Maybe b )
treeViewOperateOnSelection tree store func = treeViewGetSingleSelection tree store >>= (\r -> 
	case r of
		Nothing -> return Nothing
		( Just n ) -> return ( Just ( func n ) ) )
		
{-
	Convenience function for carrying out a function across
	multiple selected elements in a ListStore. The ListSTore must
	be contained with in the supplied TreeView.
-}

treeViewOperateOnSelections :: TreeView -> ListStore a -> ( [a] -> b ) -> IO ( Maybe b )
treeViewOperateOnSelections tree store func = treeViewGetMultipleSelections tree store >>= (\r -> 
	case r of
		Nothing -> return Nothing
		( Just n ) -> return ( Just ( func n ) ) )