{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}

-- -*-haskell-*-
--  GIMP Toolkit (GTK) CustomStore TreeModel
--
--  Author : Duncan Coutts, Axel Simon
--
--  Created: 11 Feburary 2006
--
--  Copyright (C) 2005-2016 Duncan Coutts, 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)
--
-- Standard model to store list data.
--
module Data.GI.Gtk.ModelView.SeqStore (

-- * Types
  SeqStore(..),

-- * Constructors
  seqStoreNew,
  seqStoreNewDND,

-- * Implementation of Interfaces
  seqStoreDefaultDragSourceIface,
  seqStoreDefaultDragDestIface,

-- * Methods
  seqStoreIterToIndex,
  seqStoreGetValue,
  seqStoreSafeGetValue,
  seqStoreSetValue,
  seqStoreToList,
  seqStoreGetSize,
  seqStoreInsert,
  seqStoreInsertBefore,
  seqStoreInsertAfter,
  seqStorePrepend,
  seqStoreAppend,
  seqStoreRemove,
  seqStoreClear,
  ) where

import Prelude ()
import Prelude.Compat
import Control.Monad (when)
import Control.Monad.Trans ( liftIO )
import Data.IORef
import Data.Ix (inRange)

import Foreign.ForeignPtr (ForeignPtr)

import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Foldable as F
import Data.Int (Int32)

import Data.GI.Gtk.ModelView.Types
import Data.GI.Gtk.ModelView.CustomStore
       (customStoreGetStamp, customStoreGetPrivate,
        TreeModelIface(..), customStoreNew, DragDestIface(..),
        DragSourceIface(..), CustomStore(..))
import Data.GI.Base.BasicTypes
       (TypedObject(..), ManagedPtr(..), GObject)
import Data.GI.Base.ManagedPtr (withManagedPtr)
import GI.Gtk.Interfaces.TreeModel
       (treeModelRowDeleted, treeModelRowInserted,
        treeModelRowChanged, toTreeModel, TreeModel(..), IsTreeModel(..))
import GI.GObject.Objects.Object (Object(..))
import GI.Gtk.Functions (treeGetRowDragData, treeSetRowDragData)
import GI.Gtk.Flags (TreeModelFlags(..))
import Control.Monad.IO.Class (MonadIO)
import GI.Gtk.Structs.TreeIter
       (setTreeIterUserData3, setTreeIterUserData2, setTreeIterStamp,
        setTreeIterUserData, getTreeIterUserData, TreeIter(..))
import Data.GI.Base (get, new)
import Data.GI.Base.Overloading (HasParentTypes, ParentTypes)
import Data.Word (Word32)
import Unsafe.Coerce (unsafeCoerce)
import Foreign.Ptr (nullPtr)

seqStoreIterNew :: MonadIO m => Int32 -> Int32 -> m TreeIter
seqStoreIterNew :: Int32 -> Int32 -> m TreeIter
seqStoreIterNew Int32
s Int32
u1 = do
    TreeIter
