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

{-# LANGUAGE GADTs #-}

{-# LINE 1 "./Graphics/UI/Gtk/ModelView/Types.chs" #-}
{-# LANGUAGE MagicHash #-}

{-# LINE 2 "./Graphics/UI/Gtk/ModelView/Types.chs" #-}
{-# LANGUAGE Rank2Types #-}

{-# LINE 3 "./Graphics/UI/Gtk/ModelView/Types.chs" #-}
{-# LANGUAGE OverloadedStrings #-}

{-# LINE 4 "./Graphics/UI/Gtk/ModelView/Types.chs" #-}
{-# OPTIONS_HADDOCK hide #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) CustomStore TreeModel
--
--  Author : Duncan Coutts
--
--  Created: 31 March 2006
--
--  Copyright (C) 2006-2007 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.
--
-- #hide

-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Common types and classes for the ModelView modules.
--
module Graphics.UI.Gtk.ModelView.Types (
  TypedTreeModel(..),
  TypedTreeModelClass,
  toTypedTreeModel,
  unsafeTreeModelToGeneric,

  TypedTreeModelSort(..),
  unsafeTreeModelSortToGeneric,
  TypedTreeModelFilter(..),
  unsafeTreeModelFilterToGeneric,

  -- TreeIter
  TreeIter(..),
  receiveTreeIter,
  peekTreeIter,
  treeIterSetStamp,

  -- TreePath
  TreePath,
  NativeTreePath(..),
  newTreePath,
  withTreePath,
  maybeWithTreePath,
  peekTreePath,
  fromTreePath,
  stringToTreePath,

  -- Columns
  ColumnAccess(..),
  ColumnId(..),

  -- Storing the model in a ComboBox
  comboQuark,
  ) where

import GHC.Exts (unsafeCoerce#)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GValue         (GValue)
import System.Glib.GObject        (Quark, quarkFromString)
import Graphics.UI.Gtk.Types        (TreeModel, TreeModelSort, TreeModelFilter,
                                   Pixbuf)
import Data.Char ( isDigit )
import Control.Monad ( liftM )


{-# LINE 81 "./Graphics/UI/Gtk/ModelView/Types.chs" #-}

newtype TypedTreeModel row = TypedTreeModel (ForeignPtr (TypedTreeModel row))

class TypedTreeModelClass model where
  dummy :: model a -> a
  dummy _ = error "not used"
  -- this is to get the right kind for model :: * -> *
  -- TODO: when haddock is fixed we can use an explicit kind annotation

toTypedTreeModel :: TypedTreeModelClass model => model row -> TypedTreeModel row
toTypedTreeModel = unsafeCoerce#

unsafeTreeModelToGeneric :: TreeModel -> model row
unsafeTreeModelToGeneric = unsafeCoerce#

instance TypedTreeModelClass TypedTreeModel

newtype TypedTreeModelSort row = TypedTreeModelSort (ForeignPtr (TypedTreeModelSort row))

unsafeTreeModelSortToGeneric :: TreeModelSort -> TypedTreeModelSort row
unsafeTreeModelSortToGeneric = unsafeCoerce#

instance TypedTreeModelClass TypedTreeModelSort

newtype TypedTreeModelFilter row = TypedTreeModelFilter (ForeignPtr (TypedTreeModelFilter row))

unsafeTreeModelFilterToGeneric :: TreeModelFilter -> TypedTreeModelFilter row
unsafeTreeModelFilterToGeneric = unsafeCoerce#

instance TypedTreeModelClass TypedTreeModelFilter

-- | Tree Iterator: a pointer to an entry in a
-- 'Graphics.UI.Gtk.ModelView.TreeModel'. The constructor of this structure is
-- public for the sake of creating custom tree models. The first value is a
-- time stamp that is handled by the functions that interface with Gtk. The
-- time stamps are used to print warnings if programmers use an iter to a
-- model that has changed meanwhile. The other three fields are used by the
-- custom model implementation to implement an indexing scheme. The precise
-- use of the three words is therefore implementation specific. See also
-- 'TreePath'.
--
data TreeIter = TreeIter {-# UNPACK #-} !CInt !Word32 !Word32 !Word32
              deriving Show

type TreeIterPtr = Ptr (TreeIter)
{-# LINE 126 "./Graphics/UI/Gtk/ModelView/Types.chs" #-}

instance Storable TreeIter where
  sizeOf _ = 32
{-# LINE 129 "./Graphics/UI/Gtk/ModelView/Types.chs" #-}
  alignment _ = alignment (undefined :: CInt)
  peek ptr = do
    stamp      <- (\ptr -> do {peekByteOff ptr 0 ::IO CInt}) ptr
    user_data  <- (\ptr -> do {peekByteOff ptr 8 ::IO (Ptr ())}) ptr
    user_data2 <- (\ptr -> do {peekByteOff ptr 16 ::IO (Ptr ())}) ptr
    user_data3 <- (\ptr -> do {peekByteOff ptr 24 ::IO (Ptr ())}) ptr
    return (TreeIter stamp (ptrToWord user_data)
                           (ptrToWord user_data2)
                           (ptrToWord user_data3))

    where ptrToWord :: Ptr a -> Word32
          ptrToWord ptr = fromIntegral (ptr `minusPtr` nullPtr)

  poke ptr (TreeIter stamp user_data user_data2 user_data3) = do
    (\ptr val -> do {pokeByteOff ptr 0 (val::CInt)}) ptr stamp
    (\ptr val -> do {pokeByteOff ptr 8 (val::(Ptr ()))}) ptr (wordToPtr user_data)
    (\ptr val -> do {pokeByteOff ptr 16 (val::(Ptr ()))}) ptr (wordToPtr user_data2)
    (\ptr val -> do {pokeByteOff ptr 24 (val::(Ptr ()))}) ptr (wordToPtr user_data3)

    where wordToPtr :: Word32 -> Ptr a
          wordToPtr word = nullPtr `plusPtr` fromIntegral word

-- Pass a pointer to a structure large enough to hold a GtkTreeIter
-- structure. If the function returns true, read the tree iter and
-- return it.
receiveTreeIter :: (Ptr TreeIter -> IO CInt) -> IO (Maybe TreeIter)
receiveTreeIter body =
  alloca $ \iterPtr -> do
  result <- body iterPtr
  if toBool result
    then liftM Just (peek iterPtr)
    else return Nothing

-- Note that this function does throw an error if the pointer is NULL rather
-- than returning some random tree iterator.
peekTreeIter :: Ptr TreeIter -> IO TreeIter
peekTreeIter ptr
  | ptr==nullPtr = fail "peekTreeIter: ptr is NULL, tree iterator is invalid"
  | otherwise = peek ptr

-- update the stamp of a tree iter
treeIterSetStamp :: TreeIter -> CInt -> TreeIter
treeIterSetStamp (TreeIter _ a b c) s = (TreeIter s a b c)

-- | TreePath : a list of indices to specify a subtree or node in a
-- 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel'. The node that correspond
-- to a given 'TreePath' might change if nodes are removed or added and a
-- 'TreePath' may refer to a different or even non-existent node after a
-- modification of the model. In contrast, a 'TreeIter' is a more compact
-- representation of a 'TreePath' which becomes invalid after each
-- modification of the underlying model. An intelligent index that is adjusted
-- with each update of the model to point to the same node (whenever possible)
-- is 'Graphics.UI.Gtk.ModelView.TreeRowReference.TreeRowReference'.
--
type TreePath = [Int]

newtype NativeTreePath = NativeTreePath (Ptr (NativeTreePath))
{-# LINE 186 "./Graphics/UI/Gtk/ModelView/Types.chs" #-}

nativeTreePathFree :: NativeTreePath -> IO ()
nativeTreePathFree =
  (\(NativeTreePath arg1) -> gtk_tree_path_free arg1)
{-# LINE 190 "./Graphics/UI/Gtk/ModelView/Types.chs" #-}

newTreePath :: TreePath -> IO NativeTreePath
newTreePath path = do
  nativePath <- liftM NativeTreePath gtk_tree_path_new
{-# LINE 194 "./Graphics/UI/Gtk/ModelView/Types.chs" #-}
  mapM_ ((\(NativeTreePath arg1) arg2 -> gtk_tree_path_append_index arg1 arg2) nativePath . fromIntegral) path
  return nativePath

withTreePath :: TreePath -> (NativeTreePath -> IO a) -> IO a
withTreePath tp act = do
  nativePath <- newTreePath tp
  res <- act nativePath
  nativeTreePathFree nativePath
  return res

maybeWithTreePath :: Maybe TreePath -> (NativeTreePath -> IO a) -> IO a
maybeWithTreePath mbTp act = maybe (act (NativeTreePath nullPtr)) (`withTreePath` act) mbTp

nativeTreePathGetIndices :: NativeTreePath -> IO [Int]
nativeTreePathGetIndices tp = do
  depth <- liftM fromIntegral $ (\(NativeTreePath arg1) -> gtk_tree_path_get_depth arg1) tp
  arrayPtr <- (\(NativeTreePath arg1) -> gtk_tree_path_get_indices arg1) tp
  if (depth==0 || arrayPtr==nullPtr)
    then return []
    else liftM (map fromIntegral) $ peekArray depth arrayPtr

-- | Convert the given pointer to a tree path.
peekTreePath :: Ptr NativeTreePath -> IO TreePath
peekTreePath tpPtr | tpPtr==nullPtr = return []
                   | otherwise =
  nativeTreePathGetIndices (NativeTreePath tpPtr)

-- | Convert the given pointer to a tree path. Frees the pointer.
fromTreePath :: Ptr NativeTreePath -> IO TreePath
fromTreePath tpPtr | tpPtr==nullPtr = return []
                   | otherwise = do
  path <- nativeTreePathGetIndices (NativeTreePath tpPtr)
  nativeTreePathFree (NativeTreePath tpPtr)
  return path

-- | Convert a comma or colon separated string into a 'TreePath'. Any
-- non-digit characters are assumed to separate indices, thus, the function
-- always is always successful.
stringToTreePath :: DefaultGlibString -> TreePath
stringToTreePath = stringToTreePath' . glibToString
  where
  stringToTreePath' "" = []
  stringToTreePath' path = getNum 0 (dropWhile (not . isDigit) path)
  getNum acc ('0':xs) = getNum (10*acc) xs
  getNum acc ('1':xs) = getNum (10*acc+1) xs
  getNum acc ('2':xs) = getNum (10*acc+2) xs
  getNum acc ('3':xs) = getNum (10*acc+3) xs
  getNum acc ('4':xs) = getNum (10*acc+4) xs
  getNum acc ('5':xs) = getNum (10*acc+5) xs
  getNum acc ('6':xs) = getNum (10*acc+6) xs
  getNum acc ('7':xs) = getNum (10*acc+7) xs
  getNum acc ('8':xs) = getNum (10*acc+8) xs
  getNum acc ('9':xs) = getNum (10*acc+9) xs
  getNum acc xs = acc:stringToTreePath' (dropWhile (not . isDigit) xs)

-- | Accessing a row for a specific value. Used for 'ColumnMap'.
data ColumnAccess row where
  CAInvalid :: ColumnAccess row
  CAInt     :: (row -> Int) -> ColumnAccess row
  CABool    :: (row -> Bool) -> ColumnAccess row
  CAString  :: GlibString string => (row -> string) -> ColumnAccess row
  CAPixbuf  :: (row -> Pixbuf) -> ColumnAccess row

-- | The type of a tree column.
data ColumnId row ty
  = ColumnId (GValue -> IO ty) ((row -> ty) -> ColumnAccess row) Int

-- it shouldn't matter if the following function is actually inlined
{-# NOINLINE comboQuark #-}
comboQuark :: Quark
comboQuark =
  unsafePerformIO $ quarkFromString ("comboBoxHaskellStringModelQuark"::DefaultGlibString)


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

foreign import ccall unsafe "gtk_tree_path_new"
  gtk_tree_path_new :: (IO (Ptr NativeTreePath))

foreign import ccall unsafe "gtk_tree_path_append_index"
  gtk_tree_path_append_index :: ((Ptr NativeTreePath) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_tree_path_get_depth"
  gtk_tree_path_get_depth :: ((Ptr NativeTreePath) -> (IO CInt))

foreign import ccall unsafe "gtk_tree_path_get_indices"
  gtk_tree_path_get_indices :: ((Ptr NativeTreePath) -> (IO (Ptr CInt)))