{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) CustomStore TreeModel
--
--  Author : Duncan Coutts, Axel Simon
--
--  Created: 11 Feburary 2006
--
--  Copyright (C) 2005 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.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Standard model to store list data.
--
module Graphics.UI.Gtk.ModelView.ListStore (

-- * Types
  ListStore,

-- * Constructors
  listStoreNew,
  listStoreNewDND,

-- * Implementation of Interfaces
  listStoreDefaultDragSourceIface,
  listStoreDefaultDragDestIface,

-- * Methods
  listStoreIterToIndex,
  listStoreGetValue,
  listStoreSafeGetValue,
  listStoreSetValue,
  listStoreToList,
  listStoreGetSize,
  listStoreInsert,
  listStorePrepend,
  listStoreAppend,
  listStoreRemove,
  listStoreClear,
  ) where

import Control.Monad (liftM, when)
import Data.IORef
import Data.Ix (inRange)

#if __GLASGOW_HASKELL__>=606
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Foldable as F
#else
import qualified Graphics.UI.Gtk.ModelView.Sequence as Seq
import Graphics.UI.Gtk.ModelView.Sequence (Seq)
#endif

import Graphics.UI.Gtk.Types (GObjectClass(..))
-- import Graphics.UI.Gtk.ModelView.Types ()
import Graphics.UI.Gtk.ModelView.CustomStore
import Graphics.UI.Gtk.ModelView.TreeModel
import Graphics.UI.Gtk.ModelView.TreeDrag
import Control.Monad.Trans ( liftIO )

newtype ListStore a = ListStore (CustomStore (IORef (Seq a)) a)

instance TypedTreeModelClass ListStore
instance TreeModelClass (ListStore a)
instance GObjectClass (ListStore a) where
  toGObject :: ListStore a -> GObject
toGObject (ListStore CustomStore (IORef (Seq a)) a
tm) = forall o. GObjectClass o => o -> GObject
toGObject CustomStore (IORef (Seq a)) a
tm
  unsafeCastGObject :: GObject -> ListStore a
unsafeCastGObject = forall a. CustomStore (IORef (Seq a)) a -> ListStore a
ListStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o. GObjectClass o => GObject -> o
unsafeCastGObject

-- | Create a new 'TreeModel' that contains a list of elements.
listStoreNew :: [a] -> IO (ListStore a)
listStoreNew :: forall a. [a] -> IO (ListStore a)
listStoreNew [a]
xs = forall a.
[a]
-> Maybe (DragSourceIface ListStore a)
-> Maybe (DragDestIface ListStore a)
-> IO (ListStore a)
listStoreNewDND [a]
xs (forall a. a -> Maybe a
Just forall row. DragSourceIface ListStore row
listStoreDefaultDragSourceIface)
                                     (forall a. a -> Maybe a
Just forall row. DragDestIface ListStore row
listStoreDefaultDragDestIface)

-- | Create a new 'TreeModel' that contains a list of elements. In addition, specify two
--   interfaces for drag and drop.
--
listStoreNewDND :: [a] -- ^ the initial content of the model
  -> Maybe (DragSourceIface ListStore a) -- ^ an optional interface for drags
  -> Maybe (DragDestIface ListStore a) -- ^ an optional interface to handle drops
  -> IO (ListStore a) -- ^ the new model
listStoreNewDND :: forall a.
[a]
-> Maybe (DragSourceIface ListStore a)
-> Maybe (DragDestIface ListStore a)
-> IO (ListStore a)
listStoreNewDND [a]
xs Maybe (DragSourceIface ListStore a)
mDSource Maybe (DragDestIface ListStore a)
mDDest = do
  IORef (Seq a)
rows <- forall a. a -> IO (IORef a)
newIORef (forall a. [a] -> Seq a
Seq.fromList [a]
xs)

  forall (model :: * -> *) row private.
(TreeModelClass (model row), TypedTreeModelClass model) =>
private
-> (CustomStore private row -> model row)
-> TreeModelIface row
-> Maybe (DragSourceIface model row)
-> Maybe (DragDestIface model row)
-> IO (model row)
customStoreNew IORef (Seq a)
rows forall a. CustomStore (IORef (Seq a)) a -> ListStore a
ListStore TreeModelIface {
      treeModelIfaceGetFlags :: IO [TreeModelFlags]
treeModelIfaceGetFlags      = forall (m :: * -> *) a. Monad m => a -> m a
return [TreeModelFlags
TreeModelListOnly],
      treeModelIfaceGetIter :: TreePath -> IO (Maybe TreeIter)
treeModelIfaceGetIter       = \[Int
n] -> forall a. IORef a -> IO a
readIORef IORef (Seq a)
rows forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Seq a
rows ->
                                     forall (m :: * -> *) a. Monad m => a -> m a
return (if forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
0, forall a. Seq a -> Int
Seq.length Seq a
rows forall a. Num a => a -> a -> a
- Int
1) Int
n
                                                 then forall a. a -> Maybe a
Just (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Word32
0 Word32
0)
                                                 else forall a. Maybe a
Nothing),
      treeModelIfaceGetPath :: TreeIter -> IO TreePath
treeModelIfaceGetPath       = \(TreeIter CInt
_ Word32
n Word32
_ Word32
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return [forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n],
      treeModelIfaceGetRow :: TreeIter -> IO a
treeModelIfaceGetRow        = \(TreeIter CInt
_ Word32
n Word32
_ Word32
_) ->
                                 forall a. IORef a -> IO a
readIORef IORef (Seq a)
rows forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Seq a
rows ->
                                 if forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
0, forall a. Seq a -> Int
Seq.length Seq a
rows forall a. Num a => a -> a -> a
- Int
1) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)
                                   then forall (m :: * -> *) a. Monad m => a -> m a
return (Seq a
rows forall a. Seq a -> Int -> a
`Seq.index` forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)
                                   else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ListStore.getRow: iter does not refer to a valid entry",

      treeModelIfaceIterNext :: TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterNext      = \(TreeIter CInt
_ Word32
n Word32
_ Word32
_) ->
                                 forall a. IORef a -> IO a
readIORef IORef (Seq a)
rows forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Seq a
rows ->
                                 if forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
0, forall a. Seq a -> Int
Seq.length Seq a
rows forall a. Num a => a -> a -> a
- Int
1) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
nforall a. Num a => a -> a -> a
+Word32
1))
                                   then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
0 (Word32
nforall a. Num a => a -> a -> a
+Word32
1) Word32
0 Word32
0))
                                   else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing,
      treeModelIfaceIterChildren :: Maybe TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterChildren  = \Maybe TreeIter
index -> forall a. IORef a -> IO a
readIORef IORef (Seq a)
rows forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Seq a
rows ->
                                         case Maybe TreeIter
index of
                                             Maybe TreeIter
Nothing | Bool -> Bool
not (forall a. Seq a -> Bool
Seq.null Seq a
rows) ->
                                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
0 Word32
0 Word32
0 Word32
0))
                                             Maybe TreeIter
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing,
      treeModelIfaceIterHasChild :: TreeIter -> IO Bool
treeModelIfaceIterHasChild  = \TreeIter
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
      treeModelIfaceIterNChildren :: Maybe TreeIter -> IO Int
treeModelIfaceIterNChildren = \Maybe TreeIter
index -> forall a. IORef a -> IO a
readIORef IORef (Seq a)
rows forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Seq a
rows ->
                                           case Maybe TreeIter
index of
                                             Maybe TreeIter
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Seq a -> Int
Seq.length Seq a
rows
                                             Maybe TreeIter
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
0,
      treeModelIfaceIterNthChild :: Maybe TreeIter -> Int -> IO (Maybe TreeIter)
treeModelIfaceIterNthChild  = \Maybe TreeIter
index Int
n -> case Maybe TreeIter
index of
                                               Maybe TreeIter
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Word32
0 Word32
0))
                                               Maybe TreeIter
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing,
      treeModelIfaceIterParent :: TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterParent    = \TreeIter
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing,
      treeModelIfaceRefNode :: TreeIter -> IO ()
treeModelIfaceRefNode       = \TreeIter
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (),
      treeModelIfaceUnrefNode :: TreeIter -> IO ()
treeModelIfaceUnrefNode     = \TreeIter
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    } Maybe (DragSourceIface ListStore a)
mDSource Maybe (DragDestIface ListStore a)
mDDest


-- | Convert a 'TreeIter' to an an index into the 'ListStore'. Note that this
--   function merely extracts the second element of the 'TreeIter'.
listStoreIterToIndex :: TreeIter -> Int
listStoreIterToIndex :: TreeIter -> Int
listStoreIterToIndex (TreeIter CInt
_ Word32
n Word32
_ Word32
_) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n

