{-# 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) = CustomStore (IORef (Seq a)) a -> GObject
forall o. GObjectClass o => o -> GObject
toGObject CustomStore (IORef (Seq a)) a
tm
  unsafeCastGObject :: GObject -> ListStore a
unsafeCastGObject = CustomStore (IORef (Seq a)) a -> ListStore a
forall a. CustomStore (IORef (Seq a)) a -> ListStore a
ListStore (CustomStore (IORef (Seq a)) a -> ListStore a)
-> (GObject -> CustomStore (IORef (Seq a)) a)
-> GObject
-> ListStore a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GObject -> CustomStore (IORef (Seq a)) a
forall o. GObjectClass o => GObject -> o
unsafeCastGObject

-- | Create a new 'TreeModel' that contains a list of elements.
listStoreNew :: [a] -> IO (ListStore a)
listStoreNew :: [a] -> IO (ListStore a)
listStoreNew [a]
xs = [a]
-> Maybe (DragSourceIface ListStore a)
-> Maybe (DragDestIface ListStore a)
-> IO (ListStore a)
forall a.
[a]
-> Maybe (DragSourceIface ListStore a)
-> Maybe (DragDestIface ListStore a)
-> IO (ListStore a)
listStoreNewDND [a]
xs (DragSourceIface ListStore a -> Maybe (DragSourceIface ListStore a)
forall a. a -> Maybe a
Just DragSourceIface ListStore a
forall row. DragSourceIface ListStore row
listStoreDefaultDragSourceIface)
                                     (DragDestIface ListStore a -> Maybe (DragDestIface ListStore a)
forall a. a -> Maybe a
Just DragDestIface ListStore a
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 :: [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 <- Seq a -> IO (IORef (Seq a))
forall a. a -> IO (IORef a)
newIORef ([a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a]
xs)

  IORef (Seq a)
-> (CustomStore (IORef (Seq a)) a -> ListStore a)
-> TreeModelIface a
-> Maybe (DragSourceIface ListStore a)
-> Maybe (DragDestIface ListStore a)
-> IO (ListStore a)
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 CustomStore (IORef (Seq a)) a -> ListStore a
forall a. CustomStore (IORef (Seq a)) a -> ListStore a
ListStore TreeModelIface :: forall row.
IO [TreeModelFlags]
-> (TreePath -> IO (Maybe TreeIter))
-> (TreeIter -> IO TreePath)
-> (TreeIter -> IO row)
-> (TreeIter -> IO (Maybe TreeIter))
-> (Maybe TreeIter -> IO (Maybe TreeIter))
-> (TreeIter -> IO Bool)
-> (Maybe TreeIter -> IO Int)
-> (Maybe TreeIter -> Int -> IO (Maybe TreeIter))
-> (TreeIter -> IO (Maybe TreeIter))
-> (TreeIter -> IO ())
-> (TreeIter -> IO ())
-> TreeModelIface row
TreeModelIface {
      treeModelIfaceGetFlags :: IO [TreeModelFlags]
treeModelIfaceGetFlags      = [TreeModelFlags] -> IO [TreeModelFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [TreeModelFlags
TreeModelListOnly],
      treeModelIfaceGetIter :: TreePath -> IO (Maybe TreeIter)
treeModelIfaceGetIter       = \[Int
n] -> IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef IORef (Seq a)
rows IO (Seq a) -> (Seq a -> IO (Maybe TreeIter)) -> IO (Maybe TreeIter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Seq a
rows ->
                                     Maybe TreeIter -> IO (Maybe TreeIter)
forall (m :: * -> *) a. Monad m => a -> m a
return (if (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
0, Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
n
                                                 then TreeIter -> Maybe TreeIter
forall a. a -> Maybe a
Just (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
0 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Word32
0 Word32
0)
                                                 else Maybe TreeIter
forall a. Maybe a
Nothing),
      treeModelIfaceGetPath :: TreeIter -> IO TreePath
treeModelIfaceGetPath       = \(TreeIter CInt
_ Word32
n Word32
_ Word32
_) -> TreePath -> IO TreePath
forall (m :: * -> *) a. Monad m => a -> m a
return [Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n],
      treeModelIfaceGetRow :: TreeIter -> IO a
treeModelIfaceGetRow        = \(TreeIter CInt
_ Word32
n Word32
_ Word32
_) ->
                                 IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef IORef (Seq a)
rows IO (Seq a) -> (Seq a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Seq a
rows ->
                                 if (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
0, Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)
                                   then a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq a
rows Seq a -> Int -> a
forall a. Seq a -> Int -> a
`Seq.index` Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)
                                   else String -> IO a
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
_) ->
                                 IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef IORef (Seq a)
rows IO (Seq a) -> (Seq a -> IO (Maybe TreeIter)) -> IO (Maybe TreeIter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Seq a
rows ->
                                 if (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
0, Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
nWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1))
                                   then Maybe TreeIter -> IO (Maybe TreeIter)
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeIter -> Maybe TreeIter
forall a. a -> Maybe a
Just (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
0 (Word32
nWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1) Word32
0 Word32
0))
                                   else Maybe TreeIter -> IO (Maybe TreeIter)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
      treeModelIfaceIterChildren :: Maybe TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterChildren  = \Maybe TreeIter
index -> IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef IORef (Seq a)
rows IO (Seq a) -> (Seq a -> IO (Maybe TreeIter)) -> IO (Maybe TreeIter)
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 (Seq a -> Bool
forall a. Seq a -> Bool
Seq.null Seq a
rows) ->
                                                        Maybe TreeIter -> IO (Maybe TreeIter)
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeIter -> Maybe TreeIter
forall a. a -> Maybe a
Just (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
0 Word32
0 Word32
0 Word32
0))
                                             Maybe TreeIter
_       -> Maybe TreeIter -> IO (Maybe TreeIter)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
      treeModelIfaceIterHasChild :: TreeIter -> IO Bool
treeModelIfaceIterHasChild  = \TreeIter
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
      treeModelIfaceIterNChildren :: Maybe TreeIter -> IO Int
treeModelIfaceIterNChildren = \Maybe TreeIter
index -> IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef IORef (Seq a)
rows IO (Seq a) -> (Seq a -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Seq a
rows ->
                                           case Maybe TreeIter
index of
                                             Maybe TreeIter
Nothing -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
rows
                                             Maybe TreeIter
_       -> Int -> IO Int
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 -> Maybe TreeIter -> IO (Maybe TreeIter)
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeIter -> Maybe TreeIter
forall a. a -> Maybe a
Just (CInt -> Word32 -> Word32 -> Word32 -> TreeIter
TreeIter CInt
0 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Word32
0 Word32
0))
                                               Maybe TreeIter
_       -> Maybe TreeIter -> IO (Maybe TreeIter)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
      treeModelIfaceIterParent :: TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterParent    = \TreeIter
_ -> Maybe TreeIter -> IO (Maybe TreeIter)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
      treeModelIfaceRefNode :: TreeIter -> IO ()
treeModelIfaceRefNode       = \TreeIter
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
      treeModelIfaceUnrefNode :: TreeIter -> IO ()
treeModelIfaceUnrefNode     = \TreeIter
_ -> () -> IO ()
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
_) = Word32 -> Int
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 :: DragSourceIface ListStore row
listStoreDefaultDragSourceIface = DragSourceIface :: forall (model :: * -> *) row.
(model row -> TreePath -> IO Bool)
-> (model row -> TreePath -> SelectionDataM Bool)
-> (model row -> TreePath -> IO Bool)
-> DragSourceIface model row
DragSourceIface {
    treeDragSourceRowDraggable :: ListStore row -> TreePath -> IO Bool
treeDragSourceRowDraggable = \ListStore row
_ TreePath
_-> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
    treeDragSourceDragDataGet :: ListStore row -> TreePath -> SelectionDataM Bool
treeDragSourceDragDataGet = ListStore row -> TreePath -> SelectionDataM Bool
forall treeModel.
TreeModelClass treeModel =>
treeModel -> TreePath -> SelectionDataM Bool
treeSetRowDragData,
    treeDragSourceDragDataDelete :: ListStore row -> TreePath -> IO Bool
treeDragSourceDragDataDelete = \ListStore row
model (Int
dest:TreePath
_) -> do
            IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ListStore row -> Int -> IO ()
forall a. ListStore a -> Int -> IO ()
listStoreRemove ListStore row
model Int
dest
            Bool -> IO Bool
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 :: DragDestIface ListStore row
listStoreDefaultDragDestIface = DragDestIface :: forall (model :: * -> *) row.
(model row -> TreePath -> SelectionDataM Bool)
-> (model row -> TreePath -> SelectionDataM Bool)
-> DragDestIface model row
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 -> Bool -> SelectionDataM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just (TreeModel
model', TreePath
source) -> Bool -> SelectionDataM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (ListStore row -> TreeModel
forall o. TreeModelClass o => o -> TreeModel
toTreeModel ListStore row
modelTreeModel -> TreeModel -> Bool
forall a. Eq a => a -> a -> Bool
==TreeModel -> TreeModel
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 -> Bool -> SelectionDataM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just (TreeModel
model', (Int
source:TreePath
_)) ->
          if ListStore row -> TreeModel
forall o. TreeModelClass o => o -> TreeModel
toTreeModel ListStore row
modelTreeModel -> TreeModel -> Bool
forall a. Eq a => a -> a -> Bool
/=TreeModel -> TreeModel
forall o. TreeModelClass o => o -> TreeModel
toTreeModel TreeModel
model' then Bool -> SelectionDataM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          else IO Bool -> SelectionDataM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> SelectionDataM Bool) -> IO Bool -> SelectionDataM Bool
forall a b. (a -> b) -> a -> b
$ do
            row
row <- ListStore row -> Int -> IO row
forall a. ListStore a -> Int -> IO a
listStoreGetValue ListStore row
model Int
source
            ListStore row -> Int -> row -> IO ()
forall a. ListStore a -> Int -> a -> IO ()
listStoreInsert ListStore row
model Int
dest row
row
            Bool -> IO Bool
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 :: ListStore a -> Int -> IO a
listStoreGetValue (ListStore CustomStore (IORef (Seq a)) a
model) Int
index =
  IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model) IO (Seq a) -> (Seq a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (Seq a -> a) -> Seq a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq a -> Int -> a
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 :: ListStore a -> Int -> IO (Maybe a)
listStoreSafeGetValue (ListStore CustomStore (IORef (Seq a)) a
model) Int
index = do
  Seq a
seq <- IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
  Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
seq
                then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Seq a
seq Seq a -> Int -> a
forall a. Seq a -> Int -> a
`Seq.index` Int
index
                else Maybe a
forall a. Maybe a
Nothing

-- | Update the value at the given index. The index must exist.
--
listStoreSetValue :: ListStore a -> Int -> a -> IO ()
listStoreSetValue :: ListStore a -> Int -> a -> IO ()
listStoreSetValue (ListStore CustomStore (IORef (Seq a)) a
model) Int
index a
value = do
  IORef (Seq a) -> (Seq a -> Seq a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model) (Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
index a
value)
  CInt
stamp <- CustomStore (IORef (Seq a)) a -> IO CInt
forall private row. CustomStore private row -> IO CInt
customStoreGetStamp CustomStore (IORef (Seq a)) a
model
  CustomStore (IORef (Seq a)) a -> TreePath -> TreeIter -> IO ()
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 (Int -> Word32
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 :: ListStore a -> IO [a]
listStoreToList (ListStore CustomStore (IORef (Seq a)) a
model) =
  (Seq a -> [a]) -> IO (Seq a) -> IO [a]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
#if __GLASGOW_HASKELL__>=606
  Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
#else
  Seq.toList
#endif
  (IO (Seq a) -> IO [a]) -> IO (Seq a) -> IO [a]
forall a b. (a -> b) -> a -> b
$ IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
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 :: ListStore a -> IO Int
listStoreGetSize (ListStore CustomStore (IORef (Seq a)) a
model) =
  (Seq a -> Int) -> IO (Seq a) -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Seq a -> Int
forall a. Seq a -> Int
Seq.length (IO (Seq a) -> IO Int) -> IO (Seq a) -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
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 :: ListStore a -> Int -> a -> IO ()
listStoreInsert (ListStore CustomStore (IORef (Seq a)) a
model) Int
index a
value = do
  Seq a
seq <- IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let index' :: Int
index' | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
seq = Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
seq
               | Bool
otherwise              = Int
index
    IORef (Seq a) -> Seq a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model) (Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
insert Int
index' a
value Seq a
seq)
    CInt
stamp <- CustomStore (IORef (Seq a)) a -> IO CInt
forall private row. CustomStore private row -> IO CInt
customStoreGetStamp CustomStore (IORef (Seq a)) a
model
    CustomStore (IORef (Seq a)) a -> TreePath -> TreeIter -> IO ()
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 (Int -> Word32
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 :: Int -> a -> Seq a -> Seq a
insert Int
i a
x Seq a
xs = Seq a
front Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
Seq.>< a
x a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Seq.<| Seq a
back
          where (Seq a
front, Seq a
back) = Int -> Seq a -> (Seq a, Seq a)
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 :: ListStore a -> a -> IO ()
listStorePrepend (ListStore CustomStore (IORef (Seq a)) a
model) a
value = do
  IORef (Seq a) -> (Seq a -> Seq a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
              (\Seq a
seq -> a
value a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Seq.<| Seq a
seq)
  CInt
stamp <- CustomStore (IORef (Seq a)) a -> IO CInt
forall private row. CustomStore private row -> IO CInt
customStoreGetStamp CustomStore (IORef (Seq a)) a
model
  CustomStore (IORef (Seq a)) a -> TreePath -> TreeIter -> IO ()
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 :: ListStore a -> a -> IO Int
listStoreAppend (ListStore CustomStore (IORef (Seq a)) a
model) a
value = do
  Int
index <- IORef (Seq a) -> (Seq a -> (Seq a, Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
                             (\Seq a
seq -> (Seq a
seq Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
value, Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
seq))
  CInt
stamp <- CustomStore (IORef (Seq a)) a -> IO CInt
forall private row. CustomStore private row -> IO CInt
customStoreGetStamp CustomStore (IORef (Seq a)) a
model
  CustomStore (IORef (Seq a)) a -> TreePath -> TreeIter -> IO ()
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 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) Word32
0 Word32
0)
  Int -> IO Int
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 :: ListStore a -> Int -> IO ()
listStoreRemove (ListStore CustomStore (IORef (Seq a)) a
model) Int
index = do
  Seq a
seq <- IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
seq) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    IORef (Seq a) -> Seq a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model) (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
delete Int
index Seq a
seq)
    CustomStore (IORef (Seq a)) a -> TreePath -> IO ()
forall self. TreeModelClass self => self -> TreePath -> IO ()
treeModelRowDeleted CustomStore (IORef (Seq a)) a
model [Int
index]
  where delete :: Int -> Seq a -> Seq a
        delete :: Int -> Seq a -> Seq a
delete Int
i Seq a
xs = Seq a
front Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
Seq.>< Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq a
back
          where (Seq a
front, Seq a
back) = Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
i Seq a
xs

-- | Empty the store.
listStoreClear :: ListStore a -> IO ()
listStoreClear :: 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 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      loop Int
n (Seq a
seq Seq.:> a
_) = do
        IORef (Seq a) -> Seq a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CustomStore (IORef (Seq a)) a -> IORef (Seq a)
forall private row. CustomStore private row -> private
customStoreGetPrivate CustomStore (IORef (Seq a)) a
model) Seq a
seq
        CustomStore (IORef (Seq a)) a -> TreePath -> IO ()
forall self. TreeModelClass self => self -> TreePath -> IO ()
treeModelRowDeleted CustomStore (IORef (Seq a)) a
model [Int
n]
        Int -> ViewR a -> IO ()
loop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Seq a -> ViewR a
forall a. Seq a -> ViewR a
Seq.viewr Seq a
seq)

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