    {-# LANGUAGE CPP #-}
    -- -*-haskell-*-
    --  GIMP Toolkit (GTK) CustomStore TreeModel
    --
    --  Author : Duncan Coutts, Axel Simon
    --
    --  Created: 11 February 2006
    --
    --  Copyright (C) 2005 Duncan Coutts, Axel Simon
    --
    --  This library is free software; you can redistribute it and/or
    --  modify it under the terms of the GNU Lesser General Public
    --  License as published by the Free Software Foundation; either
    --  version 2.1 of the License, or (at your option) any later version.
    --
    --  This library is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    --  Lesser General Public License for more details.
    --
    -- |
    -- Maintainer  : gtk2hs-users@lists.sourceforge.net
    -- Stability   : provisional
    -- Portability : portable (depends on GHC)
    --
    -- Standard model to store hierarchical data.
    --
    module Graphics.UI.Gtk.ModelView.TreeStore (

    -- * Types
      TreeStore,

    -- * Constructors
      treeStoreNew,
      treeStoreNewDND,

    -- * Implementation of Interfaces
      treeStoreDefaultDragSourceIface,
      treeStoreDefaultDragDestIface,

    -- * Methods
      treeStoreGetValue,
      treeStoreGetTree,
      treeStoreLookup,

      treeStoreSetValue,

      treeStoreInsert,
      treeStoreInsertTree,
      treeStoreInsertForest,

      treeStoreRemove,
      treeStoreClear,

      treeStoreChange,
      treeStoreChangeM,
      ) where

    import Data.Bits
    import Data.Word (Word32)
    import Data.Maybe ( fromMaybe, isJust )
    import Data.Tree
    import Control.Monad ( when )
    import Control.Exception (assert)
    import Data.IORef
    import Graphics.UI.Gtk.ModelView.Types
    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 )

    --------------------------------------------
    -- internal model data types
    --

    -- | A store for hierarchical data.
    --
    newtype TreeStore a = TreeStore (CustomStore (IORef (Store a)) a)

    instance TypedTreeModelClass TreeStore
    instance TreeModelClass (TreeStore a)
    instance GObjectClass (TreeStore a) where
      toGObject :: TreeStore a -> GObject
    toGObject (TreeStore CustomStore (IORef (Store a)) a
    tm) = CustomStore (IORef (Store a)) a -> GObject
    forall o. GObjectClass o => o -> GObject
    toGObject CustomStore (IORef (Store a)) a
    tm
      unsafeCastGObject :: GObject -> TreeStore a
    unsafeCastGObject = CustomStore (IORef (Store a)) a -> TreeStore a
    forall a. CustomStore (IORef (Store a)) a -> TreeStore a
    TreeStore (CustomStore (IORef (Store a)) a -> TreeStore a)
    -> (GObject -> CustomStore (IORef (Store a)) a)
    -> GObject
    -> TreeStore a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GObject -> CustomStore (IORef (Store a)) a
    forall o. GObjectClass o => GObject -> o
    unsafeCastGObject

    -- | Maximum number of nodes on each level.
    --
    -- * These numbers determine how many bits in a 'TreeIter' are devoted to
    --   each level. Hence, these numbers reflect log2 of the maximum number
    --   of nodes at a level, rounded up.
    --
    type Depth = [Int]

    data Store a = Store {
      forall a. Store a -> Depth
    depth :: Depth,
      forall a. Store a -> Cache a
    content :: Cache a
    }

    -- | Create a new list store.
    --
    -- * The given rose tree determines the initial content and may be the empty
    --   list. Each 'Tree' in the forest corresponds to one top-level node.
    --
    -- * The TreeStore maintains the initially given Forest and aligns the 'TreePath'
    --   bits to fit in 96-bit length 'TreeIter' storage.
    --
    -- * Additionally, a cache is used to achieve higher performance if operating on
    --   recently used TreePaths.
    --
    -- * __Note:__ due to the limited amount of bits available in TreeIter storage, only
    --   limited depth forests can be used with this implementation, the result of too deep
    --   Forests is an undefined behaviour while trying to retrieve the deeply nested nodes.
    --   For example: assuming the average requiement is 8 bits per tree level (max number of
    --   children at the level is 255), then we can only use 12 levels deep trees (96/8) -
    --   any further levels in a TreePath will not be encoded in the corresponding TreeIter
    --   storage.
    --
    treeStoreNew :: Forest a -> IO (TreeStore a)
    treeStoreNew :: forall a. Forest a -> IO (TreeStore a)
    treeStoreNew Forest a
    forest = Forest a
    -> Maybe (DragSourceIface TreeStore a)
    -> Maybe (DragDestIface TreeStore a)
    -> IO (TreeStore a)
    forall a.
    Forest a
    -> Maybe (DragSourceIface TreeStore a)
    -> Maybe (DragDestIface TreeStore a)
    -> IO (TreeStore a)
    treeStoreNewDND Forest a
    forest
                            (DragSourceIface TreeStore a -> Maybe (DragSourceIface TreeStore a)
    forall a. a -> Maybe a
    Just DragSourceIface TreeStore a
    forall row. DragSourceIface TreeStore row
    treeStoreDefaultDragSourceIface)
                            (DragDestIface TreeStore a -> Maybe (DragDestIface TreeStore a)
    forall a. a -> Maybe a
    Just DragDestIface TreeStore a
    forall row. DragDestIface TreeStore row
    treeStoreDefaultDragDestIface)

    -- | Create a new list store.
    --
    -- * In addition to 'treeStoreNew', this function takes an two interfaces
    --   to implement user-defined drag-and-drop functionality.
    --
    treeStoreNewDND :: Forest a -- ^ the initial tree stored in this model
      -> Maybe (DragSourceIface TreeStore a) -- ^ an optional interface for drags
      -> Maybe (DragDestIface TreeStore a) -- ^ an optional interface to handle drops
      -> IO (TreeStore a)
    treeStoreNewDND :: forall a.
    Forest a
    -> Maybe (DragSourceIface TreeStore a)
    -> Maybe (DragDestIface TreeStore a)
    -> IO (TreeStore a)
    treeStoreNewDND Forest a
    forest Maybe (DragSourceIface TreeStore a)
    mDSource Maybe (DragDestIface TreeStore a)
    mDDest = do
      storeRef <- Store a -> IO (IORef (Store a))
    forall a. a -> IO (IORef a)
    newIORef 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 -> b
    f = IORef (Store a) -> IO (Store a)
    forall a. IORef a -> IO a
    readIORef IORef (Store a)
    storeRef IO (Store a) -> (Store a -> IO b) -> IO b
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b -> IO b) -> (Store a -> b) -> Store a -> IO b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Store a -> b
    f
          withStoreUpdateCache Store a -> (b, Cache a)
    f = do
            store <- IORef (Store a) -> IO (Store a)
    forall a. IORef a -> IO a
    readIORef IORef (Store a)
    storeRef
            let (result, cache') = f store
            writeIORef storeRef store { content = cache' }
            return result

      customStoreNew storeRef TreeStore TreeModelIface {
        treeModelIfaceGetFlags = return [],

        treeModelIfaceGetIter = \Depth
    path -> (Store a -> Maybe TreeIter) -> IO (Maybe TreeIter)
    forall {b}. (Store a -> b) -> IO b
    withStore ((Store a -> Maybe TreeIter) -> IO (Maybe TreeIter))
    -> (Store a -> Maybe TreeIter) -> IO (Maybe TreeIter)
    forall a b. (a -> b) -> a -> b
    $
          \Store { depth :: forall a. Store a -> Depth
    depth = Depth
    d } -> Depth -> Depth -> Maybe TreeIter
    fromPath Depth
    d Depth
    path,

        treeModelIfaceGetPath = \TreeIter
    iter -> (Store a -> Depth) -> IO Depth
    forall {b}. (Store a -> b) -> IO b
    withStore ((Store a -> Depth) -> IO Depth) -> (Store a -> Depth) -> IO Depth
    forall a b. (a -> b) -> a -> b
    $
          \Store { depth :: forall a. Store a -> Depth
    depth = Depth
    d } -> Depth -> TreeIter -> Depth
    toPath Depth
    d TreeIter
    iter,

        treeModelIfaceGetRow  = \TreeIter
    iter -> (Store a -> (a, Cache a)) -> IO a
    forall {b}. (Store a -> (b, Cache a)) -> IO b
    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 -> TreeIter -> Cache a -> (Bool, Cache a)
    forall a. Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    checkSuccess Depth
    d TreeIter
    iter Cache a
    cache of
              (Bool
    True, cache' :: Cache a
    cache'@((TreeIter
    _, (Node { rootLabel :: forall a. Tree a -> a
    rootLabel = a
    val }:Forest a
    _)):Cache a
    _)) ->
                (a
    val, Cache a
    cache')
              (Bool, Cache a)
    _ -> [Char] -> (a, Cache a)
    forall a. (?callStack::CallStack) => [Char] -> a
    error [Char]
    "TreeStore.getRow: iter does not refer to a valid entry",

        treeModelIfaceIterNext = \TreeIter
    iter -> (Store a -> (Maybe TreeIter, Cache a)) -> IO (Maybe TreeIter)
    forall {b}. (Store a -> (b, Cache a)) -> IO b
    withStoreUpdateCache ((Store a -> (Maybe TreeIter, Cache a)) -> IO (Maybe TreeIter))
    -> (Store a -> (Maybe TreeIter, Cache a)) -> IO (Maybe TreeIter)
    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 } -> Depth -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    forall a. Depth -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    iterNext Depth
    d TreeIter
    iter Cache a
    cache,

        treeModelIfaceIterChildren = \Maybe TreeIter
    mIter -> (Store a -> (Maybe TreeIter, Cache a)) -> IO (Maybe TreeIter)
    forall {b}. (Store a -> (b, Cache a)) -> IO b
    withStoreUpdateCache ((Store a -> (Maybe TreeIter, Cache a)) -> IO (Maybe TreeIter))
    -> (Store a -> (Maybe TreeIter, Cache a)) -> IO (Maybe TreeIter)
    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 :: TreeIter
    iter = TreeIter -> Maybe TreeIter -> TreeIter
    forall a. a -> Maybe a -> a
    fromMaybe TreeIter
    invalidIter Maybe TreeIter
    mIter
           in Depth -> Int -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    forall a.
    Depth -> Int -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    iterNthChild Depth
    d Int
    0 TreeIter
    iter Cache a
    cache,

        treeModelIfaceIterHasChild = \TreeIter
    iter -> (Store a -> (Bool, Cache a)) -> IO Bool
    forall {b}. (Store a -> (b, Cache a)) -> IO b
    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 (Maybe TreeIter
    mIter, Cache a
    cache') = Depth -> Int -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    forall a.
    Depth -> Int -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    iterNthChild Depth
    d Int
    0 TreeIter
    iter Cache a
    cache
            in (Maybe TreeIter -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe TreeIter
    mIter, Cache a
    cache'),

        treeModelIfaceIterNChildren = \Maybe TreeIter
    mIter -> (Store a -> (Int, Cache a)) -> IO Int
    forall {b}. (Store a -> (b, Cache a)) -> IO b
    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 :: TreeIter
    iter = TreeIter -> Maybe TreeIter -> TreeIter
    forall a. a -> Maybe a -> a
    fromMaybe TreeIter
    invalidIter Maybe TreeIter
    mIter
           in Depth -> TreeIter -> Cache a -> (Int, Cache a)
    forall a. Depth -> TreeIter -> Cache a -> (Int, Cache a)
    iterNChildren Depth
    d TreeIter
    iter Cache a
    cache,

        treeModelIfaceIterNthChild = \Maybe TreeIter
    mIter Int
    idx  -> (Store a -> (Maybe TreeIter, Cache a)) -> IO (Maybe TreeIter)
    forall {b}. (Store a -> (b, Cache a)) -> IO b
    withStoreUpdateCache ((Store a -> (Maybe TreeIter, Cache a)) -> IO (Maybe TreeIter))
    -> (Store a -> (Maybe TreeIter, Cache a)) -> IO (Maybe TreeIter)
    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 :: TreeIter
    iter = TreeIter -> Maybe TreeIter -> TreeIter
    forall a. a -> Maybe a -> a
    fromMaybe TreeIter
    invalidIter Maybe TreeIter
    mIter
           in Depth -> Int -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    forall a.
    Depth -> Int -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    iterNthChild Depth
    d Int
    idx TreeIter
    iter Cache a
    cache,

        treeModelIfaceIterParent = \TreeIter
    iter -> (Store a -> Maybe TreeIter) -> IO (Maybe TreeIter)
    forall {b}. (Store a -> b) -> IO b
    withStore ((Store a -> Maybe TreeIter) -> IO (Maybe TreeIter))
    -> (Store a -> Maybe TreeIter) -> IO (Maybe TreeIter)
    forall a b. (a -> b) -> a -> b
    $
          \Store { depth :: forall a. Store a -> Depth
    depth = Depth
    d } -> Depth -> TreeIter -> Maybe TreeIter
    iterParent Depth
    d TreeIter
    iter,

        treeModelIfaceRefNode = \TreeIter
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (),
        treeModelIfaceUnrefNode = \TreeIter
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
       } mDSource mDDest

    -- | Default drag functions for
    -- 'Graphics.UI.Gtk.ModelView.TreeStore'. These functions allow the rows of
    -- the model to serve as drag source. Any row is allowed to be dragged and the
    -- data set in the 'SelectionDataM' object is set with 'treeSetRowDragData',
    -- i.e. it contains the model and the 'TreePath' to the row.
    treeStoreDefaultDragSourceIface :: DragSourceIface TreeStore row
    treeStoreDefaultDragSourceIface :: forall row. DragSourceIface TreeStore row
    treeStoreDefaultDragSourceIface = DragSourceIface {
        treeDragSourceRowDraggable :: TreeStore row -> Depth -> IO Bool
    treeDragSourceRowDraggable = \TreeStore row
    _ Depth
    _-> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True,
        treeDragSourceDragDataGet :: TreeStore row -> Depth -> SelectionDataM Bool
    treeDragSourceDragDataGet = TreeStore row -> Depth -> SelectionDataM Bool
    forall treeModel.
    TreeModelClass treeModel =>
    treeModel -> Depth -> SelectionDataM Bool
    treeSetRowDragData,
        treeDragSourceDragDataDelete :: TreeStore row -> Depth -> IO Bool
    treeDragSourceDragDataDelete = \TreeStore row
    model dest :: Depth
    dest@(Int
    _:Depth
    _) -> do
                IO Bool -> IO Bool
    forall a. IO a -> IO a
    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
    $ TreeStore row -> Depth -> IO Bool
    forall a. TreeStore a -> Depth -> IO Bool
    treeStoreRemove TreeStore row
    model Depth
    dest
                Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

      }

    -- | Default drop functions for 'Graphics.UI.Gtk.ModelView.TreeStore'. These
    --   functions accept a row and insert the row into the new location if it is
    --   dragged into a tree view
    -- that uses the same model.
    treeStoreDefaultDragDestIface :: DragDestIface TreeStore row
    treeStoreDefaultDragDestIface :: forall row. DragDestIface TreeStore row
    treeStoreDefaultDragDestIface = DragDestIface {
        treeDragDestRowDropPossible :: TreeStore row -> Depth -> SelectionDataM Bool
    treeDragDestRowDropPossible = \TreeStore row
    model Depth
    dest -> do
          mModelPath <- SelectionDataM (Maybe (TreeModel, Depth))
    treeGetRowDragData
          case mModelPath of
            Maybe (TreeModel, Depth)
    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', Depth
    source) -> Bool -> SelectionDataM Bool
    forall a. a -> ReaderT (Ptr ()) IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TreeStore row -> TreeModel
    forall o. TreeModelClass o => o -> TreeModel
    toTreeModel TreeStore row
    modelTreeModel -> TreeModel -> Bool
    forall a. Eq a => a -> a -> Bool
    ==TreeModel -> TreeModel
    forall o. TreeModelClass o => o -> TreeModel
    toTreeModel TreeModel
    model'),
        treeDragDestDragDataReceived :: TreeStore row -> Depth -> SelectionDataM Bool
    treeDragDestDragDataReceived = \TreeStore row
    model dest :: Depth
    dest@(Int
    _:Depth
    _) -> do
          mModelPath <- SelectionDataM (Maybe (TreeModel, Depth))
    treeGetRowDragData
          case mModelPath of
            Maybe (TreeModel, Depth)
    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', source :: Depth
    source@(Int
    _:Depth
    _)) ->
              if TreeStore row -> TreeModel
    forall o. TreeModelClass o => o -> TreeModel
    toTreeModel TreeStore 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 <- TreeStore row -> Depth -> IO (Tree row)
    forall a. TreeStore a -> Depth -> IO (Tree a)
    treeStoreGetTree TreeStore row
    model Depth
    source
                treeStoreInsertTree model (init dest) (last dest) row
                return True
      }

    --------------------------------------------
    -- low level bit-twiddling utility functions
    --

    bitsNeeded :: Word32 -> Int
    bitsNeeded :: Word32 -> Int
    bitsNeeded Word32
    n = Int -> Word32 -> Int
    forall {t} {t}. (Num t, Num t, Bits t) => t -> t -> t
    bitsNeeded' Int
    0 Word32
    n
      where bitsNeeded' :: t -> t -> t
    bitsNeeded' t
    b t
    0 = t
    b
            bitsNeeded' t
    b t
    n = t -> t -> t
    bitsNeeded' (t
    bt -> t -> t
    forall a. Num a => a -> a -> a
    +t
    1) (t
    n t -> Int -> t
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    1)

    getBitSlice :: TreeIter -> Int -> Int -> Word32
    getBitSlice :: TreeIter -> Int -> Int -> Word32
    getBitSlice (TreeIter CInt
    _ Word32
    a Word32
    b Word32
    c) Int
    off 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
    -Int
    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
    -Int
    64) Int
    count

      where getBitSliceWord :: Word32 -> Int -> Int -> Word32
            getBitSliceWord :: Word32 -> Int -> Int -> Word32
    getBitSliceWord Word32
    word Int
    off 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
    .&. (Word32
    1 Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    count Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Word32
    1)

    setBitSlice :: TreeIter -> Int -> Int -> Word32 -> TreeIter
    setBitSlice :: TreeIter -> Int -> Int -> Word32 -> TreeIter
    setBitSlice (TreeIter CInt
    stamp Word32
    a Word32
    b Word32
    c) Int
    off Int
    count Word32
    value =
      Bool -> TreeIter -> TreeIter
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Word32
    value Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word32
    1 Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    count) (TreeIter -> TreeIter) -> TreeIter -> TreeIter
    forall a b. (a -> b) -> a -> b
    $
      CInt -> Word32 -> Word32 -> Word32 -> TreeIter
    TreeIter CInt
    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
    -Int
    32) Int
    count Word32
    value)
               (Word32 -> Int -> Int -> Word32 -> Word32
    setBitSliceWord Word32
    c (Int
    offInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    64) Int
    count Word32
    value)

      where setBitSliceWord :: Word32 -> Int -> Int -> Word32 -> Word32
            setBitSliceWord :: Word32 -> Int -> Int -> Word32 -> Word32
    setBitSliceWord Word32
    word Int
    off Int
    count Word32
    value =
              let mask :: Word32
    mask = (Word32
    1 Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    count Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Word32
    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)

    --iterPrefixEqual :: TreeIter -> TreeIter -> Int -> Bool
    --iterPrefixEqual (TreeIter _ a1 b1 c1) (TreeIter _ a2 b2 c2) pos
    --  | pos>64 = let mask = 1 `shiftL` (pos-64) - 1 in
    --             a1==a2 && b1==b2 && (c1 .&. mask) == (c2 .&. mask)
    --  | pos>32 = let mask = 1 `shiftL` (pos-32) - 1 in
    --             a1==a2 && (b1 .&. mask) == (b2 .&. mask)
    --  | otherwise = let mask = 1 `shiftL` pos - 1 in
    --                (a1 .&. mask) == (a2 .&. mask)

    -- | The invalid tree iterator.
    --
    invalidIter :: TreeIter
    invalidIter :: TreeIter
    invalidIter = CInt -> Word32 -> Word32 -> Word32 -> TreeIter
    TreeIter CInt
    0 Word32
    0 Word32
    0 Word32
    0

    --showIterBits (TreeIter _ a b c) = [showBits a, showBits b, showBits c]
    --
    --showBits :: Bits a => a -> String
    --showBits a = [ if testBit a i then '1' else '0' | i <- [0..bitSize a - 1] ]

    -- | Calculate the maximum number of nodes on a per-level basis.
    --
    calcForestDepth :: Forest a -> Depth
    calcForestDepth :: forall a. Forest a -> Depth
    calcForestDepth 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
    /=Word32
    0) ([Word32] -> [Word32]) -> [Word32] -> [Word32]
    forall a b. (a -> b) -> a -> b
    $
                        (Tree a -> [Word32] -> [Word32])
    -> [Word32] -> Forest a -> [Word32]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Tree a -> [Word32] -> [Word32]
    forall {a} {a}. (Num a, Ord a) => Tree a -> [a] -> [a]
    calcTreeDepth (Word32 -> [Word32]
    forall a. a -> [a]
    repeat Word32
    0) Forest a
    f
      where
      calcTreeDepth :: Tree a -> [a] -> [a]
    calcTreeDepth Node { subForest :: forall a. Tree a -> [Tree a]
    subForest = [Tree a]
    f } (a
    d:[a]
    ds) =
          (a
    da -> a -> a
    forall a. Num a => a -> a -> a
    +a
    1)a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : (a -> a -> a) -> [a] -> [a] -> [a]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith a -> a -> a
    forall a. Ord a => a -> a -> a
    max [a]
    ds ((Tree a -> [a] -> [a]) -> [a] -> [Tree a] -> [a]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Tree a -> [a] -> [a]
    calcTreeDepth (a -> [a]
    forall a. a -> [a]
    repeat a
    0) [Tree a]
    f)

    -- | Convert an iterator into a path.
    --
    toPath :: Depth -> TreeIter -> TreePath
    toPath :: Depth -> TreeIter -> Depth
    toPath Depth
    d TreeIter
    iter = Int -> Depth -> Depth
    forall {a}. Num a => Int -> Depth -> [a]
    gP Int
    0 Depth
    d
      where
      gP :: Int -> Depth -> [a]
    gP Int
    pos [] = []
      gP Int
    pos (Int
    d:Depth
    ds) = let idx :: Word32
    idx = TreeIter -> Int -> Int -> Word32
    getBitSlice TreeIter
    iter Int
    pos Int
    d in
                      if Word32
    idxWord32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Word32
    0 then [] else Word32 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    idxWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    -Word32
    1) a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : Int -> Depth -> [a]
    gP (Int
    posInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    d) Depth
    ds

    -- | Try to convert a path into a 'TreeIter'.
    --
    fromPath :: Depth -> TreePath -> Maybe TreeIter
    fromPath :: Depth -> Depth -> Maybe TreeIter
    fromPath = Int -> TreeIter -> Depth -> Depth -> Maybe TreeIter
    forall {a}.
    Integral a =>
    Int -> TreeIter -> Depth -> [a] -> Maybe TreeIter
    fP Int
    0 TreeIter
    invalidIter
      where
      fP :: Int -> TreeIter -> Depth -> [a] -> Maybe TreeIter
    fP Int
    pos TreeIter
    ti Depth
    _ [] = TreeIter -> Maybe TreeIter
    forall a. a -> Maybe a
    Just TreeIter
    ti -- the remaining bits are zero anyway
      fP Int
    pos TreeIter
    ti [] [a]
    _ = Maybe TreeIter
    forall a. Maybe a
    Nothing
      fP Int
    pos TreeIter
    ti (Int
    d:Depth
    ds) (a
    p:[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
    +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 TreeIter
    forall a. Maybe a
    Nothing else
        Int -> TreeIter -> Depth -> [a] -> Maybe TreeIter
    fP (Int
    posInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    d) (TreeIter -> Int -> Int -> Word32 -> TreeIter
    setBitSlice TreeIter
    ti Int
    pos Int
    d Word32
    idx) Depth
    ds [a]
    ps

    -- | The 'Cache' type synonym is only used iternally. What it represents
    --   the stack during a (fictional) lookup operations.
    --   The topmost frame is the node
    --   for which this lookup was started and the innermost frame (the last
    --   element of the list) contains the root of the tree.
    --
    type Cache a = [(TreeIter, Forest a)]

    -- | Create a traversal structure that allows a pre-order traversal in linear
    --   time.
    --
    -- * The returned structure points at the root of the first level which doesn't
    --   really exist, but serves to indicate that it is before the very first
    --   node.
    --
    storeToCache :: Forest a -> Cache a
    storeToCache :: forall a. Forest a -> Cache a
    storeToCache [] = []
    storeToCache [Tree a]
    forest = [(TreeIter
    invalidIter, [a -> [Tree a] -> Tree a
    forall a. a -> [Tree a] -> Tree a
    Node a
    forall {a}. a
    root [Tree a]
    forest])]
      where
      root :: a
    root = [Char] -> a
    forall a. (?callStack::CallStack) => [Char] -> a
    error [Char]
    "TreeStore.storeToCache: accessed non-exitent root of tree"

    -- | Extract the store from the cache data structure.
    cacheToStore :: Cache a -> Forest a
    cacheToStore :: forall a. Cache a -> Forest a
    cacheToStore [] = []
    cacheToStore [(TreeIter, Forest a)]
    cache = case [(TreeIter, Forest a)] -> (TreeIter, Forest a)
    forall a. (?callStack::CallStack) => [a] -> a
    last [(TreeIter, Forest a)]
    cache of (TreeIter
    _, [Node a
    _ Forest a
    forest]) -> Forest a
    forest

    -- | Advance the traversal structure to the given 'TreeIter'.
    --
    advanceCache :: Depth -> TreeIter -> Cache a -> Cache a
    advanceCache :: forall a. Depth -> TreeIter -> Cache a -> Cache a
    advanceCache Depth
    depth TreeIter
    goal [] = []
    advanceCache Depth
    depth TreeIter
    goal cache :: [(TreeIter, Forest a)]
    cache@((TreeIter
    rootIter,Forest a
    _):[(TreeIter, Forest a)]
    _) =
      Int -> Depth -> [(TreeIter, Forest a)]
    moveToSameLevel Int
    0 Depth
    depth
      where
      moveToSameLevel :: Int -> Depth -> [(TreeIter, Forest a)]
    moveToSameLevel Int
    pos [] = [(TreeIter, Forest a)]
    cache
      moveToSameLevel Int
    pos (Int
    d:Depth
    ds) =
        let
          goalIdx :: Word32
    goalIdx = TreeIter -> Int -> Int -> Word32
    getBitSlice TreeIter
    goal Int
    pos Int
    d
          curIdx :: Word32
    curIdx = TreeIter -> Int -> Int -> Word32
    getBitSlice TreeIter
    rootIter Int
    pos Int
    d
          isNonZero :: Int -> Int -> (TreeIter, b) -> Bool
    isNonZero Int
    pos Int
    d (TreeIter
    ti,b
    _) = TreeIter -> Int -> Int -> Word32
    getBitSlice TreeIter
    ti Int
    pos Int
    dWord32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Word32
    0
        in
        if Word32
    goalIdxWord32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Word32
    curIdx then Int -> Depth -> [(TreeIter, Forest 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
    ==Word32
    0 then ((TreeIter, Forest a) -> Bool)
    -> [(TreeIter, Forest a)] -> [(TreeIter, Forest a)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Int -> Int -> (TreeIter, Forest a) -> Bool
    forall {b}. Int -> Int -> (TreeIter, b) -> Bool
    isNonZero Int
    pos Int
    d) [(TreeIter, Forest a)]
    cache else
        if Word32
    curIdxWord32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Word32
    0 then Int -> Depth -> [(TreeIter, Forest a)] -> [(TreeIter, Forest a)]
    forall a. Int -> Depth -> Cache a -> Cache a
    moveToChild Int
    pos (Int
    dInt -> Depth -> Depth
    forall a. a -> [a] -> [a]
    :Depth
    ds) [(TreeIter, Forest a)]
    cache else
        if Word32
    goalIdxWord32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    <Word32
    curIdx then
          Int -> Depth -> [(TreeIter, Forest a)] -> [(TreeIter, Forest a)]
    forall a. Int -> Depth -> Cache a -> Cache a
    moveToChild Int
    pos (Int
    dInt -> Depth -> Depth
    forall a. a -> [a] -> [a]
    :Depth
    ds) (((TreeIter, Forest a) -> Bool)
    -> [(TreeIter, Forest a)] -> [(TreeIter, Forest a)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Int -> Int -> (TreeIter, Forest a) -> Bool
    forall {b}. Int -> Int -> (TreeIter, b) -> Bool
    isNonZero Int
    pos Int
    d) [(TreeIter, Forest a)]
    cache)
        else let
          -- advance the current iterator to coincide with the goal iterator
          -- at this level
          moveWithinLevel :: Int -> Int -> [(TreeIter, [Tree a])] -> [(TreeIter, [Tree a])]
    moveWithinLevel Int
    pos Int
    d ((TreeIter
    ti,[Tree a]
    forest):[(TreeIter, [Tree 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)
              ([Tree a]
    dropped, [Tree a]
    remain) = Int -> [Tree a] -> ([Tree a], [Tree a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    diff [Tree a]
    forest
              advance :: Int
    advance = [Tree a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Tree a]
    dropped
              ti' :: TreeIter
    ti' = TreeIter -> Int -> Int -> Word32 -> TreeIter
    setBitSlice TreeIter
    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 -> [(TreeIter, [Tree a])] -> [(TreeIter, [Tree 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 ((TreeIter
    ti',[Tree a]
    remain)(TreeIter, [Tree a])
    -> [(TreeIter, [Tree a])] -> [(TreeIter, [Tree a])]
    forall a. a -> [a] -> [a]
    :[(TreeIter, [Tree a])]
    parents)
            else (TreeIter
    ti',[Tree a]
    remain)(TreeIter, [Tree a])
    -> [(TreeIter, [Tree a])] -> [(TreeIter, [Tree a])]
    forall a. a -> [a] -> [a]
    :[(TreeIter, [Tree a])]
    parents -- node not found
        in Int -> Int -> [(TreeIter, Forest a)] -> [(TreeIter, Forest a)]
    forall {a}.
    Int -> Int -> [(TreeIter, [Tree a])] -> [(TreeIter, [Tree a])]
    moveWithinLevel Int
    pos Int
    d ([(TreeIter, Forest a)] -> [(TreeIter, Forest a)])
    -> [(TreeIter, Forest a)] -> [(TreeIter, Forest a)]
    forall a b. (a -> b) -> a -> b
    $ case Depth
    ds of
            [] -> [(TreeIter, Forest a)]
    cache
            (Int
    d':Depth
    _) -> ((TreeIter, Forest a) -> Bool)
    -> [(TreeIter, Forest a)] -> [(TreeIter, Forest a)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Int -> Int -> (TreeIter, Forest a) -> Bool
    forall {b}. Int -> Int -> (TreeIter, b) -> Bool
    isNonZero (Int
    posInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    d) Int
    d') [(TreeIter, Forest a)]
    cache

      -- Descend into the topmost forest to find the goal iterator. The position
      -- and the remainding depths specify the index in the cache that is zero.
      -- All indices in front of pos coincide with that of the goal iterator.
      moveToChild :: Int -> Depth -> Cache a -> Cache a
      moveToChild :: forall a. Int -> Depth -> Cache a -> Cache a
    moveToChild Int
    pos [] Cache a
    cache = Cache a
    cache -- we can't set more than the leaf
      moveToChild Int
    pos (Int
    d:Depth
    ds) cache :: Cache a
    cache@((TreeIter
    ti,Forest a
    forest):Cache a
    parents)
        | TreeIter -> Int -> Int -> Word32
    getBitSlice TreeIter
    goal Int
    pos Int
    d Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    0 = Cache a
    cache
        | Bool
    otherwise = case Forest a
    forest of
          [] -> Cache a
    cache -- impossible request
          Node { subForest :: forall a. Tree a -> [Tree a]
    subForest = Forest a
    children }:Forest a
    _ ->
            let
              childIdx :: Int
              childIdx :: Int
    childIdx = Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (TreeIter -> Int -> Int -> Word32
    getBitSlice TreeIter
    goal Int
    pos Int
    d)Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1
              (Forest a
    dropped, 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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Forest a
    dropped
              ti' :: TreeIter
    ti' = TreeIter -> Int -> Int -> Word32 -> TreeIter
    setBitSlice TreeIter
    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
    +Word32
    1)
            in if Int
    advancedInt -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <Int
    childIdx then ((TreeIter
    ti',Forest a
    remain)(TreeIter, 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 ((TreeIter
    ti',Forest a
    remain)(TreeIter, Forest a) -> Cache a -> Cache a
    forall a. a -> [a] -> [a]
    :Cache a
    cache)

    -- | Advance to the given iterator and return weather this was successful.
    --
    checkSuccess :: Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    checkSuccess :: forall a. Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    checkSuccess Depth
    depth TreeIter
    iter Cache a
    cache = case Depth -> TreeIter -> Cache a -> Cache a
    forall a. Depth -> TreeIter -> Cache a -> Cache a
    advanceCache Depth
    depth TreeIter
    iter Cache a
    cache of
        cache' :: Cache a
    cache'@((TreeIter
    cur,Forest a
    sibs):Cache a
    _) -> (TreeIter -> TreeIter -> Bool
    cmp TreeIter
    cur TreeIter
    iter Bool -> Bool -> Bool
    && Bool -> Bool
    not (Forest a -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Forest a
    sibs), Cache a
    cache')
        [] -> (Bool
    False, [])
      where
      cmp :: TreeIter -> TreeIter -> Bool
    cmp (TreeIter CInt
    _ Word32
    a1 Word32
    b1 Word32
    c1) (TreeIter CInt
    _ Word32
    a2 Word32
    b2 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

    -- | Get the leaf index of this iterator.
    --
    -- * Due to the way we construct the 'TreeIter's, we can check which the last
    --   level of an iterator is: The bit sequence of level n is zero if n is
    --   greater or equal to the level that the iterator refers to. The returned
    --   triple is (pos, leaf, zero) such that pos..pos+leaf denotes the leaf
    --   index and pos+leaf..pos+leaf+zero denotes the bit field that is zero.
    --
    getTreeIterLeaf :: Depth -> TreeIter -> (Int, Int, Int)
    getTreeIterLeaf :: Depth -> TreeIter -> (Int, Int, Int)
    getTreeIterLeaf Depth
    ds TreeIter
    ti = Int -> Int -> Depth -> (Int, Int, Int)
    gTIL Int
    0 Int
    0 Depth
    ds
      where
      gTIL :: Int -> Int -> Depth -> (Int, Int, Int)
    gTIL Int
    pos Int
    dCur (Int
    dNext:Depth
    ds)
        | TreeIter -> Int -> Int -> Word32
    getBitSlice TreeIter
    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
    ==Word32
    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 Int
    pos Int
    d [] = (Int
    pos, Int
    d, Int
    0)

    -- | Move an iterator forwards on the same level.
    --
    iterNext :: Depth -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    iterNext :: forall a. Depth -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    iterNext Depth
    depth TreeIter
    iter Cache a
    cache = let
        (Int
    pos,Int
    leaf,Int
    _child) = Depth -> TreeIter -> (Int, Int, Int)
    getTreeIterLeaf Depth
    depth TreeIter
    iter
        curIdx :: Word32
    curIdx = TreeIter -> Int -> Int -> Word32
    getBitSlice TreeIter
    iter Int
    pos Int
    leaf
        nextIdx :: Word32
    nextIdx = Word32
    curIdxWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +Word32
    1
        nextIter :: TreeIter
    nextIter = TreeIter -> Int -> Int -> Word32 -> TreeIter
    setBitSlice TreeIter
    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 TreeIter
    forall a. Maybe a
    Nothing, Cache a
    cache) else
      case Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    forall a. Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    checkSuccess Depth
    depth TreeIter
    nextIter Cache a
    cache of
        (Bool
    True, Cache a
    cache) -> (TreeIter -> Maybe TreeIter
    forall a. a -> Maybe a
    Just TreeIter
    nextIter, Cache a
    cache)
        (Bool
    False, Cache a
    cache) -> (Maybe TreeIter
    forall a. Maybe a
    Nothing, Cache a
    cache)

    -- | Move down to the child of the given iterator.
    --
    iterNthChild :: Depth -> Int -> TreeIter -> Cache a  ->
                    (Maybe TreeIter, Cache a)
    iterNthChild :: forall a.
    Depth -> Int -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a)
    iterNthChild Depth
    depth Int
    childIdx_ TreeIter
    iter Cache a
    cache = let
        (Int
    pos,Int
    leaf,Int
    child) = Depth -> TreeIter -> (Int, Int, Int)
    getTreeIterLeaf Depth
    depth TreeIter
    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
    +Word32
    1
        nextIter :: TreeIter
    nextIter = TreeIter -> Int -> Int -> Word32 -> TreeIter
    setBitSlice TreeIter
    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 TreeIter
    forall a. Maybe a
    Nothing, Cache a
    cache) else
      case Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    forall a. Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    checkSuccess Depth
    depth TreeIter
    nextIter Cache a
    cache of
        (Bool
    True, Cache a
    cache) -> (TreeIter -> Maybe TreeIter
    forall a. a -> Maybe a
    Just TreeIter
    nextIter, Cache a
    cache)
        (Bool
    False, Cache a
    cache) -> (Maybe TreeIter
    forall a. Maybe a
    Nothing, Cache a
    cache)

    -- | Descend to the first child.
    --
    iterNChildren :: Depth -> TreeIter -> Cache a -> (Int, Cache a)
    iterNChildren :: forall a. Depth -> TreeIter -> Cache a -> (Int, Cache a)
    iterNChildren Depth
    depth TreeIter
    iter Cache a
    cache = case Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    forall a. Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    checkSuccess Depth
    depth TreeIter
    iter Cache a
    cache of
      (Bool
    True, cache :: Cache a
    cache@((TreeIter
    _,Node { subForest :: forall a. Tree a -> [Tree a]
    subForest = Forest a
    forest}:Forest a
    _):Cache a
    _)) -> (Forest a -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Forest a
    forest, Cache a
    cache)
      (Bool
    _, Cache a
    cache) -> (Int
    0, Cache a
    cache)

    -- | Ascend to parent.
    --
    iterParent :: Depth -> TreeIter -> Maybe TreeIter
    iterParent :: Depth -> TreeIter -> Maybe TreeIter
    iterParent Depth
    depth TreeIter
    iter = let
        (Int
    pos,Int
    leaf,Int
    _child) = Depth -> TreeIter -> (Int, Int, Int)
    getTreeIterLeaf Depth
    depth TreeIter
    iter
      in if Int
    posInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    0 then Maybe TreeIter
    forall a. Maybe a
    Nothing else
         if TreeIter -> Int -> Int -> Word32
    getBitSlice TreeIter
    iter Int
    pos Int
    leafWord32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Word32
    0 then Maybe TreeIter
    forall a. Maybe a
    Nothing else
         TreeIter -> Maybe TreeIter
    forall a. a -> Maybe a
    Just (TreeIter -> Int -> Int -> Word32 -> TreeIter
    setBitSlice TreeIter
    iter Int
    pos Int
    leaf Word32
    0)

    -- | Insert nodes into the store.
    --
    -- * The given list of nodes is inserted into given parent at @pos@.
    --   If the parent existed, the function returns @Just path@ where @path@
    --   is the position of the newly inserted elements. If @pos@ is negative
    --   or greater or equal to the number of children of the node at @path@,
    --   the new nodes are appended to the list.
    --
    treeStoreInsertForest ::
        TreeStore a -- ^ the store
     -> TreePath    -- ^ @path@ - the position of the parent
     -> Int         -- ^ @pos@ - the index of the new tree
     -> Forest a    -- ^ the list of trees to be inserted
     -> IO ()
    treeStoreInsertForest :: forall a. TreeStore a -> Depth -> Int -> Forest a -> IO ()
    treeStoreInsertForest (TreeStore CustomStore (IORef (Store a)) a
    model) Depth
    path Int
    pos Forest a
    nodes = do
      CustomStore (IORef (Store a)) a -> IO ()
    forall private row. CustomStore private row -> IO ()
    customStoreInvalidateIters CustomStore (IORef (Store a)) a
    model
      (idx, 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
    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 -> Depth -> Int -> Maybe (Forest a, Int, Bool)
    forall a.
    Forest a -> Forest a -> Depth -> Int -> Maybe (Forest a, Int, Bool)
    insertIntoForest (Cache a -> Forest a
    forall a. Cache a -> Forest a
    cacheToStore Cache a
    cache) Forest a
    nodes Depth
    path Int
    pos of
          Maybe (Forest a, Int, Bool)
    Nothing -> [Char] -> (Store a, (Int, Bool))
    forall a. (?callStack::CallStack) => [Char] -> a
    error ([Char]
    "treeStoreInsertForest: path does not exist " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Depth -> [Char]
    forall a. Show a => a -> [Char]
    show Depth
    path)
          Just (Forest a
    newForest, Int
    idx, Bool
    toggle) ->
           let depth :: Depth
    depth = Forest a -> Depth
    forall a. Forest a -> Depth
    calcForestDepth Forest a
    newForest
            in (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 = depth } <- readIORef (customStoreGetPrivate model)
      let rpath = Depth -> Depth
    forall a. [a] -> [a]
    reverse Depth
    path
      stamp <- customStoreGetStamp model
      sequence_ [ let p' = Depth -> Depth
    forall a. [a] -> [a]
    reverse Depth
    p
                      Just iter = fromPath depth p'
                   in treeModelRowInserted model p' (treeIterSetStamp iter stamp)
                | (i, node) <- zip [idx..] nodes
                , p <- paths (i : rpath) node ]
      let Just iter = fromPath depth path
      when toggle $ treeModelRowHasChildToggled model path
                    (treeIterSetStamp iter stamp)

      where paths :: TreePath -> Tree a -> [TreePath]
            paths :: forall a. Depth -> Tree a -> [Depth]
    paths Depth
    path Node { subForest :: forall a. Tree a -> [Tree a]
    subForest = [Tree a]
    ts } =
              Depth
    path Depth -> [Depth] -> [Depth]
    forall a. a -> [a] -> [a]
    : [[Depth]] -> [Depth]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ Depth -> Tree a -> [Depth]
    forall a. Depth -> Tree a -> [Depth]
    paths (Int
    nInt -> Depth -> Depth
    forall a. a -> [a] -> [a]
    :Depth
    path) Tree a
    t | (Int
    n, Tree a
    t) <- Depth -> [Tree a] -> [(Int, Tree a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [Tree a]
    ts ]

    -- | Insert a node into the store.
    --
    treeStoreInsertTree ::
        TreeStore a -- ^ the store
     -> TreePath    -- ^ @path@ - the position of the parent
     -> Int         -- ^ @pos@ - the index of the new tree
     -> Tree a      -- ^ the value to be inserted
     -> IO ()
    treeStoreInsertTree :: forall a. TreeStore a -> Depth -> Int -> Tree a -> IO ()
    treeStoreInsertTree TreeStore a
    store Depth
    path Int
    pos Tree a
    node =
      TreeStore a -> Depth -> Int -> Forest a -> IO ()
    forall a. TreeStore a -> Depth -> Int -> Forest a -> IO ()
    treeStoreInsertForest TreeStore a
    store Depth
    path Int
    pos [Tree a
    node]

    -- | Insert a single node into the store.
    --
    -- * This function inserts a single node without children into the tree.
    --   Its arguments are similar to those of 'treeStoreInsert'.
    --
    treeStoreInsert ::
        TreeStore a -- ^ the store
     -> TreePath    -- ^ @path@ - the position of the parent
     -> Int         -- ^ @pos@ - the index of the new tree
     -> a           -- ^ the value to be inserted
     -> IO ()
    treeStoreInsert :: forall a. TreeStore a -> Depth -> Int -> a -> IO ()
    treeStoreInsert TreeStore a
    store Depth
    path Int
    pos a
    node =
      TreeStore a -> Depth -> Int -> Forest a -> IO ()
    forall a. TreeStore a -> Depth -> Int -> Forest a -> IO ()
    treeStoreInsertForest TreeStore a
    store Depth
    path Int
    pos [a -> Forest a -> Tree a
    forall a. a -> [Tree a] -> Tree a
    Node a
    node []]

    -- | Insert nodes into a forest.
    --
    -- * If the parent was found, returns the new tree, the child number
    --   and a flag denoting if these new nodes were the first children
    --   of the parent.
    --
    insertIntoForest :: Forest a -> Forest a -> TreePath -> Int ->
                        Maybe (Forest a, Int, Bool)
    insertIntoForest :: forall a.
    Forest a -> Forest a -> Depth -> Int -> Maybe (Forest a, Int, Bool)
    insertIntoForest Forest a
    forest Forest a
    nodes [] Int
    pos
      | Int
    posInt -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <Int
    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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Forest a
    forest, Forest a -> Bool
    forall a. [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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Forest a
    prev, Forest a -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Forest a
    forest)
        where (Forest a
    prev, Forest a
    next) = Int -> Forest a -> (Forest a, Forest a)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    pos Forest a
    forest
    insertIntoForest Forest a
    forest Forest a
    nodes (Int
    p:Depth
    ps) Int
    pos = case Int -> Forest a -> (Forest a, Forest a)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    p Forest a
    forest of
      (Forest a
    prev, []) -> Maybe (Forest a, Int, Bool)
    forall a. Maybe a
    Nothing
      (Forest a
    prev, Node { rootLabel :: forall a. Tree a -> a
    rootLabel = a
    val,
                    subForest :: forall a. Tree a -> [Tree a]
    subForest = Forest a
    for}:Forest a
    next) ->
        case Forest a -> Forest a -> Depth -> Int -> Maybe (Forest a, Int, Bool)
    forall a.
    Forest a -> Forest a -> Depth -> Int -> Maybe (Forest a, Int, Bool)
    insertIntoForest Forest a
    for Forest a
    nodes Depth
    ps Int
    pos of
          Maybe (Forest a, Int, Bool)
    Nothing -> Maybe (Forest a, Int, Bool)
    forall a. Maybe a
    Nothing
          Just (Forest a
    for, Int
    pos, 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 { 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)

    -- | Remove a node from the store.
    --
    -- * The node denoted by the path is removed, along with all its children.
    --   The function returns @True@ if the given node was found.
    --
    treeStoreRemove :: TreeStore a -> TreePath -> IO Bool
      --TODO: eliminate this special case without segfaulting!
    treeStoreRemove :: forall a. TreeStore a -> Depth -> IO Bool
    treeStoreRemove (TreeStore CustomStore (IORef (Store a)) a
    model) [] = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
    treeStoreRemove (TreeStore CustomStore (IORef (Store a)) a
    model) Depth
    path = do
      CustomStore (IORef (Store a)) a -> IO ()
    forall private row. CustomStore private row -> IO ()
    customStoreInvalidateIters CustomStore (IORef (Store a)) a
    model
      (found, 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 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 a. [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 -> Depth -> Maybe (Forest a, Bool)
    forall a. Forest a -> Depth -> Maybe (Forest a, Bool)
    deleteFromForest (Cache a -> Forest a
    forall a. Cache a -> Forest a
    cacheToStore Cache a
    cache) Depth
    path of
          Maybe (Forest a, Bool)
    Nothing -> (Store a
    store, (Bool
    False, Bool
    False))
          Just (Forest a
    newForest, Bool
    toggle) ->
            (Store { depth :: Depth
    depth = Depth
    d, -- this might be a space leak
                     content :: Cache a
    content = Forest a -> Cache a
    forall a. Forest a -> Cache a
    storeToCache Forest a
    newForest }, (Bool
    True, Bool
    toggle))
      when found $ do
        when (toggle && not (null path)) $ do
          Store { depth = depth } <- readIORef (customStoreGetPrivate model)
          let parent = Depth -> Depth
    forall a. (?callStack::CallStack) => [a] -> [a]
    init Depth
    path
              Just iter = fromPath depth parent
          treeModelRowHasChildToggled model parent iter
        treeModelRowDeleted model path
      return found

    treeStoreClear :: TreeStore a -> IO ()
    treeStoreClear :: forall a. TreeStore a -> IO ()
    treeStoreClear (TreeStore CustomStore (IORef (Store a)) a
    model) = do
      CustomStore (IORef (Store a)) a -> IO ()
    forall private row. CustomStore private row -> IO ()
    customStoreInvalidateIters CustomStore (IORef (Store a)) a
    model
      Store { content = 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 CustomStore (IORef (Store a)) a
    model)
      let forest = Cache a -> Forest a
    forall a. Cache a -> Forest a
    cacheToStore Cache a
    cache
      writeIORef (customStoreGetPrivate model) Store {
          depth = calcForestDepth [],
          content = storeToCache []
        }
      let loop (-1) = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          loop   Int
    n  = CustomStore (IORef (Store a)) a -> Depth -> IO ()
    forall self. TreeModelClass self => self -> Depth -> IO ()
    treeModelRowDeleted CustomStore (IORef (Store a)) a
    model [Int
    n] IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    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
    -Int
    1)
      loop (length forest - 1)

    -- | Remove a node from a rose tree.
    --
    -- * Returns the new tree if the node was found. The returned flag is
    --   @True@ if deleting the node left the parent without any children.
    --
    deleteFromForest :: Forest a -> TreePath -> Maybe (Forest a, Bool)
    deleteFromForest :: forall a. Forest a -> Depth -> Maybe (Forest a, Bool)
    deleteFromForest Forest a
    forest [] = (Forest a, Bool) -> Maybe (Forest a, Bool)
    forall a. a -> Maybe a
    Just ([], Bool
    False)
    deleteFromForest Forest a
    forest (Int
    p:Depth
    ps) =
      case Int -> Forest a -> (Forest a, Forest a)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    p Forest a
    forest of
        (Forest a
    prev, kill :: Tree a
    kill@Node { rootLabel :: forall a. Tree a -> a
    rootLabel = a
    val,
                           subForest :: forall a. Tree a -> [Tree a]
    subForest = Forest a
    for}:Forest a
    next) ->
          if Depth -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Depth
    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 a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Forest a
    prev Bool -> Bool -> Bool
    && Forest a -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Forest a
    next) else
          case Forest a -> Depth -> Maybe (Forest a, Bool)
    forall a. Forest a -> Depth -> Maybe (Forest a, Bool)
    deleteFromForest Forest a
    for Depth
    ps of
            Maybe (Forest a, Bool)
    Nothing -> Maybe (Forest a, Bool)
    forall a. Maybe a
    Nothing
            Just (Forest a
    for,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 {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)
        (Forest a
    prev, []) -> Maybe (Forest a, Bool)
    forall a. Maybe a
    Nothing

    -- | Set a node in the store.
    --
    treeStoreSetValue :: TreeStore a -> TreePath -> a -> IO ()
    treeStoreSetValue :: forall a. TreeStore a -> Depth -> a -> IO ()
    treeStoreSetValue TreeStore a
    store Depth
    path a
    value = TreeStore a -> Depth -> (a -> IO a) -> IO Bool
    forall a. TreeStore a -> Depth -> (a -> IO a) -> IO Bool
    treeStoreChangeM TreeStore a
    store Depth
    path (\a
    _ -> a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    value)
                                      IO Bool -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Change a node in the store.
    --
    -- * Returns @True@ if the node was found. For a monadic version, see
    --   'treeStoreChangeM'.
    --
    treeStoreChange :: TreeStore a -> TreePath -> (a -> a) -> IO Bool
    treeStoreChange :: forall a. TreeStore a -> Depth -> (a -> a) -> IO Bool
    treeStoreChange TreeStore a
    store Depth
    path a -> a
    func = TreeStore a -> Depth -> (a -> IO a) -> IO Bool
    forall a. TreeStore a -> Depth -> (a -> IO a) -> IO Bool
    treeStoreChangeM TreeStore a
    store Depth
    path (a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> IO a) -> (a -> a) -> a -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> a
    func)

    -- | Change a node in the store.
    --
    -- * Returns @True@ if the node was found. For a purely functional version, see
    --   'treeStoreChange'.
    --
    treeStoreChangeM :: TreeStore a -> TreePath -> (a -> IO a) -> IO Bool
    treeStoreChangeM :: forall a. TreeStore a -> Depth -> (a -> IO a) -> IO Bool
    treeStoreChangeM (TreeStore CustomStore (IORef (Store a)) a
    model) Depth
    path a -> IO a
    act = do
      CustomStore (IORef (Store a)) a -> IO ()
    forall private row. CustomStore private row -> IO ()
    customStoreInvalidateIters CustomStore (IORef (Store a)) a
    model
      store@Store { depth = d, content = 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 CustomStore (IORef (Store a)) a
    model)
      (store'@Store { depth = d, content = cache }, found) <- do
        mRes <- changeForest (cacheToStore cache) act path
        return $ case mRes of
          Maybe (Forest a)
    Nothing -> (Store a
    store, Bool
    False)
          Just Forest a
    newForest -> (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)
      writeIORef (customStoreGetPrivate model) store'
      let Just iter = fromPath d path
      stamp <- customStoreGetStamp model
      when found $ treeModelRowChanged model path (treeIterSetStamp iter stamp)
      return found

    -- | Change a node in the forest.
    --
    -- * Returns @True@ if the given node was found.
    --
    changeForest :: Forest a -> (a -> IO a) -> TreePath -> IO (Maybe (Forest a))
    changeForest :: forall a. Forest a -> (a -> IO a) -> Depth -> IO (Maybe (Forest a))
    changeForest Forest a
    forest a -> IO a
    act [] = Maybe (Forest a) -> IO (Maybe (Forest a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Forest a)
    forall a. Maybe a
    Nothing
    changeForest Forest a
    forest a -> IO a
    act (Int
    p:Depth
    ps) = case Int -> Forest a -> (Forest a, Forest a)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    p Forest a
    forest of
      (Forest a
    prev, []) -> Maybe (Forest a) -> IO (Maybe (Forest a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Forest a)
    forall a. Maybe a
    Nothing
      (Forest a
    prev, Node { rootLabel :: forall a. Tree a -> a
    rootLabel = a
    val,
                    subForest :: forall a. Tree a -> [Tree a]
    subForest = Forest a
    for}:Forest a
    next) ->
        if Depth -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Depth
    ps then do
          val' <- a -> IO a
    act a
    val
          return (Just (prev++Node { rootLabel = val',
                                     subForest = for }:next))
        else do
          mFor <- Forest a -> (a -> IO a) -> Depth -> IO (Maybe (Forest a))
    forall a. Forest a -> (a -> IO a) -> Depth -> IO (Maybe (Forest a))
    changeForest Forest a
    for a -> IO a
    act Depth
    ps
          case mFor of
            Maybe (Forest a)
    Nothing -> Maybe (Forest a) -> IO (Maybe (Forest a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Forest a)
    forall a. Maybe a
    Nothing
            Just Forest a
    for -> Maybe (Forest a) -> IO (Maybe (Forest a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Forest a) -> IO (Maybe (Forest a)))
    -> Maybe (Forest a) -> IO (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 { 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)

    -- | Extract one node from the current model. Fails if the given
    --   'TreePath' refers to a non-existent node.
    --
    treeStoreGetValue :: TreeStore a -> TreePath -> IO a
    treeStoreGetValue :: forall a. TreeStore a -> Depth -> IO a
    treeStoreGetValue TreeStore a
    model Depth
    path = (Tree a -> a) -> IO (Tree a) -> IO a
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Tree a -> a
    forall a. Tree a -> a
    rootLabel (TreeStore a -> Depth -> IO (Tree a)
    forall a. TreeStore a -> Depth -> IO (Tree a)
    treeStoreGetTree TreeStore a
    model Depth
    path)

    -- | Extract a subtree from the current model. Fails if the given
    --   'TreePath' refers to a non-existent node.
    --
    treeStoreGetTree :: TreeStore a -> TreePath -> IO (Tree a)
    treeStoreGetTree :: forall a. TreeStore a -> Depth -> IO (Tree a)
    treeStoreGetTree (TreeStore CustomStore (IORef (Store a)) a
    model) Depth
    path = do
      store@Store { depth = d, content = 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 CustomStore (IORef (Store a)) a
    model)
      case fromPath d path of
        (Just TreeIter
    iter) -> do
          let (Bool
    res, Cache a
    cache') = Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    forall a. Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    checkSuccess Depth
    d TreeIter
    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 CustomStore (IORef (Store a)) a
    model) Store a
    store { content = cache' }
          case Cache a
    cache' of
            ((TreeIter
    _,Tree a
    node:Forest a
    _):Cache a
    _) | Bool
    res -> Tree a -> IO (Tree a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Tree a
    node
            Cache a
    _ -> [Char] -> IO (Tree a)
    forall a. [Char] -> IO a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "treeStoreGetTree: path does not exist " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Depth -> [Char]
    forall a. Show a => a -> [Char]
    show Depth
    path)
        Maybe TreeIter
    _ -> [Char] -> IO (Tree a)
    forall a. [Char] -> IO a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "treeStoreGetTree: path does not exist " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Depth -> [Char]
    forall a. Show a => a -> [Char]
    show Depth
    path)

    -- | Extract a subtree from the current model. Like 'treeStoreGetTree'
    --   but returns @Nothing@ if the path refers to a non-existent node.
    --
    treeStoreLookup :: TreeStore a -> TreePath -> IO (Maybe (Tree a))
    treeStoreLookup :: forall a. TreeStore a -> Depth -> IO (Maybe (Tree a))
    treeStoreLookup (TreeStore CustomStore (IORef (Store a)) a
    model) Depth
    path = do
      store@Store { depth = d, content = 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 CustomStore (IORef (Store a)) a
    model)
      case fromPath d path of
        (Just TreeIter
    iter) -> do
          let (Bool
    res, Cache a
    cache') = Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    forall a. Depth -> TreeIter -> Cache a -> (Bool, Cache a)
    checkSuccess Depth
    d TreeIter
    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 CustomStore (IORef (Store a)) a
    model) Store a
    store { content = cache' }
          case Cache a
    cache' of
            ((TreeIter
    _,Tree a
    node:Forest a
    _):Cache a
    _) | Bool
    res -> Maybe (Tree a) -> IO (Maybe (Tree a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tree a -> Maybe (Tree a)
    forall a. a -> Maybe a
    Just Tree a
    node)
            Cache a
    _ -> Maybe (Tree a) -> IO (Maybe (Tree a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Tree a)
    forall a. Maybe a
    Nothing
        Maybe TreeIter
    _ -> Maybe (Tree a) -> IO (Maybe (Tree a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Tree a)
    forall a. Maybe a
    Nothing