-- | Default drag functions for 'Graphics.UI.Gtk.ModelView.ListStore'. These
-- functions allow the rows of the model to serve as drag source. Any row is
-- allowed to be dragged and the data set in the 'SelectionDataM' object is
-- set with 'treeSetRowDragData', i.e. it contains the model and the
-- 'TreePath' to the row.
listStoreDefaultDragSourceIface :: DragSourceIface ListStore row
listStoreDefaultDragSourceIface :: forall row. DragSourceIface ListStore row
listStoreDefaultDragSourceIface = DragSourceIface {
    treeDragSourceRowDraggable :: ListStore row -> TreePath -> IO Bool
treeDragSourceRowDraggable = \ListStore row
_ TreePath
_-> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
    treeDragSourceDragDataGet :: ListStore row -> TreePath -> SelectionDataM Bool
treeDragSourceDragDataGet = forall treeModel.
TreeModelClass treeModel =>
treeModel -> TreePath -> SelectionDataM Bool
treeSetRowDragData,
    treeDragSourceDragDataDelete :: ListStore row -> TreePath -> IO Bool
treeDragSourceDragDataDelete = \ListStore row
model (Int
dest:TreePath
_) -> do
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ListStore a -> Int -> IO ()
listStoreRemove ListStore row
model Int
dest
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

  }

-- | Default drop functions for 'Graphics.UI.Gtk.ModelView.ListStore'. These
--   functions accept a row and insert the row into the new location if it is
--   dragged into a tree view
-- that uses the same model.
listStoreDefaultDragDestIface :: DragDestIface ListStore row
listStoreDefaultDragDestIface :: forall row. DragDestIface ListStore row
listStoreDefaultDragDestIface = DragDestIface {
    treeDragDestRowDropPossible :: ListStore row -> TreePath -> SelectionDataM Bool
treeDragDestRowDropPossible = \ListStore row
model TreePath
dest -> do
      Maybe (TreeModel, TreePath)
mModelPath <- SelectionDataM (Maybe (TreeModel, TreePath))
treeGetRowDragData
      case Maybe (TreeModel, TreePath)
mModelPath of
        Maybe (TreeModel, TreePath)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just (TreeModel
model', TreePath
source) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall o. TreeModelClass o => o -> TreeModel
toTreeModel ListStore row
modelforall a. Eq a => a -> a -> Bool
==forall o. TreeModelClass o => o -> TreeModel
toTreeModel TreeModel
model'),
    treeDragDestDragDataReceived :: ListStore row -> TreePath -> SelectionDataM Bool
treeDragDestDragDataReceived = \ListStore row
model (Int
dest:TreePath
_) -> do
      Maybe (TreeModel, TreePath)
mModelPath <- SelectionDataM (Maybe (TreeModel, TreePath))
treeGetRowDragData
      case Maybe (TreeModel, TreePath)
mModelPath of
        Maybe (TreeModel, TreePath)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just (TreeModel
model', (Int
source:TreePath
_)) ->
          if forall o. TreeModelClass o => o -> TreeModel
toTreeModel ListStore row
modelforall a. Eq a => a -> a -> Bool
/=forall o. TreeModelClass o => o -> TreeModel
toTreeModel TreeModel
model' then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            row
row <- forall a. ListStore a -> Int -> IO a
listStoreGetValue ListStore row
model Int
source
            forall a. ListStore a -> Int -> a -> IO ()
listStoreInsert ListStore row
model Int
dest row
row
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  }

-- | Extract the value at the given index.
--
listStoreGetValue :: ListStore a -> Int -> IO a
listStoreGetValue :: forall a. ListStore a -> Int -> IO a
listStoreGetValue (ListStore CustomStore (IORef (Seq a)) a
model) Int
index =
  forall a. IORef a -> IO a
readIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Seq a -> Int -> a
`Seq.index` Int
index)

-- | Extract the value at the given index.
--
listStoreSafeGetValue :: ListStore a -> Int -> IO (Maybe a)
listStoreSafeGetValue :: forall a. ListStore a -> Int -> IO (Maybe a)
listStoreSafeGetValue (ListStore CustomStore (IORef (Seq a)) a
model) Int
index = do
  Seq a
seq <- forall a. IORef a -> IO a
readIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Int
index forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
index forall a. Ord a => a -> a -> Bool
< forall a. Seq a -> Int
Seq.length Seq a
seq
                then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Seq a
seq forall a. Seq a -> Int -> a
`Seq.index` Int
index
                else forall a. Maybe a
Nothing

