-- -*-haskell-*-
--  GIMP Toolkit (GTK) TreeModel
--
--  Author : Axel Simon
--
--  Created: 8 May 2001
--
--  Copyright (C) 1999-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.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}

--
-- |
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- The tree interface used by 'TreeView'.
--
module Data.GI.Gtk.ModelView.TreeModel (
-- * Detail
--
-- | The 'TreeModel' interface defines a generic storage object for use by the
-- 'TreeView' and similar widgets. Specifically, the functions in defined here
-- are used by Gtk's widgets to access the stored data. Thus, rather than
-- calling these functions, an application programmer has to implement them.
-- While the module "Data.GI.Gtk.ModelView.CustomStore" provides the
-- necessary functions to implement the 'TreeMode' interface, it is often
-- sufficient to use the wo implementations that come with gi-gtk-hs, namely are
-- 'ListStore' and 'TreeStore'.
--
-- The model is represented as a hierarchical tree of values. It is important
-- to note that this interface only provides a way of examining a model and
-- observing changes. The implementation of each individual model decides how
-- and if changes are made.
--
-- Two generic models are provided that implement the 'TreeModel' interface:
-- the 'TreeStore' and the 'ListStore'. To use these, the developer simply
-- inserts data into these models as necessary. These models provide the data
-- structure as well as the 'TreeModel' interface. In fact, they implement
-- other interfaces, making drag and drop and storing data trivial.
--
-- A 'TreeModel' stores records of the same type. Each record is referred to
-- as row, just like in a relational database. Defining how the information of
-- a row is displayed can be done in two ways: If the widget displays data
-- using 'Data.GI.Gtk.ModelView.CellRenderer.CellRenderer' or one of its
-- derivatives, it is possible to state how a row is mapped to the attributes
-- of a renderer using the
-- 'Data.GI.Gtk.ModelView.CellLayout.cellLayoutSetAttributes' function.
-- Some widgets do not use
-- 'Data.GI.Gtk.ModelView.CellRenderer.CellRenderer's to display their
-- data. In this case an extraction function can be defined that maps a row to
-- one of a few basic types (like 'String's or 'Int's). This extraction
-- function is associated with a 'ColumnId' using
-- 'Data.GI.Gtk.ModelView.CustomStore.treeModelSetColumn'. The latter can
-- be set in the widget for the property that should be set. The widget then
-- uses the function 'treeModelGetValue' and the 'ColumnId' to extract the
-- value from the model. As the name suggests, using 'ColumnId's creates a
-- view of the data as if each row were divided into a well-defined set of
-- columns, again, like a relational database.
--
-- Models are accessed on a node level of granularity. There are two index
-- types used to reference a particular node in a model. They are the
-- 'TreePath' and the 'TreeIter'. Most of the interface consists of operations
-- on a 'TreeIter'.
--
-- A path is essentially a potential node. It is a location on a model that
-- may or may not actually correspond to a node on a specific model. A
-- 'TreePath' is in fact a synonym for a list of 'Int's and hence are easy to
-- manipulate. Each number refers to the offset at that level. Thus, the path
-- @[0]@ refers to the root node and the path @[2,4]@ refers to the fifth
-- child of the third node.
--
-- By contrast, a 'TreeIter' is a reference to a specific node on a specific
-- model. It is an abstract data type filled in by the model. One can convert
-- a path to an iterator by calling 'treeModelGetIter'. These iterators are
-- the primary way of accessing a model and are similar to the iterators used
-- by 'TextBuffer'. The model interface defines a set of operations using them
-- for navigating the model. Iterators are expected to always be valid for as
-- long as the model is unchanged (and doesn't emit a signal).
--

-- * Class Hierarchy
-- |
-- @
-- |  GInterface
-- |   +----TreeModel
-- |   +--------TypedTreeModel
-- @

  module Export,

  ColumnId,

-- * Constructors
  makeColumnIdInt,
  makeColumnIdBool,
  makeColumnIdString,
  makeColumnIdPixbuf,
  invalidColumnId,

-- * Methods
  columnIdToNumber,
  stringToTreePath,
  treeModelGetValue,
  treeModelGetIter
  ) where

import Prelude ()
import Prelude.Compat
import Data.Int (Int32)
import Data.Text (Text)
import Data.GI.Base.GValue (GValue(..), fromGValue, get_object)
import Data.GI.Base.ManagedPtr (withManagedPtr, newObject)
import Foreign.Ptr (Ptr)
import GI.GdkPixbuf.Objects.Pixbuf (Pixbuf(..))
import GI.Gtk.Structs.TreeIter (TreeIter)
import GI.Gtk.Interfaces.TreeModel as Export hiding (treeModelGetValue, treeModelGetIter)
import qualified GI.Gtk.Interfaces.TreeModel as GI (treeModelGetValue, treeModelGetIter)
import Data.GI.Gtk.ModelView.Types (stringToTreePath,
                                        ColumnId(..),
                                        ColumnAccess(..))
import Control.Monad.IO.Class (MonadIO)
import GI.Gtk.Structs.TreePath (treePathGetDepth, TreePath(..))
import Data.Maybe (fromJust)

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


-- | Create a 'ColumnId' to extract an integer.
makeColumnIdInt :: Int32 -> ColumnId row Int32
makeColumnIdInt :: forall row. Int32 -> ColumnId row Int32
makeColumnIdInt = (GValue -> IO Int32)
-> ((row -> Int32) -> ColumnAccess row)
-> Int32
-> ColumnId row Int32
forall row ty.
(GValue -> IO ty)
-> ((row -> ty) -> ColumnAccess row) -> Int32 -> ColumnId row ty
ColumnId GValue -> IO Int32
forall a (m :: * -> *). (IsGValue a, MonadIO m) => GValue -> m a
fromGValue (row -> Int32) -> ColumnAccess row
forall row. (row -> Int32) -> ColumnAccess row
CAInt

-- | Create a 'ColumnId' to extract an Boolean.
makeColumnIdBool :: Int32 -> ColumnId row Bool
makeColumnIdBool :: forall row. Int32 -> ColumnId row Bool
makeColumnIdBool = (GValue -> IO Bool)
-> ((row -> Bool) -> ColumnAccess row)
-> Int32
-> ColumnId row Bool
forall row ty.
(GValue -> IO ty)
-> ((row -> ty) -> ColumnAccess row) -> Int32 -> ColumnId row ty
ColumnId GValue -> IO Bool
forall a (m :: * -> *). (IsGValue a, MonadIO m) => GValue -> m a
fromGValue (row -> Bool) -> ColumnAccess row
forall row. (row -> Bool) -> ColumnAccess row
CABool

-- | Create a 'ColumnId' to extract an string.
makeColumnIdString :: Int32 -> ColumnId row Text
makeColumnIdString :: forall row. Int32 -> ColumnId row Text
makeColumnIdString = (GValue -> IO Text)
-> ((row -> Text) -> ColumnAccess row)
-> Int32
-> ColumnId row Text
forall row ty.
(GValue -> IO ty)
-> ((row -> ty) -> ColumnAccess row) -> Int32 -> ColumnId row ty
ColumnId (\GValue
v -> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> IO (Maybe Text) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GValue -> IO (Maybe Text)
forall a (m :: * -> *). (IsGValue a, MonadIO m) => GValue -> m a
fromGValue GValue
v) (row -> Text) -> ColumnAccess row
forall row. (row -> Text) -> ColumnAccess row
CAString

-- | Create a 'ColumnId' to extract an 'Pixbuf'.
makeColumnIdPixbuf :: Int32 -> ColumnId row Pixbuf
makeColumnIdPixbuf :: forall row. Int32 -> ColumnId row Pixbuf
makeColumnIdPixbuf = (GValue -> IO Pixbuf)
-> ((row -> Pixbuf) -> ColumnAccess row)
-> Int32
-> ColumnId row Pixbuf
forall row ty.
(GValue -> IO ty)
-> ((row -> ty) -> ColumnAccess row) -> Int32 -> ColumnId row ty
ColumnId GValue -> IO Pixbuf
gvalueToPixbuf (row -> Pixbuf) -> ColumnAccess row
forall row. (row -> Pixbuf) -> ColumnAccess row
CAPixbuf
  where gvalueToPixbuf :: GValue -> IO Pixbuf
        gvalueToPixbuf :: GValue -> IO Pixbuf
gvalueToPixbuf GValue
gv = GValue -> (Ptr GValue -> IO Pixbuf) -> IO Pixbuf
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GValue
gv ((Ptr GValue -> IO Pixbuf) -> IO Pixbuf)
-> (Ptr GValue -> IO Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$ \Ptr GValue
gvPtr -> do
          Ptr Pixbuf
objPtr <- Ptr GValue -> IO (Ptr Pixbuf)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
get_object Ptr GValue
gvPtr :: IO (Ptr Pixbuf)
          (ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pixbuf -> Pixbuf
Pixbuf Ptr Pixbuf
objPtr

-- | Convert a 'ColumnId' to a bare number.
columnIdToNumber :: ColumnId row ty -> Int32
columnIdToNumber :: forall row ty. ColumnId row ty -> Int32
columnIdToNumber (ColumnId GValue -> IO ty
_ (row -> ty) -> ColumnAccess row
_ Int32
i) = Int32
i

-- | The invalid 'ColumnId'. Widgets use this value if no column id has
--   been set.
invalidColumnId :: ColumnId row ty
invalidColumnId :: forall row ty. ColumnId row ty
invalidColumnId = (GValue -> IO ty)
-> ((row -> ty) -> ColumnAccess row) -> Int32 -> ColumnId row ty
forall row ty.
(GValue -> IO ty)
-> ((row -> ty) -> ColumnAccess row) -> Int32 -> ColumnId row ty
ColumnId ([Char] -> GValue -> IO ty
forall a. HasCallStack => [Char] -> a
error [Char]
"invalidColumnId: no GValue extractor")
  ([Char] -> (row -> ty) -> ColumnAccess row
forall a. HasCallStack => [Char] -> a
error [Char]
"invalidColumnId: no access type") (-Int32
1)

instance Eq (ColumnId row ty) where
  (ColumnId GValue -> IO ty
_ (row -> ty) -> ColumnAccess row
_ Int32
i1) == :: ColumnId row ty -> ColumnId row ty -> Bool
== (ColumnId GValue -> IO ty
_ (row -> ty) -> ColumnAccess row
_ Int32
i2) = Int32
i1Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
==Int32
i2

instance Show (ColumnId row ty) where
  show :: ColumnId row ty -> [Char]
show (ColumnId GValue -> IO ty
_ (row -> ty) -> ColumnAccess row
_ Int32
i) = Int32 -> [Char]
forall a. Show a => a -> [Char]
show Int32
i


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

-- | Read the value of at a specific column and 'TreeIter'.
--
treeModelGetValue :: IsTreeModel self => self
 -> TreeIter
 -> ColumnId row ty         -- ^ @column@ - The column to lookup the value at.
 -> IO ty
treeModelGetValue :: forall self row ty.
IsTreeModel self =>
self -> TreeIter -> ColumnId row ty -> IO ty
treeModelGetValue self
self TreeIter
iter (ColumnId GValue -> IO ty
getter (row -> ty) -> ColumnAccess row
_ Int32
colId) =
  self -> TreeIter -> Int32 -> IO GValue
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreeIter -> Int32 -> m GValue
GI.treeModelGetValue self
self TreeIter
iter Int32
colId IO GValue -> (GValue -> IO ty) -> IO ty
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GValue -> IO ty
getter

-- | Gets the a `TreeIter` or Nothing if the path is invalid or empty
treeModelGetIter :: (MonadIO m, IsTreeModel model) => model -> TreePath -> m (Maybe TreeIter)
treeModelGetIter :: forall (m :: * -> *) model.
(MonadIO m, IsTreeModel model) =>
model -> TreePath -> m (Maybe TreeIter)
treeModelGetIter model
model TreePath
path =
    TreePath -> m Int32
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TreePath -> m Int32
treePathGetDepth TreePath
path m Int32 -> (Int32 -> m (Maybe TreeIter)) -> m (Maybe TreeIter)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Int32
0 -> Maybe TreeIter -> m (Maybe TreeIter)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing
        Int32
_ -> model -> TreePath -> m (Bool, TreeIter)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> m (Bool, TreeIter)
GI.treeModelGetIter model
model TreePath
path m (Bool, TreeIter)
-> ((Bool, TreeIter) -> m (Maybe TreeIter)) -> m (Maybe TreeIter)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            (Bool
True, TreeIter
iter) -> Maybe TreeIter -> m (Maybe TreeIter)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TreeIter -> m (Maybe TreeIter))
-> Maybe TreeIter -> m (Maybe TreeIter)
forall a b. (a -> b) -> a -> b
$ TreeIter -> Maybe TreeIter
forall a. a -> Maybe a
Just TreeIter
iter
            (Bool, TreeIter)
_            -> Maybe TreeIter -> m (Maybe TreeIter)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing