{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Data.GI.Gtk.ModelView.ForestStore (
ForestStore(..),
forestStoreNew,
forestStoreNewDND,
forestStoreDefaultDragSourceIface,
forestStoreDefaultDragDestIface,
forestStoreGetValue,
forestStoreGetTree,
forestStoreGetForest,
forestStoreLookup,
forestStoreSetValue,
forestStoreInsert,
forestStoreInsertTree,
forestStoreInsertForest,
forestStoreRemove,
forestStoreClear,
forestStoreChange,
forestStoreChangeM,
) where
import Prelude ()
import Prelude.Compat
import Data.Bits
import Data.Word (Word32)
import Data.Int (Int32)
import Data.Maybe ( fromMaybe, isJust )
import Data.Tree
import Control.Monad ((>=>), when)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Exception (assert)
import Data.IORef
import Foreign.ForeignPtr (ForeignPtr)
import Data.GI.Base.BasicTypes
(ManagedPtr(..), GObject(..), GObject)
import Data.GI.Base.ManagedPtr (withManagedPtr)
import Data.GI.Base.Overloading (HasParentTypes, ParentTypes)
import Data.GI.Gtk.ModelView.Types
import Data.GI.Gtk.ModelView.CustomStore
(customStoreGetStamp, customStoreGetPrivate,
TreeModelIface(..), customStoreNew, DragDestIface(..),
DragSourceIface(..), CustomStore(..), customStoreInvalidateIters)
import GI.GObject.Objects.Object (Object(..))
import GI.Gtk.Interfaces.TreeModel
(treeModelRowDeleted, treeModelRowInserted,
treeModelRowChanged, toTreeModel, TreeModel(..), IsTreeModel(..),
treeModelRowHasChildToggled)
import GI.Gtk.Functions (treeSetRowDragData, treeGetRowDragData)
import GI.Gtk.Structs.TreePath
(TreePath)
import GI.Gtk.Structs.TreeIter
(getTreeIterUserData3, getTreeIterUserData2, getTreeIterUserData,
getTreeIterStamp, setTreeIterUserData3, setTreeIterUserData2,
setTreeIterUserData, setTreeIterStamp, TreeIter(..))
import Data.GI.Base (get, new)
import Unsafe.Coerce (unsafeCoerce)
data ForestStoreIter = ForestStoreIter Int32 Word32 Word32 Word32
fromForestStoreIter :: MonadIO m => ForestStoreIter -> m TreeIter
fromForestStoreIter :: ForestStoreIter -> m TreeIter
fromForestStoreIter (ForestStoreIter s :: Int32
s u1 :: Word32
u1 u2 :: Word32
u2 u3 :: Word32
u3) = 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
$ Word32 -> Ptr ()
forall a b. a -> b
unsafeCoerce Word32
u1
TreeIter -> Ptr () -> m ()
forall (m :: * -> *). MonadIO m => TreeIter -> Ptr () -> m ()
setTreeIterUserData2 TreeIter
i (Ptr () -> m ()) -> Ptr () -> m ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Ptr ()
forall a b. a -> b
unsafeCoerce Word32
u2
TreeIter -> Ptr () -> m ()
forall (m :: * -> *). MonadIO m => TreeIter -> Ptr () -> m ()
setTreeIterUserData3 TreeIter
i (Ptr () -> m ()) -> Ptr () -> m ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Ptr ()
forall a b. a -> b
unsafeCoerce Word32
u3
TreeIter -> m TreeIter
forall (m :: * -> *) a. Monad m => a -> m a
return TreeIter
i
toForestStoreIter :: MonadIO m => TreeIter -> m ForestStoreIter
toForestStoreIter :: TreeIter -> m ForestStoreIter
toForestStoreIter iter :: TreeIter
iter = do
Int32
stamp <- TreeIter -> m Int32
forall (m :: * -> *). MonadIO m => TreeIter -> m Int32
getTreeIterStamp TreeIter
iter
Ptr ()
u1 <- TreeIter -> m (Ptr ())
forall (m :: * -> *). MonadIO m => TreeIter -> m (Ptr ())
getTreeIterUserData TreeIter
iter
Ptr ()
u2 <- TreeIter -> m (Ptr ())
forall (m :: * -> *). MonadIO m => TreeIter -> m (Ptr ())
getTreeIterUserData2 TreeIter
iter
Ptr ()
u3 <- TreeIter -> m (Ptr ())
forall (m :: * -> *). MonadIO m => TreeIter -> m (Ptr ())
getTreeIterUserData3 TreeIter
iter
ForestStoreIter -> m ForestStoreIter
forall (m :: * -> *) a. Monad m => a -> m a
return (ForestStoreIter -> m ForestStoreIter)
-> ForestStoreIter -> m ForestStoreIter
forall a b. (a -> b) -> a -> b
$ Int32 -> Word32 -> Word32 -> Word32 -> ForestStoreIter
ForestStoreIter Int32
stamp (Ptr () -> Word32
forall a b. a -> b
unsafeCoerce Ptr ()
u1) (Ptr () -> Word32
forall a b. a -> b
unsafeCoerce Ptr ()
u2) (Ptr () -> Word32
forall a b. a -> b
unsafeCoerce Ptr ()
u3)
forestStoreIterSetStamp :: ForestStoreIter -> Int32 -> ForestStoreIter
forestStoreIterSetStamp :: ForestStoreIter -> Int32 -> ForestStoreIter
forestStoreIterSetStamp (ForestStoreIter _ a :: Word32
a b :: Word32
b c :: Word32
c) s :: Int32
s = Int32 -> Word32 -> Word32 -> Word32 -> ForestStoreIter
ForestStoreIter Int32
s Word32
a Word32
b Word32
c
newtype ForestStore a = ForestStore (ManagedPtr (CustomStore (IORef (Store a)) a))
mkForestStore :: CustomStore (IORef (Store a)) a -> ForestStore a
mkForestStore :: CustomStore (IORef (Store a)) a -> ForestStore a
mkForestStore (CustomStore ptr :: ManagedPtr (CustomStore (IORef (Store a)) a)
ptr) = ManagedPtr (CustomStore (IORef (Store a)) a) -> ForestStore a
forall a.
ManagedPtr (CustomStore (IORef (Store a)) a) -> ForestStore a
ForestStore ManagedPtr (CustomStore (IORef (Store a)) a)
ptr
instance HasParentTypes (ForestStore a)
type instance ParentTypes (ForestStore a) = '[TreeModel]
instance GObject (ForestStore a) where
#if !MIN_VERSION_haskell_gi_base(0,20,1)
gobjectIsInitiallyUnowned _ = False
#endif
gobjectType :: IO GType
gobjectType = GObject TreeModel => IO GType
forall a. GObject a => IO GType
gobjectType @TreeModel
instance IsTypedTreeModel ForestStore
type Depth = [Int]
data Store a = Store {
Store a -> Depth
depth :: Depth,
Store a -> Cache a
content :: Cache a
}
forestStoreNew :: MonadIO m => Forest a -> m (ForestStore a)
forestStoreNew :: Forest a -> m (ForestStore a)
forestStoreNew forest :: Forest a
forest = Forest a
-> Maybe (DragSourceIface ForestStore a)
-> Maybe (DragDestIface ForestStore a)
-> m (ForestStore a)
forall (m :: * -> *) a.
MonadIO m =>
Forest a
-> Maybe (DragSourceIface ForestStore a)
-> Maybe (DragDestIface ForestStore a)
-> m (ForestStore a)
forestStoreNewDND Forest a
forest
(DragSourceIface ForestStore a
-> Maybe (DragSourceIface ForestStore a)
forall a. a -> Maybe a
Just DragSourceIface ForestStore a
forall row. DragSourceIface ForestStore row
forestStoreDefaultDragSourceIface)
(DragDestIface ForestStore a -> Maybe (DragDestIface ForestStore a)
forall a. a -> Maybe a
Just DragDestIface ForestStore a
forall row. DragDestIface ForestStore row
forestStoreDefaultDragDestIface)
forestStoreNewDND :: MonadIO m => Forest a
-> Maybe (DragSourceIface ForestStore a)
-> Maybe (DragDestIface ForestStore a)
-> m (ForestStore a)
forestStoreNewDND :: Forest a
-> Maybe (DragSourceIface ForestStore a)
-> Maybe (DragDestIface ForestStore a)
-> m (ForestStore a)
forestStoreNewDND forest :: Forest a
forest mDSource :: Maybe (DragSourceIface ForestStore a)
mDSource mDDest :: Maybe (DragDestIface ForestStore a)
mDDest = IO (ForestStore a) -> m (ForestStore a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ForestStore a) -> m (ForestStore a))
-> IO (ForestStore a) -> m (ForestStore a)
forall a b. (a -> b) -> a -> b
$ do
(IORef (Store a)
storeRef :: IORef (Store a)) <- Store a -> IO (IORef (Store a))
forall a. a -> IO (IORef a)
newIORef Store :: forall a. Depth -> Cache a -> Store a
Store {
depth :: Depth
depth = Forest a -> Depth
forall a. Forest a -> Depth
calcForestDepth Forest a
forest,
content :: Cache a
content = Forest a -> Cache a
forall a. Forest a -> Cache a
storeToCache Forest a
forest
}
let withStore :: (Store a -> IO result) -> IO result
withStore :: (Store a -> IO result) -> IO result
withStore f :: Store a -> IO result
f = IORef (Store a) -> IO (Store a)
forall a. IORef a -> IO a
readIORef IORef (Store a)
storeRef IO (Store a) -> (Store a -> IO result) -> IO result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Store a -> IO result
f
withStoreUpdateCache :: (Store a -> (result, Cache a)) -> IO result
withStoreUpdateCache :: (Store a -> (result, Cache a)) -> IO result
withStoreUpdateCache f :: Store a -> (result, Cache a)
f = do
Store a
store <- IORef (Store a) -> IO (Store a)
forall a. IORef a -> IO a
readIORef IORef (Store a)
storeRef
let (result :: result
result, cache' :: Cache a
cache') = Store a -> (result, Cache a)
f Store a
store
IORef (Store a) -> Store a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Store a)
storeRef Store a
store { content :: Cache a
content = Cache a
cache' }
result -> IO result
forall (m :: * -> *) a. Monad m => a -> m a
return result
result
IORef (Store a)
-> (CustomStore (IORef (Store a)) a -> ForestStore a)
-> TreeModelIface a
-> Maybe (DragSourceIface ForestStore a)
-> Maybe (DragDestIface ForestStore a)
-> IO (ForestStore 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 (Store a)
storeRef CustomStore (IORef (Store a)) a -> ForestStore a
forall a. CustomStore (IORef (Store a)) a -> ForestStore a
mkForestStore 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 [],
treeModelIfaceGetIter :: TreePath -> IO (Maybe TreeIter)
treeModelIfaceGetIter = \path :: TreePath
path -> (Store a -> IO (Maybe TreeIter)) -> IO (Maybe TreeIter)
forall result. (Store a -> IO result) -> IO result
withStore ((Store a -> IO (Maybe TreeIter)) -> IO (Maybe TreeIter))
-> (Store a -> IO (Maybe TreeIter)) -> IO (Maybe TreeIter)
forall a b. (a -> b) -> a -> b
$
\Store { depth :: forall a. Store a -> Depth
depth = Depth
d } -> Depth -> [Int32] -> Maybe ForestStoreIter
fromPath Depth
d ([Int32] -> Maybe ForestStoreIter)
-> IO [Int32] -> IO (Maybe ForestStoreIter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path IO (Maybe ForestStoreIter)
-> (Maybe ForestStoreIter -> IO (Maybe TreeIter))
-> IO (Maybe TreeIter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ForestStoreIter -> IO TreeIter)
-> Maybe ForestStoreIter -> IO (Maybe TreeIter)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ForestStoreIter -> IO TreeIter
forall (m :: * -> *). MonadIO m => ForestStoreIter -> m TreeIter
fromForestStoreIter,
treeModelIfaceGetPath :: TreeIter -> IO TreePath
treeModelIfaceGetPath = TreeIter -> IO ForestStoreIter
forall (m :: * -> *). MonadIO m => TreeIter -> m ForestStoreIter
toForestStoreIter (TreeIter -> IO ForestStoreIter)
-> (ForestStoreIter -> IO TreePath) -> TreeIter -> IO TreePath
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \iter :: ForestStoreIter
iter -> (Store a -> IO TreePath) -> IO TreePath
forall result. (Store a -> IO result) -> IO result
withStore ((Store a -> IO TreePath) -> IO TreePath)
-> (Store a -> IO TreePath) -> IO TreePath
forall a b. (a -> b) -> a -> b
$
\Store { depth :: forall a. Store a -> Depth
depth = Depth
d } -> [Int32] -> IO TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' ([Int32] -> IO TreePath) -> [Int32] -> IO TreePath
forall a b. (a -> b) -> a -> b
$ Depth -> ForestStoreIter -> [Int32]
toPath Depth
d ForestStoreIter
iter,
treeModelIfaceGetRow :: TreeIter -> IO a
treeModelIfaceGetRow = TreeIter -> IO ForestStoreIter
forall (m :: * -> *). MonadIO m => TreeIter -> m ForestStoreIter
toForestStoreIter (TreeIter -> IO ForestStoreIter)
-> (ForestStoreIter -> IO a) -> TreeIter -> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \iter :: ForestStoreIter
iter -> (Store a -> (a, Cache a)) -> IO a
forall result. (Store a -> (result, Cache a)) -> IO result
withStoreUpdateCache ((Store a -> (a, Cache a)) -> IO a)
-> (Store a -> (a, Cache a)) -> IO a
forall a b. (a -> b) -> a -> b
$
\Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } ->
case Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
forall a. Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
checkSuccess Depth
d ForestStoreIter
iter Cache a
cache of
(True, cache' :: Cache a
cache'@((_, (Node { rootLabel :: forall a. Tree a -> a
rootLabel = a
val }:_)):_)) ->
(a
val, Cache a
cache')
_ -> [Char] -> (a, Cache a)
forall a. HasCallStack => [Char] -> a
error "ForestStore.getRow: iter does not refer to a valid entry",
treeModelIfaceIterNext :: TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterNext = TreeIter -> IO ForestStoreIter
forall (m :: * -> *). MonadIO m => TreeIter -> m ForestStoreIter
toForestStoreIter (TreeIter -> IO ForestStoreIter)
-> (ForestStoreIter -> IO (Maybe TreeIter))
-> TreeIter
-> IO (Maybe TreeIter)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \iter :: ForestStoreIter
iter -> (Store a -> (Maybe ForestStoreIter, Cache a))
-> IO (Maybe ForestStoreIter)
forall result. (Store a -> (result, Cache a)) -> IO result
withStoreUpdateCache (
\Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } -> Depth
-> ForestStoreIter -> Cache a -> (Maybe ForestStoreIter, Cache a)
forall a.
Depth
-> ForestStoreIter -> Cache a -> (Maybe ForestStoreIter, Cache a)
iterNext Depth
d ForestStoreIter
iter Cache a
cache) IO (Maybe ForestStoreIter)
-> (Maybe ForestStoreIter -> IO (Maybe TreeIter))
-> IO (Maybe TreeIter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ForestStoreIter -> IO TreeIter)
-> Maybe ForestStoreIter -> IO (Maybe TreeIter)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ForestStoreIter -> IO TreeIter
forall (m :: * -> *). MonadIO m => ForestStoreIter -> m TreeIter
fromForestStoreIter,
treeModelIfaceIterChildren :: Maybe TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterChildren = \mIter :: Maybe TreeIter
mIter -> do
ForestStoreIter
iter <- IO ForestStoreIter
-> (TreeIter -> IO ForestStoreIter)
-> Maybe TreeIter
-> IO ForestStoreIter
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForestStoreIter -> IO ForestStoreIter
forall (m :: * -> *) a. Monad m => a -> m a
return ForestStoreIter
invalidIter) TreeIter -> IO ForestStoreIter
forall (m :: * -> *). MonadIO m => TreeIter -> m ForestStoreIter
toForestStoreIter Maybe TreeIter
mIter
(Store a -> (Maybe ForestStoreIter, Cache a))
-> IO (Maybe ForestStoreIter)
forall result. (Store a -> (result, Cache a)) -> IO result
withStoreUpdateCache (
\Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } ->
Depth
-> Int
-> ForestStoreIter
-> Cache a
-> (Maybe ForestStoreIter, Cache a)
forall a.
Depth
-> Int
-> ForestStoreIter
-> Cache a
-> (Maybe ForestStoreIter, Cache a)
iterNthChild Depth
d 0 ForestStoreIter
iter Cache a
cache) IO (Maybe ForestStoreIter)
-> (Maybe ForestStoreIter -> IO (Maybe TreeIter))
-> IO (Maybe TreeIter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ForestStoreIter -> IO TreeIter)
-> Maybe ForestStoreIter -> IO (Maybe TreeIter)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ForestStoreIter -> IO TreeIter
forall (m :: * -> *). MonadIO m => ForestStoreIter -> m TreeIter
fromForestStoreIter,
treeModelIfaceIterHasChild :: TreeIter -> IO Bool
treeModelIfaceIterHasChild = TreeIter -> IO ForestStoreIter
forall (m :: * -> *). MonadIO m => TreeIter -> m ForestStoreIter
toForestStoreIter (TreeIter -> IO ForestStoreIter)
-> (ForestStoreIter -> IO Bool) -> TreeIter -> IO Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \iter :: ForestStoreIter
iter -> (Store a -> (Bool, Cache a)) -> IO Bool
forall result. (Store a -> (result, Cache a)) -> IO result
withStoreUpdateCache ((Store a -> (Bool, Cache a)) -> IO Bool)
-> (Store a -> (Bool, Cache a)) -> IO Bool
forall a b. (a -> b) -> a -> b
$
\Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } ->
let (mIter :: Maybe ForestStoreIter
mIter, cache' :: Cache a
cache') = Depth
-> Int
-> ForestStoreIter
-> Cache a
-> (Maybe ForestStoreIter, Cache a)
forall a.
Depth
-> Int
-> ForestStoreIter
-> Cache a
-> (Maybe ForestStoreIter, Cache a)
iterNthChild Depth
d 0 ForestStoreIter
iter Cache a
cache
in (Maybe ForestStoreIter -> Bool
forall a. Maybe a -> Bool
isJust Maybe ForestStoreIter
mIter, Cache a
cache'),
treeModelIfaceIterNChildren :: Maybe TreeIter -> IO Int
treeModelIfaceIterNChildren = (TreeIter -> IO ForestStoreIter)
-> Maybe TreeIter -> IO (Maybe ForestStoreIter)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TreeIter -> IO ForestStoreIter
forall (m :: * -> *). MonadIO m => TreeIter -> m ForestStoreIter
toForestStoreIter (Maybe TreeIter -> IO (Maybe ForestStoreIter))
-> (Maybe ForestStoreIter -> IO Int) -> Maybe TreeIter -> IO Int
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \mIter :: Maybe ForestStoreIter
mIter -> (Store a -> (Int, Cache a)) -> IO Int
forall result. (Store a -> (result, Cache a)) -> IO result
withStoreUpdateCache ((Store a -> (Int, Cache a)) -> IO Int)
-> (Store a -> (Int, Cache a)) -> IO Int
forall a b. (a -> b) -> a -> b
$
\Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } ->
let iter :: ForestStoreIter
iter = ForestStoreIter -> Maybe ForestStoreIter -> ForestStoreIter
forall a. a -> Maybe a -> a
fromMaybe ForestStoreIter
invalidIter Maybe ForestStoreIter
mIter
in Depth -> ForestStoreIter -> Cache a -> (Int, Cache a)
forall a. Depth -> ForestStoreIter -> Cache a -> (Int, Cache a)
iterNChildren Depth
d ForestStoreIter
iter Cache a
cache,
treeModelIfaceIterNthChild :: Maybe TreeIter -> Int -> IO (Maybe TreeIter)
treeModelIfaceIterNthChild = \mIter :: Maybe TreeIter
mIter idx :: Int
idx -> do
ForestStoreIter
iter <- IO ForestStoreIter
-> (TreeIter -> IO ForestStoreIter)
-> Maybe TreeIter
-> IO ForestStoreIter
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForestStoreIter -> IO ForestStoreIter
forall (m :: * -> *) a. Monad m => a -> m a
return ForestStoreIter
invalidIter) TreeIter -> IO ForestStoreIter
forall (m :: * -> *). MonadIO m => TreeIter -> m ForestStoreIter
toForestStoreIter Maybe TreeIter
mIter
(Store a -> (Maybe ForestStoreIter, Cache a))
-> IO (Maybe ForestStoreIter)
forall result. (Store a -> (result, Cache a)) -> IO result
withStoreUpdateCache (
\Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } ->
Depth
-> Int
-> ForestStoreIter
-> Cache a
-> (Maybe ForestStoreIter, Cache a)
forall a.
Depth
-> Int
-> ForestStoreIter
-> Cache a
-> (Maybe ForestStoreIter, Cache a)
iterNthChild Depth
d Int
idx ForestStoreIter
iter Cache a
cache) IO (Maybe ForestStoreIter)
-> (Maybe ForestStoreIter -> IO (Maybe TreeIter))
-> IO (Maybe TreeIter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ForestStoreIter -> IO TreeIter)
-> Maybe ForestStoreIter -> IO (Maybe TreeIter)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ForestStoreIter -> IO TreeIter
forall (m :: * -> *). MonadIO m => ForestStoreIter -> m TreeIter
fromForestStoreIter,
treeModelIfaceIterParent :: TreeIter -> IO (Maybe TreeIter)
treeModelIfaceIterParent = TreeIter -> IO ForestStoreIter
forall (m :: * -> *). MonadIO m => TreeIter -> m ForestStoreIter
toForestStoreIter (TreeIter -> IO ForestStoreIter)
-> (ForestStoreIter -> IO (Maybe TreeIter))
-> TreeIter
-> IO (Maybe TreeIter)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \iter :: ForestStoreIter
iter -> (Store a -> IO (Maybe TreeIter)) -> IO (Maybe TreeIter)
forall result. (Store a -> IO result) -> IO result
withStore ((Store a -> IO (Maybe TreeIter)) -> IO (Maybe TreeIter))
-> (Store a -> IO (Maybe TreeIter)) -> IO (Maybe TreeIter)
forall a b. (a -> b) -> a -> b
$
\Store { depth :: forall a. Store a -> Depth
depth = Depth
d } -> (ForestStoreIter -> IO TreeIter)
-> Maybe ForestStoreIter -> IO (Maybe TreeIter)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ForestStoreIter -> IO TreeIter
forall (m :: * -> *). MonadIO m => ForestStoreIter -> m TreeIter
fromForestStoreIter (Depth -> ForestStoreIter -> Maybe ForestStoreIter
iterParent Depth
d ForestStoreIter
iter),
treeModelIfaceRefNode :: TreeIter -> IO ()
treeModelIfaceRefNode = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
treeModelIfaceUnrefNode :: TreeIter -> IO ()
treeModelIfaceUnrefNode = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
} Maybe (DragSourceIface ForestStore a)
mDSource Maybe (DragDestIface ForestStore a)
mDDest
forestStoreDefaultDragSourceIface :: DragSourceIface ForestStore row
forestStoreDefaultDragSourceIface :: DragSourceIface ForestStore row
forestStoreDefaultDragSourceIface = 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 :: ForestStore row -> TreePath -> IO Bool
customDragSourceRowDraggable = \_ _-> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
customDragSourceDragDataGet :: ForestStore row -> TreePath -> SelectionData -> IO Bool
customDragSourceDragDataGet = \model :: ForestStore row
model path :: TreePath
path sel :: SelectionData
sel -> SelectionData -> ForestStore row -> TreePath -> IO Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
SelectionData -> a -> TreePath -> m Bool
treeSetRowDragData SelectionData
sel ForestStore row
model TreePath
path,
customDragSourceDragDataDelete :: ForestStore row -> TreePath -> IO Bool
customDragSourceDragDataDelete = \model :: ForestStore row
model path :: 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
>>= \dest :: [Int32]
dest@(_:_) -> do
IO Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ ForestStore row -> TreePath -> IO Bool
forall (m :: * -> *) a.
MonadIO m =>
ForestStore a -> TreePath -> m Bool
forestStoreRemove ForestStore row
model TreePath
path
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
}
forestStoreDefaultDragDestIface :: DragDestIface ForestStore row
forestStoreDefaultDragDestIface :: DragDestIface ForestStore row
forestStoreDefaultDragDestIface = DragDestIface :: forall (model :: * -> *) row.
(model row -> TreePath -> SelectionData -> IO Bool)
-> (model row -> TreePath -> SelectionData -> IO Bool)
-> DragDestIface model row
DragDestIface {
customDragDestRowDropPossible :: ForestStore row -> TreePath -> SelectionData -> IO Bool
customDragDestRowDropPossible = \model :: ForestStore row
model path :: TreePath
path sel :: SelectionData
sel -> do
(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
(True, Just model' :: TreeModel
model', source :: Maybe TreePath
source) -> do
TreeModel
tm <- ForestStore row -> IO TreeModel
forall (m :: * -> *) o.
(MonadIO m, IsTreeModel o) =>
o -> m TreeModel
toTreeModel ForestStore 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
$ \m :: 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
$ \m' :: 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 -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False,
customDragDestDragDataReceived :: ForestStore row -> TreePath -> SelectionData -> IO Bool
customDragDestDragDataReceived = \model :: ForestStore row
model path :: TreePath
path sel :: SelectionData
sel -> do
dest :: [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
(True, Just model' :: TreeModel
model', Just path :: TreePath
path) -> do
source :: [Int32]
source@(_:_) <- TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
TreeModel
tm <- ForestStore row -> IO TreeModel
forall (m :: * -> *) o.
(MonadIO m, IsTreeModel o) =>
o -> m TreeModel
toTreeModel ForestStore 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
$ \m :: 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
$ \m' :: 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
Tree row
row <- ForestStore row -> TreePath -> IO (Tree row)
forall (m :: * -> *) a.
MonadIO m =>
ForestStore a -> TreePath -> m (Tree a)
forestStoreGetTree ForestStore row
model (TreePath -> IO (Tree row)) -> IO TreePath -> IO (Tree row)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Int32] -> IO TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int32]
source
TreePath
initPath <- [Int32] -> IO TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' ([Int32] -> [Int32]
forall a. [a] -> [a]
init [Int32]
dest)
ForestStore row -> TreePath -> Int -> Tree row -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
ForestStore a -> TreePath -> Int -> Tree a -> m ()
forestStoreInsertTree ForestStore row
model TreePath
initPath (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Int32 -> Int
forall a b. (a -> b) -> a -> b
$ [Int32] -> Int32
forall a. [a] -> a
last [Int32]
dest) Tree row
row
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
}
bitsNeeded :: Word32 -> Int
bitsNeeded :: Word32 -> Int
bitsNeeded n :: Word32
n = Int -> Word32 -> Int
forall t t. (Num t, Num t, Bits t) => t -> t -> t
bitsNeeded' 0 Word32
n
where bitsNeeded' :: t -> t -> t
bitsNeeded' b :: t
b 0 = t
b
bitsNeeded' b :: t
b n :: t
n = t -> t -> t
bitsNeeded' (t
bt -> t -> t
forall a. Num a => a -> a -> a
+1) (t
n t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` 1)
getBitSlice :: ForestStoreIter -> Int -> Int -> Word32
getBitSlice :: ForestStoreIter -> Int -> Int -> Word32
getBitSlice (ForestStoreIter _ a :: Word32
a b :: Word32
b c :: Word32
c) off :: Int
off count :: Int
count =
Word32 -> Int -> Int -> Word32
getBitSliceWord Word32
a Int
off Int
count
Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Int -> Word32
getBitSliceWord Word32
b (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-32) Int
count
Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Int -> Word32
getBitSliceWord Word32
c (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-64) Int
count
where getBitSliceWord :: Word32 -> Int -> Int -> Word32
getBitSliceWord :: Word32 -> Int -> Int -> Word32
getBitSliceWord word :: Word32
word off :: Int
off count :: Int
count =
Word32
word Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shift` (-Int
off) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
count Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- 1)
setBitSlice :: ForestStoreIter -> Int -> Int -> Word32 -> ForestStoreIter
setBitSlice :: ForestStoreIter -> Int -> Int -> Word32 -> ForestStoreIter
setBitSlice (ForestStoreIter stamp :: Int32
stamp a :: Word32
a b :: Word32
b c :: Word32
c) off :: Int
off count :: Int
count value :: Word32
value =
Bool -> ForestStoreIter -> ForestStoreIter
forall a. HasCallStack => Bool -> a -> a
assert (Word32
value Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< 1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
count) (ForestStoreIter -> ForestStoreIter)
-> ForestStoreIter -> ForestStoreIter
forall a b. (a -> b) -> a -> b
$
Int32 -> Word32 -> Word32 -> Word32 -> ForestStoreIter
ForestStoreIter Int32
stamp
(Word32 -> Int -> Int -> Word32 -> Word32
setBitSliceWord Word32
a Int
off Int
count Word32
value)
(Word32 -> Int -> Int -> Word32 -> Word32
setBitSliceWord Word32
b (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-32) Int
count Word32
value)
(Word32 -> Int -> Int -> Word32 -> Word32
setBitSliceWord Word32
c (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-64) Int
count Word32
value)
where setBitSliceWord :: Word32 -> Int -> Int -> Word32 -> Word32
setBitSliceWord :: Word32 -> Int -> Int -> Word32 -> Word32
setBitSliceWord word :: Word32
word off :: Int
off count :: Int
count value :: Word32
value =
let mask :: Word32
mask = (1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
count Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- 1) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shift` Int
off
in (Word32
word Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
mask) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
value Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shift` Int
off)
invalidIter :: ForestStoreIter
invalidIter :: ForestStoreIter
invalidIter = Int32 -> Word32 -> Word32 -> Word32 -> ForestStoreIter
ForestStoreIter 0 0 0 0
calcForestDepth :: Forest a -> Depth
calcForestDepth :: Forest a -> Depth
calcForestDepth f :: Forest a
f = (Word32 -> Int) -> [Word32] -> Depth
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Int
bitsNeeded ([Word32] -> Depth) -> [Word32] -> Depth
forall a b. (a -> b) -> a -> b
$
(Word32 -> Bool) -> [Word32] -> [Word32]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/=0) ([Word32] -> [Word32]) -> [Word32] -> [Word32]
forall a b. (a -> b) -> a -> b
$
(Tree a -> [Word32] -> [Word32])
-> [Word32] -> Forest a -> [Word32]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree a -> [Word32] -> [Word32]
forall c a. (Num c, Ord c) => Tree a -> [c] -> [c]
calcTreeDepth (Word32 -> [Word32]
forall a. a -> [a]
repeat 0) Forest a
f
where
calcTreeDepth :: Tree a -> [c] -> [c]
calcTreeDepth Node { subForest :: forall a. Tree a -> Forest a
subForest = Forest a
f } (d :: c
d:ds :: [c]
ds) =
(c
dc -> c -> c
forall a. Num a => a -> a -> a
+1)c -> [c] -> [c]
forall a. a -> [a] -> [a]
: (c -> c -> c) -> [c] -> [c] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith c -> c -> c
forall a. Ord a => a -> a -> a
max [c]
ds ((Tree a -> [c] -> [c]) -> [c] -> Forest a -> [c]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree a -> [c] -> [c]
calcTreeDepth (c -> [c]
forall a. a -> [a]
repeat 0) Forest a
f)
toPath :: Depth -> ForestStoreIter -> [Int32]
toPath :: Depth -> ForestStoreIter -> [Int32]
toPath d :: Depth
d iter :: ForestStoreIter
iter = Int -> Depth -> [Int32]
gP 0 Depth
d
where
gP :: Int -> Depth -> [Int32]
gP pos :: Int
pos [] = []
gP pos :: Int
pos (d :: Int
d:ds :: Depth
ds) = let idx :: Word32
idx = ForestStoreIter -> Int -> Int -> Word32
getBitSlice ForestStoreIter
iter Int
pos Int
d in
if Word32
idxWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==0 then [] else Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
idxWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
-1) Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
: Int -> Depth -> [Int32]
gP (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) Depth
ds
fromPath :: Depth -> [Int32] -> Maybe ForestStoreIter
fromPath :: Depth -> [Int32] -> Maybe ForestStoreIter
fromPath = Int -> ForestStoreIter -> Depth -> [Int32] -> Maybe ForestStoreIter
forall a.
Integral a =>
Int -> ForestStoreIter -> Depth -> [a] -> Maybe ForestStoreIter
fP 0 ForestStoreIter
invalidIter
where
fP :: Int -> ForestStoreIter -> Depth -> [a] -> Maybe ForestStoreIter
fP pos :: Int
pos ti :: ForestStoreIter
ti _ [] = ForestStoreIter -> Maybe ForestStoreIter
forall a. a -> Maybe a
Just ForestStoreIter
ti
fP pos :: Int
pos ti :: ForestStoreIter
ti [] _ = Maybe ForestStoreIter
forall a. Maybe a
Nothing
fP pos :: Int
pos ti :: ForestStoreIter
ti (d :: Int
d:ds :: Depth
ds) (p :: a
p:ps :: [a]
ps) = let idx :: Word32
idx = a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
pa -> a -> a
forall a. Num a => a -> a -> a
+1) in
if Word32
idx Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Word32
forall a. Bits a => Int -> a
bit Int
d then Maybe ForestStoreIter
forall a. Maybe a
Nothing else
Int -> ForestStoreIter -> Depth -> [a] -> Maybe ForestStoreIter
fP (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (ForestStoreIter -> Int -> Int -> Word32 -> ForestStoreIter
setBitSlice ForestStoreIter
ti Int
pos Int
d Word32
idx) Depth
ds [a]
ps
type Cache a = [(ForestStoreIter, Forest a)]
storeToCache :: Forest a -> Cache a
storeToCache :: Forest a -> Cache a
storeToCache [] = []
storeToCache forest :: Forest a
forest = [(ForestStoreIter
invalidIter, [a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Node a
forall a. a
root Forest a
forest])]
where
root :: a
root = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "ForestStore.storeToCache: accessed non-exitent root of tree"
cacheToStore :: Cache a -> Forest a
cacheToStore :: Cache a -> Forest a
cacheToStore [] = []
cacheToStore cache :: Cache a
cache = case Cache a -> (ForestStoreIter, Forest a)
forall a. [a] -> a
last Cache a
cache of (_, [Node _ forest :: Forest a
forest]) -> Forest a
forest
advanceCache :: Depth -> ForestStoreIter -> Cache a -> Cache a
advanceCache :: Depth -> ForestStoreIter -> Cache a -> Cache a
advanceCache depth :: Depth
depth goal :: ForestStoreIter
goal [] = []
advanceCache depth :: Depth
depth goal :: ForestStoreIter
goal cache :: Cache a
cache@((rootIter :: ForestStoreIter
rootIter,_):_) =
Int -> Depth -> Cache a
moveToSameLevel 0 Depth
depth
where
moveToSameLevel :: Int -> Depth -> Cache a
moveToSameLevel pos :: Int
pos [] = Cache a
cache
moveToSameLevel pos :: Int
pos (d :: Int
d:ds :: Depth
ds) =
let
goalIdx :: Word32
goalIdx = ForestStoreIter -> Int -> Int -> Word32
getBitSlice ForestStoreIter
goal Int
pos Int
d
curIdx :: Word32
curIdx = ForestStoreIter -> Int -> Int -> Word32
getBitSlice ForestStoreIter
rootIter Int
pos Int
d
isNonZero :: Int -> Int -> (ForestStoreIter, b) -> Bool
isNonZero pos :: Int
pos d :: Int
d (ti :: ForestStoreIter
ti,_) = ForestStoreIter -> Int -> Int -> Word32
getBitSlice ForestStoreIter
ti Int
pos Int
dWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/=0
in
if Word32
goalIdxWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
curIdx then Int -> Depth -> Cache a
moveToSameLevel (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) Depth
ds else
if Word32
goalIdxWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==0 then ((ForestStoreIter, Forest a) -> Bool) -> Cache a -> Cache a
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> (ForestStoreIter, Forest a) -> Bool
forall b. Int -> Int -> (ForestStoreIter, b) -> Bool
isNonZero Int
pos Int
d) Cache a
cache else
if Word32
curIdxWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==0 then Int -> Depth -> Cache a -> Cache a
forall a. Int -> Depth -> Cache a -> Cache a
moveToChild Int
pos (Int
dInt -> Depth -> Depth
forall a. a -> [a] -> [a]
:Depth
ds) Cache a
cache else
if Word32
goalIdxWord32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<Word32
curIdx then
Int -> Depth -> Cache a -> Cache a
forall a. Int -> Depth -> Cache a -> Cache a
moveToChild Int
pos (Int
dInt -> Depth -> Depth
forall a. a -> [a] -> [a]
:Depth
ds) (((ForestStoreIter, Forest a) -> Bool) -> Cache a -> Cache a
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> (ForestStoreIter, Forest a) -> Bool
forall b. Int -> Int -> (ForestStoreIter, b) -> Bool
isNonZero Int
pos Int
d) Cache a
cache)
else let
moveWithinLevel :: Int -> Int -> Cache a -> Cache a
moveWithinLevel pos :: Int
pos d :: Int
d ((ti :: ForestStoreIter
ti,forest :: Forest a
forest):parents :: Cache a
parents) = let
diff :: Int
diff = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
goalIdxWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
-Word32
curIdx)
(dropped :: Forest a
dropped, remain :: Forest a
remain) = Int -> Forest a -> (Forest a, Forest a)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
diff Forest a
forest
advance :: Int
advance = Forest a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest a
dropped
ti' :: ForestStoreIter
ti' = ForestStoreIter -> Int -> Int -> Word32 -> ForestStoreIter
setBitSlice ForestStoreIter
ti Int
pos Int
d (Word32
curIdxWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
advance)
in
if Int
advanceInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
diff then Int -> Depth -> Cache a -> Cache a
forall a. Int -> Depth -> Cache a -> Cache a
moveToChild (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) Depth
ds ((ForestStoreIter
ti',Forest a
remain)(ForestStoreIter, Forest a) -> Cache a -> Cache a
forall a. a -> [a] -> [a]
:Cache a
parents)
else (ForestStoreIter
ti',Forest a
remain)(ForestStoreIter, Forest a) -> Cache a -> Cache a
forall a. a -> [a] -> [a]
:Cache a
parents
in Int -> Int -> Cache a -> Cache a
moveWithinLevel Int
pos Int
d (Cache a -> Cache a) -> Cache a -> Cache a
forall a b. (a -> b) -> a -> b
$ case Depth
ds of
[] -> Cache a
cache
(d' :: Int
d':_) -> ((ForestStoreIter, Forest a) -> Bool) -> Cache a -> Cache a
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> (ForestStoreIter, Forest a) -> Bool
forall b. Int -> Int -> (ForestStoreIter, b) -> Bool
isNonZero (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) Int
d') Cache a
cache
moveToChild :: Int -> Depth -> Cache a -> Cache a
moveToChild :: Int -> Depth -> Cache a -> Cache a
moveToChild pos :: Int
pos [] cache :: Cache a
cache = Cache a
cache
moveToChild pos :: Int
pos (d :: Int
d:ds :: Depth
ds) cache :: Cache a
cache@((ti :: ForestStoreIter
ti,forest :: Forest a
forest):parents :: Cache a
parents)
| ForestStoreIter -> Int -> Int -> Word32
getBitSlice ForestStoreIter
goal Int
pos Int
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Cache a
cache
| Bool
otherwise = case Forest a
forest of
[] -> Cache a
cache
Node { subForest :: forall a. Tree a -> Forest a
subForest = Forest a
children }:_ ->
let
childIdx :: Int
childIdx :: Int
childIdx = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ForestStoreIter -> Int -> Int -> Word32
getBitSlice ForestStoreIter
goal Int
pos Int
d)Int -> Int -> Int
forall a. Num a => a -> a -> a
-1
(dropped :: Forest a
dropped, remain :: Forest a
remain) = Int -> Forest a -> (Forest a, Forest a)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
childIdx Forest a
children
advanced :: Int
advanced = Forest a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest a
dropped
ti' :: ForestStoreIter
ti' = ForestStoreIter -> Int -> Int -> Word32 -> ForestStoreIter
setBitSlice ForestStoreIter
ti Int
pos Int
d (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
advancedWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+1)
in if Int
advancedInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
childIdx then ((ForestStoreIter
ti',Forest a
remain)(ForestStoreIter, Forest a) -> Cache a -> Cache a
forall a. a -> [a] -> [a]
:Cache a
cache) else
Int -> Depth -> Cache a -> Cache a
forall a. Int -> Depth -> Cache a -> Cache a
moveToChild (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) Depth
ds ((ForestStoreIter
ti',Forest a
remain)(ForestStoreIter, Forest a) -> Cache a -> Cache a
forall a. a -> [a] -> [a]
:Cache a
cache)
checkSuccess :: Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
checkSuccess :: Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
checkSuccess depth :: Depth
depth iter :: ForestStoreIter
iter cache :: Cache a
cache = case Depth -> ForestStoreIter -> Cache a -> Cache a
forall a. Depth -> ForestStoreIter -> Cache a -> Cache a
advanceCache Depth
depth ForestStoreIter
iter Cache a
cache of
cache' :: Cache a
cache'@((cur :: ForestStoreIter
cur,sibs :: Forest a
sibs):_) -> (ForestStoreIter -> ForestStoreIter -> Bool
cmp ForestStoreIter
cur ForestStoreIter
iter Bool -> Bool -> Bool
&& Bool -> Bool
not (Forest a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest a
sibs), Cache a
cache')
[] -> (Bool
False, [])
where
cmp :: ForestStoreIter -> ForestStoreIter -> Bool
cmp (ForestStoreIter _ a1 :: Word32
a1 b1 :: Word32
b1 c1 :: Word32
c1) (ForestStoreIter _ a2 :: Word32
a2 b2 :: Word32
b2 c2 :: Word32
c2) =
Word32
a1Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
a2 Bool -> Bool -> Bool
&& Word32
b1Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
b2 Bool -> Bool -> Bool
&& Word32
c2Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
c2
getTreeIterLeaf :: Depth -> ForestStoreIter -> (Int, Int, Int)
getTreeIterLeaf :: Depth -> ForestStoreIter -> (Int, Int, Int)
getTreeIterLeaf ds :: Depth
ds ti :: ForestStoreIter
ti = Int -> Int -> Depth -> (Int, Int, Int)
gTIL 0 0 Depth
ds
where
gTIL :: Int -> Int -> Depth -> (Int, Int, Int)
gTIL pos :: Int
pos dCur :: Int
dCur (dNext :: Int
dNext:ds :: Depth
ds)
| ForestStoreIter -> Int -> Int -> Word32
getBitSlice ForestStoreIter
ti (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dCur) Int
dNextWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==0 = (Int
pos,Int
dCur,Int
dNext)
| Bool
otherwise = Int -> Int -> Depth -> (Int, Int, Int)
gTIL (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dCur) Int
dNext Depth
ds
gTIL pos :: Int
pos d :: Int
d [] = (Int
pos, Int
d, 0)
iterNext :: Depth -> ForestStoreIter -> Cache a -> (Maybe ForestStoreIter, Cache a)
iterNext :: Depth
-> ForestStoreIter -> Cache a -> (Maybe ForestStoreIter, Cache a)
iterNext depth :: Depth
depth iter :: ForestStoreIter
iter cache :: Cache a
cache = let
(pos :: Int
pos,leaf :: Int
leaf,_child :: Int
_child) = Depth -> ForestStoreIter -> (Int, Int, Int)
getTreeIterLeaf Depth
depth ForestStoreIter
iter
curIdx :: Word32
curIdx = ForestStoreIter -> Int -> Int -> Word32
getBitSlice ForestStoreIter
iter Int
pos Int
leaf
nextIdx :: Word32
nextIdx = Word32
curIdxWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+1
nextIter :: ForestStoreIter
nextIter = ForestStoreIter -> Int -> Int -> Word32 -> ForestStoreIter
setBitSlice ForestStoreIter
iter Int
pos Int
leaf Word32
nextIdx
in
if Word32
nextIdxWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Int -> Word32
forall a. Bits a => Int -> a
bit Int
leaf then (Maybe ForestStoreIter
forall a. Maybe a
Nothing, Cache a
cache) else
case Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
forall a. Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
checkSuccess Depth
depth ForestStoreIter
nextIter Cache a
cache of
(True, cache :: Cache a
cache) -> (ForestStoreIter -> Maybe ForestStoreIter
forall a. a -> Maybe a
Just ForestStoreIter
nextIter, Cache a
cache)
(False, cache :: Cache a
cache) -> (Maybe ForestStoreIter
forall a. Maybe a
Nothing, Cache a
cache)
iterNthChild :: Depth -> Int -> ForestStoreIter -> Cache a ->
(Maybe ForestStoreIter, Cache a)
iterNthChild :: Depth
-> Int
-> ForestStoreIter
-> Cache a
-> (Maybe ForestStoreIter, Cache a)
iterNthChild depth :: Depth
depth childIdx_ :: Int
childIdx_ iter :: ForestStoreIter
iter cache :: Cache a
cache = let
(pos :: Int
pos,leaf :: Int
leaf,child :: Int
child) = Depth -> ForestStoreIter -> (Int, Int, Int)
getTreeIterLeaf Depth
depth ForestStoreIter
iter
childIdx :: Word32
childIdx = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
childIdx_Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+1
nextIter :: ForestStoreIter
nextIter = ForestStoreIter -> Int -> Int -> Word32 -> ForestStoreIter
setBitSlice ForestStoreIter
iter (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
leaf) Int
child Word32
childIdx
in
if Word32
childIdxWord32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>=Int -> Word32
forall a. Bits a => Int -> a
bit Int
child then (Maybe ForestStoreIter
forall a. Maybe a
Nothing, Cache a
cache) else
case Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
forall a. Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
checkSuccess Depth
depth ForestStoreIter
nextIter Cache a
cache of
(True, cache :: Cache a
cache) -> (ForestStoreIter -> Maybe ForestStoreIter
forall a. a -> Maybe a
Just ForestStoreIter
nextIter, Cache a
cache)
(False, cache :: Cache a
cache) -> (Maybe ForestStoreIter
forall a. Maybe a
Nothing, Cache a
cache)
iterNChildren :: Depth -> ForestStoreIter -> Cache a -> (Int, Cache a)
iterNChildren :: Depth -> ForestStoreIter -> Cache a -> (Int, Cache a)
iterNChildren depth :: Depth
depth iter :: ForestStoreIter
iter cache :: Cache a
cache = case Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
forall a. Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
checkSuccess Depth
depth ForestStoreIter
iter Cache a
cache of
(True, cache :: Cache a
cache@((_,Node { subForest :: forall a. Tree a -> Forest a
subForest = Forest a
forest}:_):_)) -> (Forest a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest a
forest, Cache a
cache)
(_, cache :: Cache a
cache) -> (0, Cache a
cache)
iterParent :: Depth -> ForestStoreIter -> Maybe ForestStoreIter
iterParent :: Depth -> ForestStoreIter -> Maybe ForestStoreIter
iterParent depth :: Depth
depth iter :: ForestStoreIter
iter = let
(pos :: Int
pos,leaf :: Int
leaf,_child :: Int
_child) = Depth -> ForestStoreIter -> (Int, Int, Int)
getTreeIterLeaf Depth
depth ForestStoreIter
iter
in if Int
posInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==0 then Maybe ForestStoreIter
forall a. Maybe a
Nothing else
if ForestStoreIter -> Int -> Int -> Word32
getBitSlice ForestStoreIter
iter Int
pos Int
leafWord32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==0 then Maybe ForestStoreIter
forall a. Maybe a
Nothing else
ForestStoreIter -> Maybe ForestStoreIter
forall a. a -> Maybe a
Just (ForestStoreIter -> Int -> Int -> Word32 -> ForestStoreIter
setBitSlice ForestStoreIter
iter Int
pos Int
leaf 0)
forestStoreInsertForest :: MonadIO m
=> ForestStore a
-> TreePath
-> Int
-> Forest a
-> m ()
forestStoreInsertForest :: ForestStore a -> TreePath -> Int -> Forest a -> m ()
forestStoreInsertForest (ForestStore model :: ManagedPtr (CustomStore (IORef (Store a)) a)
model) path :: TreePath
path pos :: Int
pos nodes :: Forest a
nodes = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[Int32]
ipath <- TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
CustomStore (IORef (Store a)) a -> IO ()
forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m ()
customStoreInvalidateIters (CustomStore (IORef (Store a)) a -> IO ())
-> CustomStore (IORef (Store a)) a -> IO ()
forall a b. (a -> b) -> a -> b
$ ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model
(idx :: Int
idx, toggle :: Bool
toggle) <- IORef (Store a)
-> (Store a -> (Store a, (Int, Bool))) -> IO (Int, Bool)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (CustomStore (IORef (Store a)) a -> IORef (Store a))
-> CustomStore (IORef (Store a)) a -> IORef (Store a)
forall a b. (a -> b) -> a -> b
$ ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model) ((Store a -> (Store a, (Int, Bool))) -> IO (Int, Bool))
-> (Store a -> (Store a, (Int, Bool))) -> IO (Int, Bool)
forall a b. (a -> b) -> a -> b
$
\store :: Store a
store@Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } ->
case Forest a
-> Forest a -> [Int32] -> Int -> Maybe (Forest a, Int, Bool)
forall a.
Forest a
-> Forest a -> [Int32] -> Int -> Maybe (Forest a, Int, Bool)
insertIntoForest (Cache a -> Forest a
forall a. Cache a -> Forest a
cacheToStore Cache a
cache) Forest a
nodes [Int32]
ipath Int
pos of
Nothing -> [Char] -> (Store a, (Int, Bool))
forall a. HasCallStack => [Char] -> a
error ("forestStoreInsertForest: path does not exist " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Int32] -> [Char]
forall a. Show a => a -> [Char]
show [Int32]
ipath)
Just (newForest :: Forest a
newForest, idx :: Int
idx, toggle :: Bool
toggle) ->
let depth :: Depth
depth = Forest a -> Depth
forall a. Forest a -> Depth
calcForestDepth Forest a
newForest
in (Store :: forall a. Depth -> Cache a -> Store a
Store { depth :: Depth
depth = Depth
depth,
content :: Cache a
content = Forest a -> Cache a
forall a. Forest a -> Cache a
storeToCache Forest a
newForest },
(Int
idx, Bool
toggle))
Store { depth :: forall a. Store a -> Depth
depth = Depth
depth } <- IORef (Store a) -> IO (Store a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (CustomStore (IORef (Store a)) a -> IORef (Store a))
-> CustomStore (IORef (Store a)) a -> IORef (Store a)
forall a b. (a -> b) -> a -> b
$ ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model)
let rpath :: [Int32]
rpath = [Int32] -> [Int32]
forall a. [a] -> [a]
reverse [Int32]
ipath
Int32
stamp <- CustomStore (IORef (Store a)) a -> IO Int32
forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m Int32
customStoreGetStamp (CustomStore (IORef (Store a)) a -> IO Int32)
-> CustomStore (IORef (Store a)) a -> IO Int32
forall a b. (a -> b) -> a -> b
$ ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ let p' :: [Int32]
p' = [Int32] -> [Int32]
forall a. [a] -> [a]
reverse [Int32]
p
Just iter :: ForestStoreIter
iter = Depth -> [Int32] -> Maybe ForestStoreIter
fromPath Depth
depth [Int32]
p'
in do
TreePath
p'' <- [Int32] -> IO TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int32]
p'
CustomStore (IORef (Store a)) a -> TreePath -> TreeIter -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> TreeIter -> m ()
treeModelRowInserted (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model) TreePath
p'' (TreeIter -> IO ()) -> IO TreeIter -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ForestStoreIter -> IO TreeIter
forall (m :: * -> *). MonadIO m => ForestStoreIter -> m TreeIter
fromForestStoreIter (ForestStoreIter -> Int32 -> ForestStoreIter
forestStoreIterSetStamp ForestStoreIter
iter Int32
stamp)
| (i :: Int
i, node :: Tree a
node) <- Depth -> Forest a -> [(Int, Tree a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
idx..] Forest a
nodes
, [Int32]
p <- [Int32] -> Tree a -> [[Int32]]
forall a. [Int32] -> Tree a -> [[Int32]]
paths (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
: [Int32]
rpath) Tree a
node ]
let Just iter :: ForestStoreIter
iter = Depth -> [Int32] -> Maybe ForestStoreIter
fromPath Depth
depth [Int32]
ipath
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
toggle (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ CustomStore (IORef (Store a)) a -> TreePath -> TreeIter -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> TreeIter -> m ()
treeModelRowHasChildToggled (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model) TreePath
path
(TreeIter -> IO ()) -> IO TreeIter -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ForestStoreIter -> IO TreeIter
forall (m :: * -> *). MonadIO m => ForestStoreIter -> m TreeIter
fromForestStoreIter (ForestStoreIter -> Int32 -> ForestStoreIter
forestStoreIterSetStamp ForestStoreIter
iter Int32
stamp)
where paths :: [Int32] -> Tree a -> [[Int32]]
paths :: [Int32] -> Tree a -> [[Int32]]
paths path :: [Int32]
path Node { subForest :: forall a. Tree a -> Forest a
subForest = Forest a
ts } =
[Int32]
path [Int32] -> [[Int32]] -> [[Int32]]
forall a. a -> [a] -> [a]
: [[[Int32]]] -> [[Int32]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Int32] -> Tree a -> [[Int32]]
forall a. [Int32] -> Tree a -> [[Int32]]
paths (Int32
nInt32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
:[Int32]
path) Tree a
t | (n :: Int32
n, t :: Tree a
t) <- [Int32] -> Forest a -> [(Int32, Tree a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] Forest a
ts ]
forestStoreInsertTree :: MonadIO m
=> ForestStore a
-> TreePath
-> Int
-> Tree a
-> m ()
forestStoreInsertTree :: ForestStore a -> TreePath -> Int -> Tree a -> m ()
forestStoreInsertTree store :: ForestStore a
store path :: TreePath
path pos :: Int
pos node :: Tree a
node =
ForestStore a -> TreePath -> Int -> Forest a -> m ()
forall (m :: * -> *) a.
MonadIO m =>
ForestStore a -> TreePath -> Int -> Forest a -> m ()
forestStoreInsertForest ForestStore a
store TreePath
path Int
pos [Tree a
node]
forestStoreInsert :: MonadIO m
=> ForestStore a
-> TreePath
-> Int
-> a
-> m ()
forestStoreInsert :: ForestStore a -> TreePath -> Int -> a -> m ()
forestStoreInsert store :: ForestStore a
store path :: TreePath
path pos :: Int
pos node :: a
node =
ForestStore a -> TreePath -> Int -> Forest a -> m ()
forall (m :: * -> *) a.
MonadIO m =>
ForestStore a -> TreePath -> Int -> Forest a -> m ()
forestStoreInsertForest ForestStore a
store TreePath
path Int
pos [a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Node a
node []]
insertIntoForest :: Forest a -> Forest a -> [Int32] -> Int ->
Maybe (Forest a, Int, Bool)
insertIntoForest :: Forest a
-> Forest a -> [Int32] -> Int -> Maybe (Forest a, Int, Bool)
insertIntoForest forest :: Forest a
forest nodes :: Forest a
nodes [] pos :: Int
pos
| Int
posInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<0 = (Forest a, Int, Bool) -> Maybe (Forest a, Int, Bool)
forall a. a -> Maybe a
Just (Forest a
forestForest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++Forest a
nodes, Forest a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest a
forest, Forest a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest a
forest)
| Bool
otherwise = (Forest a, Int, Bool) -> Maybe (Forest a, Int, Bool)
forall a. a -> Maybe a
Just (Forest a
prevForest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++Forest a
nodesForest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++Forest a
next, Forest a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest a
prev, Forest a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest a
forest)
where (prev :: Forest a
prev, next :: Forest a
next) = Int -> Forest a -> (Forest a, Forest a)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pos Forest a
forest
insertIntoForest forest :: Forest a
forest nodes :: Forest a
nodes (p :: Int32
p:ps :: [Int32]
ps) pos :: Int
pos = case Int -> Forest a -> (Forest a, Forest a)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
p) Forest a
forest of
(prev :: Forest a
prev, []) -> Maybe (Forest a, Int, Bool)
forall a. Maybe a
Nothing
(prev :: Forest a
prev, Node { rootLabel :: forall a. Tree a -> a
rootLabel = a
val,
subForest :: forall a. Tree a -> Forest a
subForest = Forest a
for}:next :: Forest a
next) ->
case Forest a
-> Forest a -> [Int32] -> Int -> Maybe (Forest a, Int, Bool)
forall a.
Forest a
-> Forest a -> [Int32] -> Int -> Maybe (Forest a, Int, Bool)
insertIntoForest Forest a
for Forest a
nodes [Int32]
ps Int
pos of
Nothing -> Maybe (Forest a, Int, Bool)
forall a. Maybe a
Nothing
Just (for :: Forest a
for, pos :: Int
pos, toggle :: Bool
toggle) -> (Forest a, Int, Bool) -> Maybe (Forest a, Int, Bool)
forall a. a -> Maybe a
Just (Forest a
prevForest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++Node :: forall a. a -> Forest a -> Tree a
Node { rootLabel :: a
rootLabel = a
val,
subForest :: Forest a
subForest = Forest a
for }Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
:Forest a
next,
Int
pos, Bool
toggle)
forestStoreRemove :: MonadIO m => ForestStore a -> TreePath -> m Bool
forestStoreRemove :: ForestStore a -> TreePath -> m Bool
forestStoreRemove model :: ForestStore a
model path :: TreePath
path = TreePath -> m [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path m [Int32] -> ([Int32] -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ForestStore a -> TreePath -> [Int32] -> m Bool
forall (m :: * -> *) a.
MonadIO m =>
ForestStore a -> TreePath -> [Int32] -> m Bool
forestStoreRemoveImpl ForestStore a
model TreePath
path
forestStoreRemoveImpl :: MonadIO m => ForestStore a -> TreePath -> [Int32] -> m Bool
forestStoreRemoveImpl :: ForestStore a -> TreePath -> [Int32] -> m Bool
forestStoreRemoveImpl (ForestStore model :: ManagedPtr (CustomStore (IORef (Store a)) a)
model) _ [] = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
forestStoreRemoveImpl (ForestStore model :: ManagedPtr (CustomStore (IORef (Store a)) a)
model) path :: TreePath
path ipath :: [Int32]
ipath = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
CustomStore (IORef (Store a)) a -> IO ()
forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m ()
customStoreInvalidateIters (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model)
(found :: Bool
found, toggle :: Bool
toggle) <- IORef (Store a)
-> (Store a -> (Store a, (Bool, Bool))) -> IO (Bool, Bool)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model)) ((Store a -> (Store a, (Bool, Bool))) -> IO (Bool, Bool))
-> (Store a -> (Store a, (Bool, Bool))) -> IO (Bool, Bool)
forall a b. (a -> b) -> a -> b
$
\store :: Store a
store@Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } ->
if Cache a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Cache a
cache then (Store a
store, (Bool
False, Bool
False)) else
case Forest a -> [Int32] -> Maybe (Forest a, Bool)
forall a. Forest a -> [Int32] -> Maybe (Forest a, Bool)
deleteFromForest (Cache a -> Forest a
forall a. Cache a -> Forest a
cacheToStore Cache a
cache) [Int32]
ipath of
Nothing -> (Store a
store, (Bool
False, Bool
False))
Just (newForest :: Forest a
newForest, toggle :: Bool
toggle) ->
(Store :: forall a. Depth -> Cache a -> Store a
Store { depth :: Depth
depth = Depth
d,
content :: Cache a
content = Forest a -> Cache a
forall a. Forest a -> Cache a
storeToCache Forest a
newForest }, (Bool
True, Bool
toggle))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
found (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
toggle Bool -> Bool -> Bool
&& Bool -> Bool
not ([Int32] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int32]
ipath)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Store { depth :: forall a. Store a -> Depth
depth = Depth
depth } <- IORef (Store a) -> IO (Store a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model))
let iparent :: [Int32]
iparent = [Int32] -> [Int32]
forall a. [a] -> [a]
init [Int32]
ipath
Just iter :: ForestStoreIter
iter = Depth -> [Int32] -> Maybe ForestStoreIter
fromPath Depth
depth [Int32]
iparent
TreePath
parent <- [Int32] -> IO TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int32]
iparent
CustomStore (IORef (Store a)) a -> TreePath -> TreeIter -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> TreeIter -> m ()
treeModelRowHasChildToggled (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model) TreePath
parent (TreeIter -> IO ()) -> IO TreeIter -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ForestStoreIter -> IO TreeIter
forall (m :: * -> *). MonadIO m => ForestStoreIter -> m TreeIter
fromForestStoreIter ForestStoreIter
iter
CustomStore (IORef (Store a)) a -> TreePath -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> m ()
treeModelRowDeleted (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model) TreePath
path
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
found
forestStoreClear :: MonadIO m => ForestStore a -> m ()
forestStoreClear :: ForestStore a -> m ()
forestStoreClear (ForestStore model :: ManagedPtr (CustomStore (IORef (Store 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
$ do
CustomStore (IORef (Store a)) a -> IO ()
forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m ()
customStoreInvalidateIters (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model)
Store { content :: forall a. Store a -> Cache a
content = Cache a
cache } <- IORef (Store a) -> IO (Store a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model))
let forest :: Forest a
forest = Cache a -> Forest a
forall a. Cache a -> Forest a
cacheToStore Cache a
cache
IORef (Store a) -> Store a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model)) Store :: forall a. Depth -> Cache a -> Store a
Store {
depth :: Depth
depth = Forest Any -> Depth
forall a. Forest a -> Depth
calcForestDepth [],
content :: Cache a
content = Forest a -> Cache a
forall a. Forest a -> Cache a
storeToCache []
}
let loop :: Int -> IO ()
loop (-1) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop n :: Int
n = [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] IO TreePath -> (TreePath -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CustomStore (IORef (Store a)) a -> TreePath -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> m ()
treeModelRowDeleted (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
loop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
Int -> IO ()
loop (Forest a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest a
forest Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
deleteFromForest :: Forest a -> [Int32] -> Maybe (Forest a, Bool)
deleteFromForest :: Forest a -> [Int32] -> Maybe (Forest a, Bool)
deleteFromForest forest :: Forest a
forest [] = (Forest a, Bool) -> Maybe (Forest a, Bool)
forall a. a -> Maybe a
Just ([], Bool
False)
deleteFromForest forest :: Forest a
forest (p :: Int32
p:ps :: [Int32]
ps) =
case Int -> Forest a -> (Forest a, Forest a)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
p) Forest a
forest of
(prev :: Forest a
prev, kill :: Tree a
kill@Node { rootLabel :: forall a. Tree a -> a
rootLabel = a
val,
subForest :: forall a. Tree a -> Forest a
subForest = Forest a
for}:next :: Forest a
next) ->
if [Int32] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int32]
ps then (Forest a, Bool) -> Maybe (Forest a, Bool)
forall a. a -> Maybe a
Just (Forest a
prevForest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++Forest a
next, Forest a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest a
prev Bool -> Bool -> Bool
&& Forest a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest a
next) else
case Forest a -> [Int32] -> Maybe (Forest a, Bool)
forall a. Forest a -> [Int32] -> Maybe (Forest a, Bool)
deleteFromForest Forest a
for [Int32]
ps of
Nothing -> Maybe (Forest a, Bool)
forall a. Maybe a
Nothing
Just (for :: Forest a
for,toggle :: Bool
toggle) -> (Forest a, Bool) -> Maybe (Forest a, Bool)
forall a. a -> Maybe a
Just (Forest a
prevForest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++Node :: forall a. a -> Forest a -> Tree a
Node {rootLabel :: a
rootLabel = a
val,
subForest :: Forest a
subForest = Forest a
for }Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
:Forest a
next, Bool
toggle)
(prev :: Forest a
prev, []) -> Maybe (Forest a, Bool)
forall a. Maybe a
Nothing
forestStoreSetValue :: MonadIO m => ForestStore a -> TreePath -> a -> m ()
forestStoreSetValue :: ForestStore a -> TreePath -> a -> m ()
forestStoreSetValue store :: ForestStore a
store path :: TreePath
path value :: a
value = ForestStore a -> TreePath -> (a -> m a) -> m Bool
forall (m :: * -> *) a.
MonadIO m =>
ForestStore a -> TreePath -> (a -> m a) -> m Bool
forestStoreChangeM ForestStore a
store TreePath
path (\_ -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
value)
m Bool -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
forestStoreChange :: MonadIO m => ForestStore a -> TreePath -> (a -> a) -> m Bool
forestStoreChange :: ForestStore a -> TreePath -> (a -> a) -> m Bool
forestStoreChange store :: ForestStore a
store path :: TreePath
path func :: a -> a
func = ForestStore a -> TreePath -> (a -> m a) -> m Bool
forall (m :: * -> *) a.
MonadIO m =>
ForestStore a -> TreePath -> (a -> m a) -> m Bool
forestStoreChangeM ForestStore a
store TreePath
path (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (a -> a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
func)
forestStoreChangeM :: MonadIO m => ForestStore a -> TreePath -> (a -> m a) -> m Bool
forestStoreChangeM :: ForestStore a -> TreePath -> (a -> m a) -> m Bool
forestStoreChangeM (ForestStore model :: ManagedPtr (CustomStore (IORef (Store a)) a)
model) path :: TreePath
path act :: a -> m a
act = do
[Int32]
ipath <- TreePath -> m [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
CustomStore (IORef (Store a)) a -> m ()
forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m ()
customStoreInvalidateIters (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model)
store :: Store a
store@Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } <-
IO (Store a) -> m (Store a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Store a) -> m (Store a)) -> IO (Store a) -> m (Store a)
forall a b. (a -> b) -> a -> b
$ IORef (Store a) -> IO (Store a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model))
(store' :: Store a
store'@Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache }, found :: Bool
found) <- do
Maybe (Forest a)
mRes <- Forest a -> (a -> m a) -> [Int32] -> m (Maybe (Forest a))
forall (m :: * -> *) a.
MonadIO m =>
Forest a -> (a -> m a) -> [Int32] -> m (Maybe (Forest a))
changeForest (Cache a -> Forest a
forall a. Cache a -> Forest a
cacheToStore Cache a
cache) a -> m a
act [Int32]
ipath
(Store a, Bool) -> m (Store a, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Store a, Bool) -> m (Store a, Bool))
-> (Store a, Bool) -> m (Store a, Bool)
forall a b. (a -> b) -> a -> b
$ case Maybe (Forest a)
mRes of
Nothing -> (Store a
store, Bool
False)
Just newForest :: Forest a
newForest -> (Store :: forall a. Depth -> Cache a -> Store a
Store { depth :: Depth
depth = Depth
d,
content :: Cache a
content = Forest a -> Cache a
forall a. Forest a -> Cache a
storeToCache Forest a
newForest }, Bool
True)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Store a) -> Store a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model)) Store a
store'
let Just iter :: ForestStoreIter
iter = Depth -> [Int32] -> Maybe ForestStoreIter
fromPath Depth
d [Int32]
ipath
Int32
stamp <- CustomStore (IORef (Store a)) a -> m Int32
forall (m :: * -> *) private row.
MonadIO m =>
CustomStore private row -> m Int32
customStoreGetStamp (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
found (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CustomStore (IORef (Store a)) a -> TreePath -> TreeIter -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeModel a) =>
a -> TreePath -> TreeIter -> m ()
treeModelRowChanged (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model) TreePath
path (TreeIter -> m ()) -> m TreeIter -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ForestStoreIter -> m TreeIter
forall (m :: * -> *). MonadIO m => ForestStoreIter -> m TreeIter
fromForestStoreIter (ForestStoreIter -> Int32 -> ForestStoreIter
forestStoreIterSetStamp ForestStoreIter
iter Int32
stamp)
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
found
changeForest :: MonadIO m => Forest a -> (a -> m a) -> [Int32] -> m (Maybe (Forest a))
changeForest :: Forest a -> (a -> m a) -> [Int32] -> m (Maybe (Forest a))
changeForest forest :: Forest a
forest act :: a -> m a
act [] = Maybe (Forest a) -> m (Maybe (Forest a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Forest a)
forall a. Maybe a
Nothing
changeForest forest :: Forest a
forest act :: a -> m a
act (p :: Int32
p:ps :: [Int32]
ps) = case Int -> Forest a -> (Forest a, Forest a)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
p) Forest a
forest of
(prev :: Forest a
prev, []) -> Maybe (Forest a) -> m (Maybe (Forest a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Forest a)
forall a. Maybe a
Nothing
(prev :: Forest a
prev, Node { rootLabel :: forall a. Tree a -> a
rootLabel = a
val,
subForest :: forall a. Tree a -> Forest a
subForest = Forest a
for}:next :: Forest a
next) ->
if [Int32] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int32]
ps then do
a
val' <- a -> m a
act a
val
Maybe (Forest a) -> m (Maybe (Forest a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Forest a -> Maybe (Forest a)
forall a. a -> Maybe a
Just (Forest a
prevForest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++Node :: forall a. a -> Forest a -> Tree a
Node { rootLabel :: a
rootLabel = a
val',
subForest :: Forest a
subForest = Forest a
for }Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
:Forest a
next))
else do
Maybe (Forest a)
mFor <- Forest a -> (a -> m a) -> [Int32] -> m (Maybe (Forest a))
forall (m :: * -> *) a.
MonadIO m =>
Forest a -> (a -> m a) -> [Int32] -> m (Maybe (Forest a))
changeForest Forest a
for a -> m a
act [Int32]
ps
case Maybe (Forest a)
mFor of
Nothing -> Maybe (Forest a) -> m (Maybe (Forest a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Forest a)
forall a. Maybe a
Nothing
Just for :: Forest a
for -> Maybe (Forest a) -> m (Maybe (Forest a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Forest a) -> m (Maybe (Forest a)))
-> Maybe (Forest a) -> m (Maybe (Forest a))
forall a b. (a -> b) -> a -> b
$ Forest a -> Maybe (Forest a)
forall a. a -> Maybe a
Just (Forest a
prevForest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++Node :: forall a. a -> Forest a -> Tree a
Node { rootLabel :: a
rootLabel = a
val,
subForest :: Forest a
subForest = Forest a
for }Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
:Forest a
next)
forestStoreGetValue :: (Applicative m, MonadIO m) => ForestStore a -> TreePath -> m a
forestStoreGetValue :: ForestStore a -> TreePath -> m a
forestStoreGetValue model :: ForestStore a
model path :: TreePath
path = Tree a -> a
forall a. Tree a -> a
rootLabel (Tree a -> a) -> m (Tree a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForestStore a -> TreePath -> m (Tree a)
forall (m :: * -> *) a.
MonadIO m =>
ForestStore a -> TreePath -> m (Tree a)
forestStoreGetTree ForestStore a
model TreePath
path
forestStoreGetTree :: MonadIO m => ForestStore a -> TreePath -> m (Tree a)
forestStoreGetTree :: ForestStore a -> TreePath -> m (Tree a)
forestStoreGetTree (ForestStore model :: ManagedPtr (CustomStore (IORef (Store a)) a)
model) path :: TreePath
path = IO (Tree a) -> m (Tree a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tree a) -> m (Tree a)) -> IO (Tree a) -> m (Tree a)
forall a b. (a -> b) -> a -> b
$ do
[Int32]
ipath <- TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
store :: Store a
store@Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } <-
IORef (Store a) -> IO (Store a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model))
case Depth -> [Int32] -> Maybe ForestStoreIter
fromPath Depth
d [Int32]
ipath of
(Just iter :: ForestStoreIter
iter) -> do
let (res :: Bool
res, cache' :: Cache a
cache') = Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
forall a. Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
checkSuccess Depth
d ForestStoreIter
iter Cache a
cache
IORef (Store a) -> Store a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model)) Store a
store { content :: Cache a
content = Cache a
cache' }
case Cache a
cache' of
((_,node :: Tree a
node:_):_) | Bool
res -> Tree a -> IO (Tree a)
forall (m :: * -> *) a. Monad m => a -> m a
return Tree a
node
_ -> [Char] -> IO (Tree a)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ("forestStoreGetTree: path does not exist " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Int32] -> [Char]
forall a. Show a => a -> [Char]
show [Int32]
ipath)
_ -> [Char] -> IO (Tree a)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ("forestStoreGetTree: path does not exist " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Int32] -> [Char]
forall a. Show a => a -> [Char]
show [Int32]
ipath)
forestStoreGetForest :: MonadIO m => ForestStore a -> m (Forest a)
forestStoreGetForest :: ForestStore a -> m (Forest a)
forestStoreGetForest (ForestStore model :: ManagedPtr (CustomStore (IORef (Store a)) a)
model) = IO (Forest a) -> m (Forest a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Forest a) -> m (Forest a)) -> IO (Forest a) -> m (Forest a)
forall a b. (a -> b) -> a -> b
$ do
store :: Store a
store@Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } <-
IORef (Store a) -> IO (Store a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model))
Forest a -> IO (Forest a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Forest a -> IO (Forest a)) -> Forest a -> IO (Forest a)
forall a b. (a -> b) -> a -> b
$ Cache a -> Forest a
forall a. Cache a -> Forest a
cacheToStore Cache a
cache
forestStoreLookup :: MonadIO m => ForestStore a -> TreePath -> m (Maybe (Tree a))
forestStoreLookup :: ForestStore a -> TreePath -> m (Maybe (Tree a))
forestStoreLookup (ForestStore model :: ManagedPtr (CustomStore (IORef (Store a)) a)
model) path :: TreePath
path = IO (Maybe (Tree a)) -> m (Maybe (Tree a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Tree a)) -> m (Maybe (Tree a)))
-> IO (Maybe (Tree a)) -> m (Maybe (Tree a))
forall a b. (a -> b) -> a -> b
$ do
[Int32]
ipath <- TreePath -> IO [Int32]
forall (m :: * -> *). MonadIO m => TreePath -> m [Int32]
treePathGetIndices' TreePath
path
store :: Store a
store@Store { depth :: forall a. Store a -> Depth
depth = Depth
d, content :: forall a. Store a -> Cache a
content = Cache a
cache } <-
IORef (Store a) -> IO (Store a)
forall a. IORef a -> IO a
readIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model))
case Depth -> [Int32] -> Maybe ForestStoreIter
fromPath Depth
d [Int32]
ipath of
(Just iter :: ForestStoreIter
iter) -> do
let (res :: Bool
res, cache' :: Cache a
cache') = Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
forall a. Depth -> ForestStoreIter -> Cache a -> (Bool, Cache a)
checkSuccess Depth
d ForestStoreIter
iter Cache a
cache
IORef (Store a) -> Store a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CustomStore (IORef (Store a)) a -> IORef (Store a)
forall private row. CustomStore private row -> private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Store a)) a)
-> CustomStore (IORef (Store a)) a
forall private row.
ManagedPtr (CustomStore private row) -> CustomStore private row
CustomStore ManagedPtr (CustomStore (IORef (Store a)) a)
model)) Store a
store { content :: Cache a
content = Cache a
cache' }
case Cache a
cache' of
((_,node :: Tree a
node:_):_) | Bool
res -> Maybe (Tree a) -> IO (Maybe (Tree a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree a -> Maybe (Tree a)
forall a. a -> Maybe a
Just Tree a
node)
_ -> Maybe (Tree a) -> IO (Maybe (Tree a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Tree a)
forall a. Maybe a
Nothing
_ -> Maybe (Tree a) -> IO (Maybe (Tree a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Tree a)
forall a. Maybe a
Nothing