i <- (ManagedPtr TreeIter -> TreeIter)
-> [AttrOp TreeIter 'AttrSet] -> m TreeIter
forall a (tag :: AttrOpTag) (m :: * -> *).
(Constructible a tag, MonadIO m) =>
(ManagedPtr a -> a) -> [AttrOp a tag] -> m a
new ManagedPtr TreeIter -> TreeIter
TreeIter []
    TreeIter -> Int32 -> m ()
forall (m :: * -> *). MonadIO m => TreeIter -> Int32 -> m ()
setTreeIterStamp     TreeIter
i Int32
s
    TreeIter -> Ptr () -> m ()
forall (m :: * -> *). MonadIO m => TreeIter -> Ptr () -> m ()
setTreeIterUserData  TreeIter
i (Ptr () -> m ()) -> Ptr () -> m ()
forall a b. (a -> b) -> a -> b
$ Int32 -> Ptr ()
forall a b. a -> b
unsafeCoerce Int32
u1
    TreeIter -> Ptr () -> m ()
forall (m :: * -> *). MonadIO m => TreeIter -> Ptr () -> m ()
setTreeIterUserData2 TreeIter
i Ptr ()
forall a. Ptr a
nullPtr
    TreeIter -> Ptr () -> m ()
forall (m :: * -> *). MonadIO m => TreeIter -> Ptr () -> m ()
setTreeIterUserData3 TreeIter
i Ptr ()
forall a. Ptr a
nullPtr
    TreeIter -> m TreeIter
forall (m :: * -> *) a. Monad m => a -> m a
return TreeIter
i

newtype SeqStore a = SeqStore (ManagedPtr (CustomStore (IORef (Seq a)) a))

mkSeqStore :: CustomStore (IORef (Seq a)) a -> SeqStore a
mkSeqStore :: CustomStore (IORef (Seq a)) a -> SeqStore a
mkSeqStore (CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
ptr) = ManagedPtr (CustomStore (IORef (Seq a)) a) -> SeqStore a
forall a. ManagedPtr (CustomStore (IORef (Seq a)) a) -> SeqStore a
SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
ptr

instance HasParentTypes (SeqStore a)
type instance ParentTypes (SeqStore a) = '[TreeModel]

instance TypedObject (SeqStore a) where
  glibType :: IO GType
glibType = TypedObject TreeModel => IO GType
forall a. TypedObject a => IO GType
glibType @TreeModel

instance GObject (SeqStore a)

instance IsTypedTreeModel SeqStore

-- | Create a new 'TreeModel' that contains a list of elements.
seqStoreNew :: (Applicative m, MonadIO m) => [a] -> m (SeqStore a)
seqStoreNew :: [a] -> m (SeqStore a)
seqStoreNew [a]
xs = [a]
-> Maybe (DragSourceIface SeqStore a)
-> Maybe (DragDestIface SeqStore a)
-> m (SeqStore a)
forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
[a]
-> Maybe (DragSourceIface SeqStore a)
-> Maybe (DragDestIface SeqStore a)
-> m (SeqStore a)
seqStoreNewDND [a]
xs (DragSourceIface SeqStore a -> Maybe (DragSourceIface SeqStore a)
forall a. a -> Maybe a
Just DragSourceIface SeqStore a
forall row. DragSourceIface SeqStore row
seqStoreDefaultDragSourceIface)
                                     (DragDestIface SeqStore a -> Maybe (DragDestIface SeqStore a)
forall a. a -> Maybe a
Just DragDestIface SeqStore a
forall row. DragDestIface SeqStore row
seqStoreDefaultDragDestIface)

-- | Create a new 'TreeModel' that contains a list of elements. In addition, specify two
--   interfaces for drag and drop.
--
seqStoreNewDND :: (Applicative m, MonadIO m)
  => [a] -- ^ the initial content of the model
  -> Maybe (DragSourceIface SeqStore a) -- ^ an optional interface for drags
  -> Maybe (DragDestIface SeqStore a) -- ^ an optional interface to handle drops
  -> m (SeqStore a) -- ^ the new model
seqStoreNewDND :: [a]
-> Maybe (DragSourceIface SeqStore a)
-> Maybe (DragDestIface SeqStore a)
-> m (SeqStore a)
seqStoreNewDND [a]
xs Maybe (DragSourceIface SeqStore a)
mDSource Maybe (DragDestIface SeqStore a)
mDDest = do
  IORef (Seq a)
rows <- IO (IORef (Seq a)) -> m (IORef (Seq a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Seq a)) -> m (IORef (Seq a)))
-> IO (IORef (Seq a)) -> m (IORef (Seq a))
forall a b. (a -> b) -> a -> b
$ 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 -> SeqStore a)
-> TreeModelIface a
-> Maybe (DragSourceIface SeqStore a)
-> Maybe (DragDestIface SeqStore a)
-> m (SeqStore a)
forall (m :: * -> *) (model :: * -> *) row private.
(MonadIO m, IsTreeModel (model row), IsTypedTreeModel model) =>
private
-> (CustomStore private row -> model row)
-> TreeModelIface row
-> Maybe (DragSourceIface model row)
-> Maybe (DragDestIface model row)
-> m (model row)
customStoreNew IORef (Seq a)
rows CustomStore (IORef (Seq a)) a -> SeqStore a
forall a. CustomStore (IORef (Seq a)) a -> SeqStore a
mkSeqStore 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
TreeModelFlagsListOnly],
      treeModelIfaceGetIter :: TreePath -> IO (Maybe TreeIter)
treeModelIfaceGetIter       = \TreePath
path -> TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path IO [Int32]
-> ([Int32] -> IO (Maybe TreeIter)) -> IO (Maybe TreeIter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Int32
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 ->
                                     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) (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n)
                                                 then TreeIter -> Maybe TreeIter
