{-# 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 :: forall (m :: * -> *). MonadIO m => Int32 -> Int32 -> m TreeIter
seqStoreIterNew Int32
s Int32
u1 = do
    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
forall (m :: * -> *).
MonadIO m =>
(ManagedPtr TreeIter -> TreeIter)
-> [AttrOp TreeIter 'AttrSet] -> m TreeIter
new ManagedPtr TreeIter -> TreeIter
TreeIter []
    setTreeIterStamp     i s
    setTreeIterUserData  i $ unsafeCoerce u1
    setTreeIterUserData2 i nullPtr
    setTreeIterUserData3 i nullPtr
    return i

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

mkSeqStore :: CustomStore (IORef (Seq a)) a -> SeqStore a
mkSeqStore :: forall a. 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 = 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 :: forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
[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 :: forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
[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
  rows <- IO (IORef (Seq a)) -> m (IORef (Seq a))
forall a. IO a -> m 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)

  customStoreNew rows mkSeqStore TreeModelIface {
      treeModelIfaceGetFlags      = return [TreeModelFlagsListOnly],
      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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
      treeModelIfaceGetPath       = \TreeIter
i -> do
                            n <- TreeIter -> IO Int32
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
TreeIter -> m Int32
seqStoreIterToIndex TreeIter
i
                            treePathNewFromIndices' [fromIntegral n],
      treeModelIfaceGetRow        = \TreeIter
i -> do
                            n <- TreeIter -> IO Int32
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
TreeIter -> m Int32
seqStoreIterToIndex TreeIter
i
                            readIORef rows >>= \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 a. 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 a. 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
i -> do
                            n <- TreeIter -> IO Int32
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
TreeIter -> m Int32
seqStoreIterToIndex TreeIter
i
                            readIORef rows >>= \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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
      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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
      treeModelIfaceIterHasChild  = \TreeIter
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
      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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0,
      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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
      treeModelIfaceIterParent    = \TreeIter
_ -> Maybe TreeIter -> IO (Maybe TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
      treeModelIfaceRefNode       = \TreeIter
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
      treeModelIfaceUnrefNode     = \TreeIter
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    } mDSource 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 :: forall (m :: * -> *).
(Applicative m, MonadIO m) =>
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 :: forall row. DragSourceIface SeqStore row
seqStoreDefaultDragSourceIface = DragSourceIface {
    customDragSourceRowDraggable :: SeqStore row -> TreePath -> IO Bool
customDragSourceRowDraggable = \SeqStore row
_ TreePath
_-> Bool -> IO Bool
forall a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int32
dest:[Int32]
_) -> do
            IO () -> IO ()
forall a. IO a -> IO a
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 a. a -> IO a
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 :: forall row. DragDestIface SeqStore row
seqStoreDefaultDragDestIface = DragDestIface {
    customDragDestRowDropPossible :: SeqStore row -> TreePath -> SelectionData -> IO Bool
customDragDestRowDropPossible = \SeqStore row
model TreePath
path SelectionData
sel -> do
      dest <- TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
      mModelPath <- treeGetRowDragData sel
      case mModelPath of
        (Bool
True, Just TreeModel
model', Maybe TreePath
source) -> do
            tm <- SeqStore row -> IO TreeModel
forall (m :: * -> *) o.
(MonadIO m, IsTreeModel o) =>
o -> m TreeModel
toTreeModel SeqStore row
model
            withManagedPtr tm $ \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 a. a -> IO a
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 a. a -> IO a
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
      (dest:_) <- TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
      mModelPath <- treeGetRowDragData sel
      case mModelPath of
        (Bool
True, Just TreeModel
model', Just TreePath
path) -> do
          (source:_) <- TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
          tm <- toTreeModel model
          withManagedPtr tm $ \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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
              else do
                row <- SeqStore row -> Int32 -> IO row
forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
SeqStore a -> Int32 -> m a
seqStoreGetValue SeqStore row
model Int32
source
                seqStoreInsert model dest row
                return True
        (Bool, Maybe TreeModel, Maybe TreePath)
_ -> Bool -> IO Bool
forall a. a -> IO a
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 :: forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
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 a. IO a -> m 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 :: forall (m :: * -> *) a.
MonadIO m =>
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 <- IO (Seq a) -> m (Seq a)
forall a. IO a -> m 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))
  return $ if index >=0 && index < Seq.length seq
                then Just $ seq `Seq.index` index
                else Nothing

-- | Update the value at the given index. The index must exist.
--
seqStoreSetValue :: MonadIO m => SeqStore a -> Int32 -> a -> m ()
seqStoreSetValue :: forall (m :: * -> *) a.
MonadIO m =>
SeqStore a -> Int32 -> a -> m ()
seqStoreSetValue (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) Int32
index a
value = do
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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)
  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)
  path <- treePathNewFromIndices' [index]
  i <- seqStoreIterNew stamp (fromIntegral index)
  treeModelRowChanged (CustomStore model) path i

-- | Extract all data from the store.
--
seqStoreToList :: (Applicative m, MonadIO m) => SeqStore a -> m [a]
seqStoreToList :: forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
SeqStore a -> m [a]
seqStoreToList (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) =
  Seq a -> [a]
forall a. 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 a. IO a -> m 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 :: forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
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 a. IO a -> m 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 :: forall (m :: * -> *) a.
MonadIO m =>
SeqStore a -> Int32 -> a -> m ()
seqStoreInsert (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) Int32
index a
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  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))
  when (index >= 0) $ do
    let 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
    writeIORef (customStoreGetPrivate (CustomStore model)) (insert index' value seq)
    stamp <- customStoreGetStamp (CustomStore model)
    p <- treePathNewFromIndices' [fromIntegral index']
    i <- seqStoreIterNew stamp (fromIntegral index')
    treeModelRowInserted (CustomStore model) p i

  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 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 :: forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
SeqStore a -> TreeIter -> a -> m ()
seqStoreInsertBefore SeqStore a
store TreeIter
iter a
value = do
    n <- TreeIter -> m Int32
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
TreeIter -> m Int32
seqStoreIterToIndex TreeIter
iter
    seqStoreInsert store n value

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

-- | Prepend the element to the store.
seqStorePrepend :: (Applicative m, MonadIO m) => SeqStore a -> a -> m ()
seqStorePrepend :: forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
SeqStore a -> a -> m ()
seqStorePrepend (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) a
value = do
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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)
  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)
  p <- treePathNewFromIndices' [0]
  i <- seqStoreIterNew stamp 0
  treeModelRowInserted (CustomStore model) p 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 :: forall (m :: * -> *) a. MonadIO m => SeqStore a -> a -> m Int32
seqStoreAppend (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) a
value = do
  index <- IO Int -> m Int
forall a. IO a -> m a
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))
  stamp <- customStoreGetStamp (CustomStore model)
  p <- treePathNewFromIndices' [fromIntegral index]
  i <- seqStoreIterNew stamp (fromIntegral index)
  treeModelRowInserted (CustomStore model) p i
  return $ fromIntegral 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 :: forall (m :: * -> *) a. MonadIO m => SeqStore a -> Int32 -> m ()
seqStoreRemove (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) Int32
index' = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  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))
  when (index >=0 && index < Seq.length seq) $ do
    writeIORef (customStoreGetPrivate (CustomStore model)) (delete index seq)
    p <- treePathNewFromIndices' [fromIntegral index]
    treeModelRowDeleted (CustomStore model) p
  where delete :: Int -> Seq a -> Seq a
        delete :: forall a. 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 :: forall (m :: * -> *) a. MonadIO m => SeqStore a -> m ()
seqStoreClear (SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
model) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$

  -- 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 a. a -> IO a
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
        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]
        treeModelRowDeleted (CustomStore model) p
        loop (n-1) (Seq.viewr seq)

   in do 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))
         loop (Seq.length seq - 1) (Seq.viewr 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