-- | Update the value at the given index. The index must exist.
--
listStoreSetValue :: ListStore a -> Int -> a -> IO ()
listStoreSetValue :: forall a. ListStore a -> Int -> a -> IO ()
listStoreSetValue (ListStore CustomStore (IORef (Seq a)) a
model) Int
index a
value = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model) (forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
index a
value)
  CInt
stamp <- forall private row. CustomStore private row -> IO CInt
customStoreGetStamp CustomStore (IORef (Seq a)) a
model
  forall self.
TreeModelClass self =>
self -> TreePath -> TreeIter -> IO ()
treeModelRowChanged CustomStore (IORef (Seq a)) a
model [Int
index] (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
stamp (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) Word32
0 Word32
0)

-- | Extract all data from the store.
--
listStoreToList :: ListStore a -> IO [a]
listStoreToList :: forall a. ListStore a -> IO [a]
listStoreToList (ListStore CustomStore (IORef (Seq a)) a
model) =
  forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
#if __GLASGOW_HASKELL__>=606
  forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
#else
  Seq.toList
#endif
  forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)

-- | Query the number of elements in the store.
listStoreGetSize :: ListStore a -> IO Int
listStoreGetSize :: forall a. ListStore a -> IO Int
listStoreGetSize (ListStore CustomStore (IORef (Seq a)) a
model) =
  forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Seq a -> Int
Seq.length forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)

-- | Insert an element in front of the given element. The element is appended
-- if the index is greater or equal to the size of the list.
listStoreInsert :: ListStore a -> Int -> a -> IO ()
listStoreInsert :: forall a. ListStore a -> Int -> a -> IO ()
listStoreInsert (ListStore CustomStore (IORef (Seq a)) a
model) Int
index a
value = do
  Seq a
seq <- forall a. IORef a -> IO a
readIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ do
    let index' :: Int
index' | Int
index forall a. Ord a => a -> a -> Bool
> forall a. Seq a -> Int
Seq.length Seq a
seq = forall a. Seq a -> Int
Seq.length Seq a
seq
               | Bool
otherwise              = Int
index
    forall a. IORef a -> a -> IO ()
writeIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model) (forall a. Int -> a -> Seq a -> Seq a
insert Int
index' a
value Seq a
seq)
    CInt
stamp <- forall private row. CustomStore private row -> IO CInt
customStoreGetStamp CustomStore (IORef (Seq a)) a
model
    forall self.
TreeModelClass self =>
self -> TreePath -> TreeIter -> IO ()
treeModelRowInserted CustomStore (IORef (Seq a)) a
model [Int
index'] (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
stamp (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index') Word32
0 Word32
0)

  where insert :: Int -> a -> Seq a -> Seq a
        insert :: forall a. Int -> a -> Seq a -> Seq a
insert Int
i a
x Seq a
xs = Seq a
front forall a. Seq a -> Seq a -> Seq a
Seq.>< a
x forall a. a -> Seq a -> Seq a
Seq.<| Seq a
back
          where (Seq a
front, Seq a
back) = forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
i Seq a
xs

-- | Prepend the element to the store.
listStorePrepend :: ListStore a -> a -> IO ()
listStorePrepend :: forall a. ListStore a -> a -> IO ()
listStorePrepend (ListStore CustomStore (IORef (Seq a)) a
model) a
value = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
              (\Seq a
seq -> a
value forall a. a -> Seq a -> Seq a
Seq.<| Seq a
seq)
  CInt
stamp <- forall private row. CustomStore private row -> IO CInt
customStoreGetStamp CustomStore (IORef (Seq a)) a
model
  forall self.
TreeModelClass self =>
self -> TreePath -> TreeIter -> IO ()
treeModelRowInserted CustomStore (IORef (Seq a)) a
model [Int
0] (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
stamp Word32
0 Word32
0 Word32
0)

---- | Prepend a list to the store. Not implemented yet.
--listStorePrependList :: ListStore a -> [a] -> IO ()
--listStorePrependList store list =
--  mapM_ (listStoreInsert store 0) (reverse list)

-- | Append an element to the store. Returns the index of the inserted
-- element.
listStoreAppend :: ListStore a -> a -> IO Int
listStoreAppend :: forall a. ListStore a -> a -> IO Int
listStoreAppend (ListStore CustomStore (IORef (Seq a)) a
model) a
value = do
  Int
index <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
                             (\Seq a
seq -> (Seq a
seq forall a. Seq a -> a -> Seq a
Seq.|> a
value, forall a. Seq a -> Int
Seq.length Seq a
seq))
  CInt
stamp <- forall private row. CustomStore private row -> IO CInt
customStoreGetStamp CustomStore (IORef (Seq a)) a
model
  forall self.
TreeModelClass self =>
self -> TreePath -> TreeIter -> IO ()
treeModelRowInserted CustomStore (IORef (Seq a)) a
model [Int
index] (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
stamp (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) Word32
0 Word32
0)
  forall (m :: * -> *) a. Monad m => a -> m a
return Int
index

{-
listStoreAppendList :: ListStore a -> [a] -> IO ()
listStoreAppendList (ListStore model) values = do
  seq <- readIORef (customStoreGetPrivate model)
  let seq' = Seq.fromList values
      startIndex = Seq.length seq
      endIndex = startIndex + Seq.length seq' - 1
  writeIORef (customStoreGetPrivate model) (seq Seq.>< seq')
  stamp <- customStoreGetStamp model
  flip mapM [startIndex..endIndex] $ \index ->
    treeModelRowInserted model [index] (TreeIter stamp (fromIntegral index) 0 0)
-}

-- | Remove the element at the given index.
--
listStoreRemove :: ListStore a -> Int -> IO ()
listStoreRemove :: forall a. ListStore a -> Int -> IO ()
listStoreRemove (ListStore CustomStore (IORef (Seq a)) a
model) Int
index = do
  Seq a
seq <- forall a. IORef a -> IO a
readIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
index forall a. Ord a => a -> a -> Bool
< forall a. Seq a -> Int
Seq.length Seq a
seq) forall a b. (a -> b) -> a -> b
$ do
    forall a. IORef a -> a -> IO ()
writeIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model) (forall a. Int -> Seq a -> Seq a
delete Int
index Seq a
seq)
    forall self. TreeModelClass self => self -> TreePath -> IO ()
treeModelRowDeleted CustomStore (IORef (Seq a)) a
model [Int
index]
  where delete :: Int -> Seq a -> Seq a
        delete :: forall a. Int -> Seq a -> Seq a
delete Int
i Seq a
xs = Seq a
front forall a. Seq a -> Seq a -> Seq a
Seq.>< forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq a
back
          where (Seq a
front, Seq a
back) = forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
i Seq a
xs

-- | Empty the store.
listStoreClear :: ListStore a -> IO ()
listStoreClear :: forall a. ListStore a -> IO ()
listStoreClear (ListStore CustomStore (IORef (Seq a)) a
model) =

  -- Since deleting rows can cause callbacks (eg due to selection changes)
  -- we have to make sure the model is consitent with the view at each
  -- intermediate step of clearing the store. Otherwise at some intermediate
  -- stage when the view has only been informed about some delections, the
  -- user might query the model expecting to find the remaining rows are there
  -- but find them deleted. That'd be bad.
  --
  let loop :: Int -> ViewR a -> IO ()
loop (-1) ViewR a
Seq.EmptyR = forall (m :: * -> *) a. Monad m => a -> m a
return ()
      loop Int
n (Seq a
seq Seq.:> a
_) = do
        forall a. IORef a -> a -> IO ()
writeIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model) Seq a
seq
        forall self. TreeModelClass self => self -> TreePath -> IO ()
treeModelRowDeleted CustomStore (IORef (Seq a)) a
model [Int
n]
        Int -> ViewR a -> IO ()
loop (Int
nforall a. Num a => a -> a -> a
-Int
1) (forall a. Seq a -> ViewR a
Seq.viewr Seq a
seq)

   in do Seq a
seq <- forall a. IORef a -> IO a
readIORef (forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
         Int -> ViewR a -> IO ()
loop (forall a. Seq a -> Int
Seq.length Seq a
seq forall a. Num a => a -> a -> a
- Int
1) (forall a. Seq a -> ViewR a
Seq.viewr Seq a
seq)

---- | Permute the rows of the store. Not yet implemented.
--listStoreReorder :: ListStore a -> [Int] -> IO ()
--listStoreReorder store = undefined
--
---- | Swap two rows of the store. Not yet implemented.
--listStoreSwap :: ListStore a -> Int -> Int -> IO ()
--listStoreSwap store = undefined
--
---- | Move the element at the first index in front of the element denoted by
---- the second index. Not yet implemented.
--listStoreMoveBefore :: ListStore a -> Int -> Int -> IO ()
--listStoreMoveBefore store = undefined
--
---- | Move the element at the first index past the element denoted by the
---- second index. Not yet implemented.
--listStoreMoveAfter :: ListStore a -> Int -> Int -> IO ()
--listStoreMoveAfter store = undefined