forall a. a -> Maybe a
Just (TreeIter -> Maybe TreeIter) -> IO TreeIter -> IO (Maybe TreeIter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> Int32 -> IO TreeIter
forall (m :: * -> *). MonadIO m => Int32 -> Int32 -> m TreeIter
seqStoreIterNew Int32
0 (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n)
                                                 else Maybe TreeIter -> IO (Maybe TreeIter)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
      treeModelIfaceGetPath :: TreeIter -> IO TreePath
treeModelIfaceGetPath       = \TreeIter
i -> do
                            Int32
n <- TreeIter -> IO Int32
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
TreeIter -> m Int32
seqStoreIterToIndex TreeIter
i
                            [Int32] -> IO TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n],
      treeModelIfaceGetRow :: TreeIter -> IO a
treeModelIfaceGetRow        = \TreeIter
i -> do
                            Int32
n <- TreeIter -> IO Int32
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
TreeIter -> m Int32
seqStoreIterToIndex TreeIter
i
                            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) (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
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` Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n)
                                   else String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SeqStore.getRow: iter does not refer to a valid entry",

      treeModelIfaceIterNext :: TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterNext      = \TreeIter
i -> do
                            Int32
n <- TreeIter -> IO Int32
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
TreeIter -> m Int32
seqStoreIterToIndex TreeIter
i
                            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) (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
nInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+Int32
1))
                                   then TreeIter -> Maybe TreeIter
forall a. a -> Maybe a
Just (TreeIter -> Maybe TreeIter) -> IO TreeIter -> IO (Maybe TreeIter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> Int32 -> IO TreeIter
forall (m :: * -> *). MonadIO m => Int32 -> Int32 -> m TreeIter
seqStoreIterNew Int32
0 (Int32
nInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+Int32
1)
                                   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) -> TreeIter -> Maybe TreeIter
forall a. a -> Maybe a
Just (TreeIter -> Maybe TreeIter) -> IO TreeIter -> IO (Maybe TreeIter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> Int32 -> IO TreeIter
forall (m :: * -> *). MonadIO m => Int32 -> Int32 -> m TreeIter
seqStoreIterNew Int32
0 Int32
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 -> TreeIter -> Maybe TreeIter
forall a. a -> Maybe a
Just (TreeIter -> Maybe TreeIter) -> IO TreeIter -> IO (Maybe TreeIter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> Int32 -> IO TreeIter
forall (m :: * -> *). MonadIO m => Int32 -> Int32 -> m TreeIter
seqStoreIterNew Int32
0 (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
                                               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 SeqStore a)
mDSource Maybe (DragDestIface SeqStore a)
mDDest


-- | Convert a 'TreeIterRaw' to an an index into the 'SeqStore'. Note that this
--   function merely extracts the second element of the 'TreeIterRaw'.
seqStoreIterToIndex :: (Applicative m, MonadIO m) => TreeIter -> m Int32
seqStoreIterToIndex :: TreeIter -> m Int32
seqStoreIterToIndex TreeIter
i = Ptr () -> Int32
forall a b. a -> b
unsafeCoerce (Ptr () -> Int32) -> m (Ptr ()) -> m Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeIter -> m (Ptr ())
forall (m :: * -> *). MonadIO m => TreeIter -> m (Ptr ())
getTreeIterUserData TreeIter
i

-- | Default drag functions for 'Data.GI.Gtk.ModelView.SeqStore'. 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.
seqStoreDefaultDragSourceIface :: DragSourceIface SeqStore row
seqStoreDefaultDragSourceIface :: DragSourceIface SeqStore row
seqStoreDefaultDragSourceIface = DragSourceIface :: forall (model :: * -> *) row.
(model row -> TreePath -> IO Bool)
-> (model row -> TreePath -> SelectionData -> IO Bool)
-> (model row -> TreePath -> IO Bool)
-> DragSourceIface model row
DragSourceIface {
    customDragSourceRowDraggable :: SeqStore row -> TreePath -> IO Bool
customDragSourceRowDraggable = \SeqStore row
_ TreePath
_-> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
    customDragSourceDragDataGet :: SeqStore row -> TreePath -> SelectionData -> IO Bool
customDragSourceDragDataGet = \SeqStore row
model TreePath
path SelectionData
sel -> SelectionData -> SeqStore row -> TreePath -> IO Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
SelectionData -> a -> TreePath -> m Bool
treeSetRowDragData SelectionData
sel SeqStore row
model TreePath
path,
    customDragSourceDragDataDelete :: SeqStore row -> TreePath -> IO Bool
customDragSourceDragDataDelete = \SeqStore row
model TreePath
path -> TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path IO [Int32] -> ([Int32] -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int32
dest:[Int32]
_) -> do
            IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SeqStore row -> Int32 -> IO ()
forall (m :: * -> *) a. MonadIO m => SeqStore a -> Int32 -> m ()
seqStoreRemove SeqStore row
model (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
dest)
            Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

  }

-- | Default drop functions for 'Data.GI.Gtk.ModelView.SeqStore'. 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.
seqStoreDefaultDragDestIface :: DragDestIface SeqStore row
seqStoreDefaultDragDestIface :: DragDestIface SeqStore row
seqStoreDefaultDragDestIface = DragDestIface :: forall (model :: * -> *) row.
(model row -> TreePath -> SelectionData -> IO Bool)
-> (model row -> TreePath -> SelectionData -> IO Bool)
-> DragDestIface model row
DragDestIface {
    customDragDestRowDropPossible :: SeqStore row -> TreePath -> SelectionData -> IO Bool
customDragDestRowDropPossible = \SeqStore row
model TreePath
path SelectionData
sel -> do
      [Int32]
dest <- TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
      (Bool, Maybe TreeModel, Maybe TreePath)
mModelPath <- SelectionData -> IO (Bool, Maybe TreeModel, Maybe TreePath)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SelectionData -> m (Bool, Maybe TreeModel, Maybe TreePath)
treeGetRowDragData SelectionData
sel
      case (Bool, Maybe TreeModel, Maybe TreePath)
mModelPath of
        (Bool
True, Just TreeModel
model', Maybe TreePath
source) -> do
            TreeModel
tm <- SeqStore row -> IO TreeModel
forall (m :: * -> *) o.
(MonadIO m, IsTreeModel o) =>
o -> m TreeModel
toTreeModel SeqStore row
model
            TreeModel -> (Ptr TreeModel -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TreeModel
tm ((Ptr TreeModel -> IO Bool) -> IO Bool)
-> (Ptr TreeModel -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr TreeModel
m ->
                TreeModel -> (Ptr TreeModel -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TreeModel
model' ((Ptr TreeModel -> IO Bool) -> IO Bool)
-> (Ptr TreeModel -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr TreeModel
m' -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr TreeModel
mPtr TreeModel -> Ptr TreeModel -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr TreeModel
m')
        (Bool, Maybe TreeModel, Maybe TreePath)
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
    customDragDestDragDataReceived :: SeqStore row -> TreePath -> SelectionData -> IO Bool
customDragDestDragDataReceived = \SeqStore row
model TreePath
path SelectionData
sel -> do
      (Int32
dest:[Int32]
_) <- TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
      (Bool, Maybe TreeModel, Maybe TreePath)
mModelPath <- SelectionData -> IO (Bool, Maybe TreeModel, Maybe TreePath)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SelectionData -> m (Bool, Maybe TreeModel, Maybe TreePath)
treeGetRowDragData SelectionData
sel
      case (Bool, Maybe TreeModel, Maybe TreePath)
mModelPath of
        (Bool
True, Just TreeModel
model', Just TreePath
path) -> do
          (Int32
source:[Int32]
_) <- TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
          TreeModel
tm <- SeqStore row -> IO TreeModel
forall (m :: * -> *) o.
(MonadIO m, IsTreeModel o) =>
o -> m TreeModel
toTreeModel SeqStore row
model
          TreeModel -> (Ptr TreeModel -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TreeModel
tm ((Ptr TreeModel -> IO Bool) -> IO Bool)
-> (Ptr TreeModel -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr TreeModel
m ->
            TreeModel -> (Ptr TreeModel -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TreeModel
model' ((Ptr TreeModel -> IO Bool) -> IO Bool)
-> (Ptr TreeModel -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr TreeModel
m' ->
              if Ptr TreeModel
mPtr TreeModel -> Ptr TreeModel -> Bool
forall a. Eq a => a -> a -> Bool
/=Ptr TreeModel
m' then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
              else do
                row
row <- SeqStore row -> Int32 -> IO row
forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
SeqStore a -> Int32 -> m a
seqStoreGetValue SeqStore row
model Int32
source
                SeqStore row -> Int32 -> row -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
SeqStore a -> Int32 -> a -> m ()
seqStoreInsert SeqStore row
model Int32
dest row
row
                Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        (Bool, Maybe TreeModel, Maybe TreePath)
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  }

-- | Extract the value at the given index.
--
seqStoreGetValue :: (Applicative m, MonadIO m) => SeqStore a -> Int32 -> m a
seqStoreGetValue :: SeqStore a -> Int32 -> m a
seqStoreGetValue (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) Int32
index =
  (Seq a -> Int -> a
forall a. Seq a -> Int -> a
`Seq.index` Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
index) (Seq a -> a) -> m (Seq a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Seq a) -> m (Seq a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model)))

-- | Extract the value at the given index.
--
seqStoreSafeGetValue :: MonadIO m => SeqStore a -> Int32 -> m (Maybe a)
seqStoreSafeGetValue :: SeqStore a -> Int32 -> m (Maybe a)
seqStoreSafeGetValue (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) Int32
index' = do
  let index :: Int
index = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
index'
  Seq a
seq <- IO (Seq a) -> m (Seq a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Seq a) -> m (Seq a)) -> IO (Seq a) -> m (Seq 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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model))
  Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (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.
--
seqStoreSetValue :: MonadIO m => SeqStore a -> Int32 -> a -> m ()
seqStoreSetValue :: SeqStore a -> Int32 -> a -> m ()
seqStoreSetValue (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) Int32
index a
value = do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model)) (Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
index) a
value)
  Int32
stamp <- CustomStore (IORef (Seq a)) a -> m Int32
forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m Int32
customStoreGetStamp (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model)
  TreePath
path <- [Int32] -> m TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int32
index]
  TreeIter
i <- Int32 -> Int32 -> m TreeIter
forall (m :: * -> *). MonadIO m => Int32 -> Int32 -> m TreeIter
seqStoreIterNew Int32
stamp (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
index)
  CustomStore (IORef (Seq a)) a -> TreePath -> TreeIter -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> TreeIter -> m ()
treeModelRowChanged (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) TreePath
path TreeIter
i

-- | Extract all data from the store.
--
seqStoreToList :: (Applicative m, MonadIO m) => SeqStore a -> m [a]
seqStoreToList :: SeqStore a -> m [a]
seqStoreToList (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) =
  Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq a -> [a]) -> m (Seq a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Seq a) -> m (Seq a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model)))

-- | Query the number of elements in the store.
seqStoreGetSize :: (Applicative m, MonadIO m) => SeqStore a -> m Int32
seqStoreGetSize :: SeqStore a -> m Int32
seqStoreGetSize (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) =
  Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Seq a -> Int) -> Seq a -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> Int
forall a. Seq a -> Int
Seq.length (Seq a -> Int32) -> m (Seq a) -> m Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Seq a) -> m (Seq a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (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.
seqStoreInsert :: MonadIO m => SeqStore a -> Int32 -> a -> m ()
seqStoreInsert :: SeqStore a -> Int32 -> a -> m ()
seqStoreInsert (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) Int32
index a
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
index Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let index' :: Int
index' | Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
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                           = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Int32 -> Int
forall a b. (a -> b) -> a -> b
$ Int32
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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (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)
    Int32
stamp <- CustomStore (IORef (Seq a)) a -> IO Int32
forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m Int32
customStoreGetStamp (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model)
    TreePath
p <- [Int32] -> IO TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index']
    TreeIter
i <- Int32 -> Int32 -> IO TreeIter
forall (m :: * -> *). MonadIO m => Int32 -> Int32 -> m TreeIter
seqStoreIterNew Int32
stamp (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index')
    CustomStore (IORef (Seq a)) a -> TreePath -> TreeIter -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> TreeIter -> m ()
treeModelRowInserted (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) TreePath
p TreeIter
i

  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

-- | Insert an element in front of the given element.
seqStoreInsertBefore :: (Applicative m, MonadIO m) => SeqStore a -> TreeIter -> a -> m ()
seqStoreInsertBefore :: SeqStore a -> TreeIter -> a -> m ()
seqStoreInsertBefore SeqStore a
store TreeIter
iter a
value = do
    Int32
n <- TreeIter -> m Int32
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
TreeIter -> m Int32
seqStoreIterToIndex TreeIter
iter
    SeqStore a -> Int32 -> a -> m ()
forall (m :: * -> *) a.
MonadIO m =>
SeqStore a -> Int32 -> a -> m ()
seqStoreInsert SeqStore a
store Int32
n a
value

-- | Insert an element after the given element.
seqStoreInsertAfter :: (Applicative m, MonadIO m) => SeqStore a -> TreeIter -> a -> m ()
seqStoreInsertAfter :: SeqStore a -> TreeIter -> a -> m ()
seqStoreInsertAfter SeqStore a
store TreeIter
iter a
value = do
    Int32
n <- TreeIter -> m Int32
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
TreeIter -> m Int32
seqStoreIterToIndex TreeIter
iter
    SeqStore a -> Int32 -> a -> m ()
forall (m :: * -> *) a.
MonadIO m =>
SeqStore a -> Int32 -> a -> m ()
seqStoreInsert SeqStore a
store (Int32
n Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1) a
value

-- | Prepend the element to the store.
seqStorePrepend :: (Applicative m, MonadIO m) => SeqStore a -> a -> m ()
seqStorePrepend :: SeqStore a -> a -> m ()
seqStorePrepend (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) a
value = do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (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)
  Int32
stamp <- CustomStore (IORef (Seq a)) a -> m Int32
forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m Int32
customStoreGetStamp (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model)
  TreePath
p <- [Int32] -> m TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int32
0]
  TreeIter
i <- Int32 -> Int32 -> m TreeIter
forall (m :: * -> *). MonadIO m => Int32 -> Int32 -> m TreeIter
seqStoreIterNew Int32
stamp Int32
0
  CustomStore (IORef (Seq a)) a -> TreePath -> TreeIter -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> TreeIter -> m ()
treeModelRowInserted (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) TreePath
p TreeIter
i

---- | Prepend a list to the store. Not implemented yet.
--seqStorePrependList :: MonadIO m => SeqStore a -> [a] -> m ()
--seqStorePrependList store list =
--  mapM_ (seqStoreInsert store 0) (reverse list)

-- | Append an element to the store. Returns the index of the inserted
-- element.
seqStoreAppend :: MonadIO m => SeqStore a -> a -> m Int32
seqStoreAppend :: SeqStore a -> a -> m Int32
seqStoreAppend (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) a
value = do
  Int
index <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ 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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (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))
  Int32
stamp <- CustomStore (IORef (Seq a)) a -> m Int32
forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m Int32
customStoreGetStamp (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model)
  TreePath
p <- [Int32] -> m TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index]
  TreeIter
i <- Int32 -> Int32 -> m TreeIter
forall (m :: * -> *). MonadIO m => Int32 -> Int32 -> m TreeIter
seqStoreIterNew Int32
stamp (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index)
  CustomStore (IORef (Seq a)) a -> TreePath -> TreeIter -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> TreeIter -> m ()
treeModelRowInserted (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) TreePath
p TreeIter
i
  Int32 -> m Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> m Int32) -> Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index

{-
seqStoreAppendList :: MonadIO m => SeqStore a -> [a] -> m ()
seqStoreAppendList (SeqStore 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] (TreeIterRaw stamp (fromIntegral index) 0 0)
-}

-- | Remove the element at the given index.
--
seqStoreRemove :: MonadIO m => SeqStore a -> Int32 -> m ()
seqStoreRemove :: SeqStore a -> Int32 -> m ()
seqStoreRemove (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) Int32
index' = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model)) (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
delete Int
index Seq a
seq)
    TreePath
p <- [Int32] -> IO TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index]
    CustomStore (IORef (Seq a)) a -> TreePath -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> m ()
treeModelRowDeleted (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) TreePath
p
  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
        index :: Int
index = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
index'

-- | Empty the store.
seqStoreClear :: MonadIO m => SeqStore a -> m ()
seqStoreClear :: SeqStore a -> m ()
seqStoreClear (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$

  -- 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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model)) Seq a
seq
        TreePath
p <- [Int32] -> IO TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n]
        CustomStore (IORef (Seq a)) a -> TreePath -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> m ()
treeModelRowDeleted (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) TreePath
p
        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 (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (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.
--seqStoreReorder :: MonadIO m => SeqStore a -> [Int] -> m ()
--seqStoreReorder store = undefined
--
---- | Swap two rows of the store. Not yet implemented.
--seqStoreSwap :: MonadIO m => SeqStore a -> Int -> Int -> m ()
--seqStoreSwap store = undefined
--
---- | Move the element at the first index in front of the element denoted by
---- the second index. Not yet implemented.
--seqStoreMoveBefore :: MonadIO m => SeqStore a -> Int -> Int -> m ()
--seqStoreMoveBefore store = undefined
--
---- | Move the element at the first index past the element denoted by the
---- second index. Not yet implemented.
--seqStoreMoveAfter :: MonadIO m => SeqStore a -> Int -> Int -> m ()
--seqStoreMoveAfter store = undefined