{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MonoLocalBinds #-}

-- -*-haskell-*-
--  GIMP Toolkit (GTK) Interface CellLayout
--
--  Author : Axel Simon
--
--  Created: 23 January 2006
--
--  Copyright (C) 2016-2016 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.
--
-- |
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- An interface for packing cells
--
-- * Module available since Gtk+ version 2.4
--
module Data.GI.Gtk.ModelView.CellLayout (
-- * Detail
--
-- | 'CellLayout' is an interface which is implemented by all objects which
-- provide a 'TreeViewColumn' API for packing cells, setting attributes and data funcs.

-- * Class Hierarchy
-- |
-- @
-- |  Interface CellLayout
-- |   +----'TreeViewColumn'
-- |   +----'CellView'
-- |   +----'IconView'
-- |   +----'EntryCompletion'
-- |   +----'ComboBox'
-- |   +----'ComboBoxEntry'
-- @

    module GI.Gtk.Interfaces.CellLayout
--  , cellLayoutAddColumnAttribute
  , cellLayoutSetAttributes
  , cellLayoutSetDataFunction
  , cellLayoutSetDataFunc'
  , convertIterFromParentToChildModel
  ) where

import Control.Monad.IO.Class (MonadIO(..))
import Foreign.Ptr (castPtr)
import Foreign.Storable (peek)
import Data.GI.Base.Attributes (AttrOp, AttrOpTag(..), set)
import Data.GI.Base.ManagedPtr (castTo, withManagedPtr)
import GI.Gtk.Interfaces.CellLayout
import GI.Gtk.Objects.TreeModelFilter (TreeModelFilter(..), getTreeModelFilterChildModel, treeModelFilterConvertIterToChildIter)
import GI.Gtk.Objects.TreeModelSort (TreeModelSort(..), getTreeModelSortModel, treeModelSortConvertIterToChildIter)
import GI.Gtk.Structs.TreeIter
       (getTreeIterStamp, getTreeIterUserData3, getTreeIterUserData2,
        getTreeIterUserData, TreeIter(..))
import GI.Gtk.Objects.CellRenderer (IsCellRenderer, CellRenderer(..), toCellRenderer)
import Data.GI.Gtk.ModelView.Types
import Data.GI.Gtk.ModelView.TreeModel
import Data.GI.Gtk.ModelView.CustomStore (customStoreGetRow)
import Data.GI.Base (get)
import Data.GI.Base.BasicTypes (ManagedPtr(..))

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

-- | Adds an attribute mapping to the renderer @cell@. The @column@ is
-- the 'ColumnId' of the model to get a value from, and the @attribute@ is the
-- parameter on @cell@ to be set from the value. So for example if column 2 of
-- the model contains strings, you could have the \"text\" attribute of a
-- 'CellRendererText' get its values from column 2.
--
-- cellLayoutAddColumnAttribute :: (MonadIO m, IsCellLayout self, IsCellRenderer cell) => self
--  -> cell   -- ^ @cell@ - A 'CellRenderer'.
--  -> ReadWriteAttr cell a v  -- ^ @attribute@ - An attribute of a renderer.
--  -> ColumnId row v    -- ^ @column@ - The virtual column of the model from which to
--                       -- retrieve the attribute.
--  -> m ()
-- cellLayoutAddColumnAttribute self cell attr column =
--   cellLayoutAddAttribute self cell (T.pack $ show attr) (columnIdToNumber column)

-- | Specify how a row of the @model@ defines the
-- attributes of the 'CellRenderer' @cell@. This is a convenience wrapper
-- around 'cellLayoutSetAttributeFunc' in that it sets the cells of the @cell@
-- with the data retrieved from the model.
--
-- * Note on using 'Data.GI.Gtk.ModelView.TreeModelSort.TreeModelSort' and
-- 'Data.GI.Gtk.ModelView.TreeModelFilter.TreeModelFilter': These two models
-- wrap another model, the so-called child model, instead of storing their own
-- data. This raises the problem that the data of cell renderers must be set
-- using the child model, while the 'TreeIter's that the view works with refer to
-- the model that encapsulates the child model. For convenience, this function
-- transparently translates an iterator to the child model before extracting the
-- data using e.g. 'Data.GI.Gtk.TreeModel.TreeModelSort.treeModelSortConvertIterToChildIter'.
-- Hence, it is possible to install the encapsulating model in the view and to
-- pass the child model to this function.
--
cellLayoutSetAttributes :: (MonadIO m,
                            IsCellLayout self,
                            IsCellRenderer cell,
                            IsTreeModel (model row),
                            IsTypedTreeModel model)
 => self
 -> cell   -- ^ @cell@ - A 'CellRenderer'.
 -> model row -- ^ @model@ - A model containing rows of type @row@.
 -> (row -> [AttrOp cell 'AttrSet]) -- ^ Function to set attributes on the cell renderer.
 -> m ()
cellLayoutSetAttributes :: forall (m :: * -> *) self cell (model :: * -> *) row.
(MonadIO m, IsCellLayout self, IsCellRenderer cell,
 IsTreeModel (model row), IsTypedTreeModel model) =>
self
-> cell -> model row -> (row -> [AttrOp cell 'AttrSet]) -> m ()
cellLayoutSetAttributes self
self cell
cell model row
model row -> [AttrOp cell 'AttrSet]
attributes =
  self -> cell -> model row -> (TreeIter -> IO ()) -> m ()
forall (m :: * -> *) self cell model.
(MonadIO m, IsCellLayout self, IsCellRenderer cell,
 IsTreeModel model) =>
self -> cell -> model -> (TreeIter -> IO ()) -> m ()
cellLayoutSetDataFunc' self
self cell
cell model row
model ((TreeIter -> IO ()) -> m ()) -> (TreeIter -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \TreeIter
iter -> do
    row
row <- model row -> TreeIter -> IO row
forall (m :: * -> *) (model :: * -> *) row.
(MonadIO m, IsTypedTreeModel model) =>
model row -> TreeIter -> m row
customStoreGetRow model row
model TreeIter
iter
    cell -> [AttrOp cell 'AttrSet] -> IO ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
set cell
cell (row -> [AttrOp cell 'AttrSet]
attributes row
row)

-- | Like 'cellLayoutSetAttributes', but allows any IO action to be used
cellLayoutSetDataFunction :: (MonadIO m,
                            IsCellLayout self,
                            IsCellRenderer cell,
                            IsTreeModel (model row),
                            IsTypedTreeModel model)
 => self
 -> cell   -- ^ @cell@ - A 'CellRenderer'.
 -> model row -- ^ @model@ - A model containing rows of type @row@.
 -> (row -> IO ()) -- ^ Function to set data on the cell renderer.
 -> m ()
cellLayoutSetDataFunction :: forall (m :: * -> *) self cell (model :: * -> *) row.
(MonadIO m, IsCellLayout self, IsCellRenderer cell,
 IsTreeModel (model row), IsTypedTreeModel model) =>
self -> cell -> model row -> (row -> IO ()) -> m ()
cellLayoutSetDataFunction self
self cell
cell model row
model row -> IO ()
callback =
  self -> cell -> model row -> (TreeIter -> IO ()) -> m ()
forall (m :: * -> *) self cell model.
(MonadIO m, IsCellLayout self, IsCellRenderer cell,
 IsTreeModel model) =>
self -> cell -> model -> (TreeIter -> IO ()) -> m ()
cellLayoutSetDataFunc' self
self cell
cell model row
model ((TreeIter -> IO ()) -> m ()) -> (TreeIter -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \TreeIter
iter -> do
    row
row <- model row -> TreeIter -> IO row
forall (m :: * -> *) (model :: * -> *) row.
(MonadIO m, IsTypedTreeModel model) =>
model row -> TreeIter -> m row
customStoreGetRow model row
model TreeIter
iter
    row -> IO ()
callback row
row

-- | Install a function that looks up a row in the model and sets the
-- attributes of the 'CellRenderer' @cell@ using the row's content.
--
cellLayoutSetDataFunc' :: (MonadIO m,
                               IsCellLayout self,
                               IsCellRenderer cell,
                               IsTreeModel model)
 => self
 -> cell   -- ^ @cell@ - A 'CellRenderer'.
 -> model  -- ^ @model@ - A model from which to draw data.
 -> (TreeIter -> IO ()) -- ^ Function to set attributes on the cell renderer.
 -> m ()
cellLayoutSetDataFunc' :: forall (m :: * -> *) self cell model.
(MonadIO m, IsCellLayout self, IsCellRenderer cell,
 IsTreeModel model) =>
self -> cell -> model -> (TreeIter -> IO ()) -> m ()
cellLayoutSetDataFunc' self
self cell
cell model
model TreeIter -> IO ()
func = 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
  self -> cell -> Maybe CellLayoutDataFunc -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCellLayout a, IsCellRenderer b) =>
a -> b -> Maybe CellLayoutDataFunc -> m ()
cellLayoutSetCellDataFunc self
self cell
cell (Maybe CellLayoutDataFunc -> IO ())
-> (CellLayoutDataFunc -> Maybe CellLayoutDataFunc)
-> CellLayoutDataFunc
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellLayoutDataFunc -> Maybe CellLayoutDataFunc
forall a. a -> Maybe a
Just (CellLayoutDataFunc -> IO ()) -> CellLayoutDataFunc -> IO ()
forall a b. (a -> b) -> a -> b
$ \CellLayout
_ (CellRenderer ManagedPtr CellRenderer
cellPtr') TreeModel
model' TreeIter
iter -> do
    TreeModel
castModel <- model -> IO TreeModel
forall (m :: * -> *) o.
(MonadIO m, IsTreeModel o) =>
o -> m TreeModel
toTreeModel model
model
    TreeIter
iter <- TreeIter -> TreeModel -> TreeModel -> IO TreeIter
convertIterFromParentToChildModel TreeIter
iter TreeModel
model' TreeModel
castModel
    CellRenderer ManagedPtr CellRenderer
cellPtr <- cell -> IO CellRenderer
forall (m :: * -> *) o.
(MonadIO m, IsCellRenderer o) =>
o -> m CellRenderer
toCellRenderer cell
cell
    if ManagedPtr CellRenderer -> ForeignPtr CellRenderer
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr CellRenderer
cellPtr ForeignPtr CellRenderer -> ForeignPtr CellRenderer -> Bool
forall a. Eq a => a -> a -> Bool
/= ManagedPtr CellRenderer -> ForeignPtr CellRenderer
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr CellRenderer
cellPtr' then
      [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char]
"cellLayoutSetAttributeFunc: attempt to set attributes of "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
             [Char]
"a different CellRenderer.")
      else TreeIter -> IO ()
func TreeIter
iter

-- Given a 'TreeModelFilter' or a 'TreeModelSort' and a 'TreeIter', get the
-- child model of these models and convert the iter to an iter of the child
-- model. This is an ugly internal function that is needed for some widgets
-- which pass iterators to the callback function of set_cell_data_func that
-- refer to some internal TreeModelFilter models that they create around the
-- user model. This is a bug but since C programs mostly use the columns
-- rather than the cell_layout way to extract attributes, this bug does not
-- show up in many programs. Reported in the case of EntryCompletion as bug
-- \#551202.
--
convertIterFromParentToChildModel ::
     TreeIter -- ^ the iterator
  -> TreeModel -- ^ the model that we got from the all back
  -> TreeModel -- ^ the model that we actually want
  -> IO TreeIter
convertIterFromParentToChildModel :: TreeIter -> TreeModel -> TreeModel -> IO TreeIter
convertIterFromParentToChildModel TreeIter
iter parentModel :: TreeModel
parentModel@(TreeModel ManagedPtr TreeModel
parentModelPtr) TreeModel
childModel =
  let (TreeModel ManagedPtr TreeModel
modelPtr) = TreeModel
childModel in
  if ManagedPtr TreeModel -> ForeignPtr TreeModel
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr TreeModel
modelPtr ForeignPtr TreeModel -> ForeignPtr TreeModel -> Bool
forall a. Eq a => a -> a -> Bool
== ManagedPtr TreeModel -> ForeignPtr TreeModel
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr TreeModel
parentModelPtr
    then TreeIter -> IO TreeIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TreeIter
iter
    else
        (ManagedPtr TreeModelFilter -> TreeModelFilter)
-> TreeModel -> IO (Maybe TreeModelFilter)
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o', GObject o') =>
(ManagedPtr o' -> o') -> o -> IO (Maybe o')
castTo ManagedPtr TreeModelFilter -> TreeModelFilter
TreeModelFilter TreeModel
parentModel IO (Maybe TreeModelFilter)
-> (Maybe TreeModelFilter -> IO TreeIter) -> IO TreeIter
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just TreeModelFilter
tmFilter -> do
                TreeIter
childIter <- TreeModelFilter -> TreeIter -> IO TreeIter
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModelFilter a) =>
a -> TreeIter -> m TreeIter
treeModelFilterConvertIterToChildIter TreeModelFilter
tmFilter TreeIter
iter
                Just child :: TreeModel
child@(TreeModel ManagedPtr TreeModel
childPtr) <- TreeModelFilter -> IO (Maybe TreeModel)
forall (m :: * -> *) o.
(MonadIO m, IsTreeModelFilter o) =>
o -> m (Maybe TreeModel)
getTreeModelFilterChildModel TreeModelFilter
tmFilter
                if ManagedPtr TreeModel -> ForeignPtr TreeModel
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr TreeModel
childPtr ForeignPtr TreeModel -> ForeignPtr TreeModel -> Bool
forall a. Eq a => a -> a -> Bool
== ManagedPtr TreeModel -> ForeignPtr TreeModel
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr TreeModel
modelPtr
                    then TreeIter -> IO TreeIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TreeIter
childIter
                    else TreeIter -> TreeModel -> TreeModel -> IO TreeIter
convertIterFromParentToChildModel TreeIter
childIter TreeModel
child TreeModel
childModel
            Maybe TreeModelFilter
Nothing -> do
                (ManagedPtr TreeModelSort -> TreeModelSort)
-> TreeModel -> IO (Maybe TreeModelSort)
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o', GObject o') =>
(ManagedPtr o' -> o') -> o -> IO (Maybe o')
castTo ManagedPtr TreeModelSort -> TreeModelSort
TreeModelSort TreeModel
parentModel IO (Maybe TreeModelSort)
-> (Maybe TreeModelSort -> IO TreeIter) -> IO TreeIter
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Just TreeModelSort
tmSort -> do
                        TreeIter
childIter <- TreeModelSort -> TreeIter -> IO TreeIter
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModelSort a) =>
a -> TreeIter -> m TreeIter
treeModelSortConvertIterToChildIter TreeModelSort
tmSort TreeIter
iter
                        child :: TreeModel
child@(TreeModel ManagedPtr TreeModel
childPtr) <- TreeModelSort -> IO TreeModel
forall (m :: * -> *) o.
(MonadIO m, IsTreeModelSort o) =>
o -> m TreeModel
getTreeModelSortModel TreeModelSort
tmSort
                        if ManagedPtr TreeModel -> ForeignPtr TreeModel
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr TreeModel
childPtr ForeignPtr TreeModel -> ForeignPtr TreeModel -> Bool
forall a. Eq a => a -> a -> Bool
== ManagedPtr TreeModel -> ForeignPtr TreeModel
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr TreeModel
modelPtr
                            then TreeIter -> IO TreeIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TreeIter
childIter
                            else TreeIter -> TreeModel -> TreeModel -> IO TreeIter
convertIterFromParentToChildModel TreeIter
childIter TreeModel
child TreeModel
childModel
                    Maybe TreeModelSort
Nothing -> do
                        Int32
stamp <- TreeIter -> IO Int32
forall (m :: * -> *). MonadIO m => TreeIter -> m Int32
getTreeIterStamp TreeIter
iter
                        Ptr ()
ud1 <- TreeIter -> IO (Ptr ())
forall (m :: * -> *). MonadIO m => TreeIter -> m (Ptr ())
getTreeIterUserData TreeIter
iter
                        Ptr ()
ud2 <- TreeIter -> IO (Ptr ())
forall (m :: * -> *). MonadIO m => TreeIter -> m (Ptr ())
getTreeIterUserData2 TreeIter
iter
                        Ptr ()
ud3 <- TreeIter -> IO (Ptr ())
forall (m :: * -> *). MonadIO m => TreeIter -> m (Ptr ())
getTreeIterUserData3 TreeIter
iter
                        [Char] -> IO TreeIter
forall a. HasCallStack => [Char] -> a
error ([Char]
"CellLayout: don't know how to convert iter "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(Int32, Ptr (), Ptr (), Ptr ()) -> [Char]
forall a. Show a => a -> [Char]
show (Int32
stamp, Ptr ()
ud1, Ptr ()
ud2, Ptr ()
ud3)[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                               [Char]
" from model "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ForeignPtr TreeModel -> [Char]
forall a. Show a => a -> [Char]
show (ManagedPtr TreeModel -> ForeignPtr TreeModel
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr TreeModel
parentModelPtr)[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" to model "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                               ForeignPtr TreeModel -> [Char]
forall a. Show a => a -> [Char]
show (ManagedPtr TreeModel -> ForeignPtr TreeModel
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr TreeModel
modelPtr)[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
". Is it possible that you are setting the "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                               [Char]
"attributes of a CellRenderer using a different model than "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                               [Char]
"that which was set in the view?")