{-# LANGUAGE CPP #-}
module Graphics.UI.Gtk.ModelView.ListStore (
ListStore,
listStoreNew,
listStoreNewDND,
listStoreDefaultDragSourceIface,
listStoreDefaultDragDestIface,
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.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
listStoreNew :: [a] -> IO (ListStore a)
listStoreNew :: forall a. [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)
listStoreNewDND :: [a]
-> Maybe (DragSourceIface ListStore a)
-> Maybe (DragDestIface ListStore a)
-> IO (ListStore a)
listStoreNewDND :: forall a.
[a]
-> Maybe (DragSourceIface ListStore a)
-> Maybe (DragDestIface ListStore a)
-> IO (ListStore a)
listStoreNewDND [a]
xs Maybe (DragSourceIface ListStore a)
mDSource Maybe (DragDestIface ListStore a)
mDDest = do
IORef (Seq a)
rows <- 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 {
treeModelIfaceGetFlags :: IO [TreeModelFlags]
treeModelIfaceGetFlags = [TreeModelFlags] -> IO [TreeModelFlags]
forall a. a -> IO a
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 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 ->
Maybe TreeIter -> IO (Maybe TreeIter)
forall a. a -> IO a
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 a. a -> IO a
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 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) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
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` Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)
else String -> IO a
forall a. 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 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) (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 a. a -> IO a
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 a. a -> IO a
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 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) ->
Maybe TreeIter -> IO (Maybe TreeIter)
forall a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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 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 -> Int -> IO (Maybe TreeIter)
treeModelIfaceIterNthChild = \Maybe TreeIter
index Int
n -> case Maybe TreeIter
index of
Maybe TreeIter
Nothing -> Maybe TreeIter -> IO (Maybe TreeIter)
forall a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeIter
forall a. Maybe a
Nothing,
treeModelIfaceRefNode :: TreeIter -> IO ()
treeModelIfaceRefNode = \TreeIter
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
treeModelIfaceUnrefNode :: TreeIter -> IO ()
treeModelIfaceUnrefNode = \TreeIter
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
} Maybe (DragSourceIface ListStore a)
mDSource Maybe (DragDestIface ListStore a)
mDDest
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
listStoreDefaultDragSourceIface :: DragSourceIface ListStore row
listStoreDefaultDragSourceIface :: forall row. DragSourceIface ListStore row
listStoreDefaultDragSourceIface = DragSourceIface {
treeDragSourceRowDraggable :: ListStore row -> TreePath -> IO Bool
treeDragSourceRowDraggable = \ListStore row
_ TreePath
_-> Bool -> IO Bool
forall a. a -> IO a
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 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
$ ListStore row -> Int -> IO ()
forall a. ListStore a -> Int -> IO ()
listStoreRemove ListStore row
model Int
dest
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
}
listStoreDefaultDragDestIface :: DragDestIface ListStore row
listStoreDefaultDragDestIface :: forall row. DragDestIface ListStore row
listStoreDefaultDragDestIface = DragDestIface {
treeDragDestRowDropPossible :: ListStore row -> TreePath -> SelectionDataM Bool
treeDragDestRowDropPossible = \ListStore row
model TreePath
dest -> do
Maybe (TreeModel, TreePath)
mModelPath <- SelectionDataM (Maybe (TreeModel, TreePath))
treeGetRowDragData
case Maybe (TreeModel, TreePath)
mModelPath of
Maybe (TreeModel, TreePath)
Nothing -> Bool -> SelectionDataM Bool
forall a. a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just (TreeModel
model', TreePath
source) -> Bool -> SelectionDataM Bool
forall a. a -> ReaderT (Ptr ()) IO a
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 a. a -> ReaderT (Ptr ()) IO a
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 a. a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else IO Bool -> SelectionDataM Bool
forall a. IO a -> ReaderT (Ptr ()) IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
}
listStoreGetValue :: ListStore a -> Int -> IO a
listStoreGetValue :: forall a. 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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. 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)
listStoreSafeGetValue :: ListStore a -> Int -> IO (Maybe a)
listStoreSafeGetValue :: forall a. ListStore a -> Int -> IO (Maybe a)
listStoreSafeGetValue (ListStore CustomStore (IORef (Seq a)) a
model) Int
index = do
Seq a
seq <- 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 a. a -> IO 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
listStoreSetValue :: ListStore a -> Int -> a -> IO ()
listStoreSetValue :: forall a. ListStore a -> Int -> a -> IO ()
listStoreSetValue (ListStore CustomStore (IORef (Seq a)) a
model) Int
index a
value = do
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)
listStoreToList :: ListStore a -> IO [a]
listStoreToList :: forall a. 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 a. 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)
listStoreGetSize :: ListStore a -> IO Int
listStoreGetSize :: forall a. 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)
listStoreInsert :: ListStore a -> Int -> a -> IO ()
listStoreInsert :: forall a. ListStore a -> Int -> a -> IO ()
listStoreInsert (ListStore CustomStore (IORef (Seq a)) a
model) Int
index a
value = do
Seq a
seq <- 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 :: 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
listStorePrepend :: ListStore a -> a -> IO ()
listStorePrepend :: forall a. 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)
listStoreAppend :: ListStore a -> a -> IO Int
listStoreAppend :: forall a. ListStore a -> a -> IO Int
listStoreAppend (ListStore CustomStore (IORef (Seq a)) a
model) a
value = do
Int
index <- 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
index
listStoreRemove :: ListStore a -> Int -> IO ()
listStoreRemove :: forall a. ListStore a -> Int -> IO ()
listStoreRemove (ListStore CustomStore (IORef (Seq a)) a
model) Int
index = do
Seq a
seq <- 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 :: 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
listStoreClear :: ListStore a -> IO ()
listStoreClear :: forall a. ListStore a -> IO ()
listStoreClear (ListStore CustomStore (IORef (Seq a)) a
model) =
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 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)