{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

module Cursor.Forest
  ( ForestCursor (..),
    singletonForestCursor,
    makeForestCursor,
    rebuildForestCursor,
    drawForestCursor,
    mapForestCursor,
    forestCursorListCursorL,
    forestCursorSelectedTreeL,
    forestCursorSelectPrevTreeCursor,
    forestCursorSelectNextTreeCursor,
    forestCursorSelectFirstTreeCursor,
    forestCursorSelectLastTreeCursor,
    forestCursorSelectPrev,
    forestCursorSelectNext,
    forestCursorSelectPrevOnSameLevel,
    forestCursorSelectNextOnSameLevel,
    forestCursorSelectFirst,
    forestCursorSelectLast,
    forestCursorSelectFirstOnSameLevel,
    forestCursorSelectLastOnSameLevel,
    forestCursorSelectAbove,
    forestCursorSelectBelowAtPos,
    forestCursorSelectBelowAtStart,
    forestCursorSelectBelowAtEnd,
    forestCursorSelection,
    forestCursorSelectIndex,
    forestCursorOpenCurrentForest,
    forestCursorCloseCurrentForest,
    forestCursorToggleCurrentForest,
    forestCursorOpenCurrentForestRecursively,
    forestCursorToggleCurrentForestRecursively,
    forestCursorInsertEntireTree,
    forestCursorAppendEntireTree,
    forestCursorInsertAndSelectTreeCursor,
    forestCursorAppendAndSelectTreeCursor,
    forestCursorInsertTree,
    forestCursorAppendTree,
    forestCursorInsertAndSelectTree,
    forestCursorAppendAndSelectTree,
    forestCursorInsert,
    forestCursorAppend,
    forestCursorInsertAndSelect,
    forestCursorAppendAndSelect,
    forestCursorInsertNodeSingleAndSelect,
    forestCursorAppendNodeSingleAndSelect,
    forestCursorInsertNodeAndSelect,
    forestCursorAppendNodeAndSelect,
    forestCursorAddChildTreeToNodeAtPos,
    forestCursorAddChildTreeToNodeAtStart,
    forestCursorAddChildTreeToNodeAtEnd,
    forestCursorAddChildToNodeAtPos,
    forestCursorAddChildToNodeAtStart,
    forestCursorAddChildToNodeAtEnd,
    forestCursorAddChildTreeToNodeAtPosAndSelect,
    forestCursorAddChildTreeToNodeAtStartAndSelect,
    forestCursorAddChildTreeToNodeAtEndAndSelect,
    forestCursorAddChildToNodeAtPosAndSelect,
    forestCursorAddChildToNodeAtStartAndSelect,
    forestCursorAddChildToNodeAtEndAndSelect,
    forestCursorAddChildNodeSingleToNodeAtPosAndSelect,
    forestCursorAddChildNodeSingleToNodeAtStartAndSelect,
    forestCursorAddChildNodeSingleToNodeAtEndAndSelect,
    forestCursorAddChildNodeToNodeAtPosAndSelect,
    forestCursorAddChildNodeToNodeAtStartAndSelect,
    forestCursorAddChildNodeToNodeAtEndAndSelect,
    forestCursorRemoveElemAndSelectPrev,
    forestCursorDeleteElemAndSelectNext,
    forestCursorRemoveElem,
    forestCursorDeleteElem,
    forestCursorRemoveSubTreeAndSelectPrev,
    forestCursorDeleteSubTreeAndSelectNext,
    forestCursorRemoveSubTree,
    forestCursorDeleteSubTree,
    forestCursorAddRoot,
    forestCursorSwapPrev,
    forestCursorSwapNext,
    forestCursorPromoteElem,
    forestCursorPromoteSubTree,
    forestCursorDemoteElem,
    forestCursorDemoteSubTree,
    forestCursorDemoteElemUnder,
    forestCursorDemoteSubTreeUnder,
    CTree (..),
    makeCTree,
    cTree,
    rebuildCTree,
    CForest (..),
    makeCForest,
    cForest,
    rebuildCForest,
    traverseForestCursor,
    foldForestCursor,
  )
where

import Control.Applicative
import Control.DeepSeq
import Cursor.List.NonEmpty
import Cursor.Tree
import Cursor.Types
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe
import Data.Tree
import Data.Validity
import Data.Validity.Tree ()
import GHC.Generics (Generic)
import Lens.Micro

newtype ForestCursor a b = ForestCursor
  { ForestCursor a b -> NonEmptyCursor (TreeCursor a b) (CTree b)
forestCursorListCursor :: NonEmptyCursor (TreeCursor a b) (CTree b)
  }
  deriving (Int -> ForestCursor a b -> ShowS
[ForestCursor a b] -> ShowS
ForestCursor a b -> String
(Int -> ForestCursor a b -> ShowS)
-> (ForestCursor a b -> String)
-> ([ForestCursor a b] -> ShowS)
-> Show (ForestCursor a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show b, Show a) => Int -> ForestCursor a b -> ShowS
forall a b. (Show b, Show a) => [ForestCursor a b] -> ShowS
forall a b. (Show b, Show a) => ForestCursor a b -> String
showList :: [ForestCursor a b] -> ShowS
$cshowList :: forall a b. (Show b, Show a) => [ForestCursor a b] -> ShowS
show :: ForestCursor a b -> String
$cshow :: forall a b. (Show b, Show a) => ForestCursor a b -> String
showsPrec :: Int -> ForestCursor a b -> ShowS
$cshowsPrec :: forall a b. (Show b, Show a) => Int -> ForestCursor a b -> ShowS
Show, ForestCursor a b -> ForestCursor a b -> Bool
(ForestCursor a b -> ForestCursor a b -> Bool)
-> (ForestCursor a b -> ForestCursor a b -> Bool)
-> Eq (ForestCursor a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq b, Eq a) =>
ForestCursor a b -> ForestCursor a b -> Bool
/= :: ForestCursor a b -> ForestCursor a b -> Bool
$c/= :: forall a b.
(Eq b, Eq a) =>
ForestCursor a b -> ForestCursor a b -> Bool
== :: ForestCursor a b -> ForestCursor a b -> Bool
$c== :: forall a b.
(Eq b, Eq a) =>
ForestCursor a b -> ForestCursor a b -> Bool
Eq, (forall x. ForestCursor a b -> Rep (ForestCursor a b) x)
-> (forall x. Rep (ForestCursor a b) x -> ForestCursor a b)
-> Generic (ForestCursor a b)
forall x. Rep (ForestCursor a b) x -> ForestCursor a b
forall x. ForestCursor a b -> Rep (ForestCursor a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (ForestCursor a b) x -> ForestCursor a b
forall a b x. ForestCursor a b -> Rep (ForestCursor a b) x
$cto :: forall a b x. Rep (ForestCursor a b) x -> ForestCursor a b
$cfrom :: forall a b x. ForestCursor a b -> Rep (ForestCursor a b) x
Generic)

instance (Validity a, Validity b) => Validity (ForestCursor a b)

instance (NFData a, NFData b) => NFData (ForestCursor a b)

singletonForestCursor :: a -> ForestCursor a b
singletonForestCursor :: a -> ForestCursor a b
singletonForestCursor = NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b.
NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
ForestCursor (NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b)
-> (a -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> a
-> ForestCursor a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeCursor a b -> NonEmptyCursor (TreeCursor a b) (CTree b)
forall a b. a -> NonEmptyCursor a b
singletonNonEmptyCursor (TreeCursor a b -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> (a -> TreeCursor a b)
-> a
-> NonEmptyCursor (TreeCursor a b) (CTree b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TreeCursor a b
forall a b. a -> TreeCursor a b
singletonTreeCursor

makeForestCursor :: (b -> a) -> NonEmpty (CTree b) -> ForestCursor a b
makeForestCursor :: (b -> a) -> NonEmpty (CTree b) -> ForestCursor a b
makeForestCursor b -> a
g = NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b.
NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
ForestCursor (NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b)
-> (NonEmpty (CTree b)
    -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> NonEmpty (CTree b)
-> ForestCursor a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CTree b -> TreeCursor a b)
-> NonEmpty (CTree b) -> NonEmptyCursor (TreeCursor a b) (CTree b)
forall b a. (b -> a) -> NonEmpty b -> NonEmptyCursor a b
makeNonEmptyCursor ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g)

rebuildForestCursor :: (a -> b) -> ForestCursor a b -> NonEmpty (CTree b)
rebuildForestCursor :: (a -> b) -> ForestCursor a b -> NonEmpty (CTree b)
rebuildForestCursor a -> b
f = (TreeCursor a b -> CTree b)
-> NonEmptyCursor (TreeCursor a b) (CTree b) -> NonEmpty (CTree b)
forall a b. (a -> b) -> NonEmptyCursor a b -> NonEmpty b
rebuildNonEmptyCursor ((a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f) (NonEmptyCursor (TreeCursor a b) (CTree b) -> NonEmpty (CTree b))
-> (ForestCursor a b -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> ForestCursor a b
-> NonEmpty (CTree b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForestCursor a b -> NonEmptyCursor (TreeCursor a b) (CTree b)
forall a b.
ForestCursor a b -> NonEmptyCursor (TreeCursor a b) (CTree b)
forestCursorListCursor

drawForestCursor :: (Show a, Show b) => ForestCursor a b -> String
drawForestCursor :: ForestCursor a b -> String
drawForestCursor ForestCursor {NonEmptyCursor (TreeCursor a b) (CTree b)
forestCursorListCursor :: NonEmptyCursor (TreeCursor a b) (CTree b)
forestCursorListCursor :: forall a b.
ForestCursor a b -> NonEmptyCursor (TreeCursor a b) (CTree b)
..} =
  Forest String -> String
drawForest (Forest String -> String) -> Forest String -> String
forall a b. (a -> b) -> a -> b
$
    (CTree b -> Tree String) -> [CTree b] -> Forest String
forall a b. (a -> b) -> [a] -> [b]
map CTree b -> Tree String
forall a. Show a => CTree a -> Tree String
showCTree ([CTree b] -> [CTree b]
forall a. [a] -> [a]
reverse ([CTree b] -> [CTree b]) -> [CTree b] -> [CTree b]
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor (TreeCursor a b) (CTree b)
forestCursorListCursor)
      Forest String -> Forest String -> Forest String
forall a. [a] -> [a] -> [a]
++ [TreeCursor a b -> Tree String
forall a b. (Show a, Show b) => TreeCursor a b -> Tree String
treeCursorWithPointer (TreeCursor a b -> Tree String) -> TreeCursor a b -> Tree String
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor (TreeCursor a b) (CTree b) -> TreeCursor a b
forall a b. NonEmptyCursor a b -> a
nonEmptyCursorCurrent NonEmptyCursor (TreeCursor a b) (CTree b)
forestCursorListCursor]
      Forest String -> Forest String -> Forest String
forall a. [a] -> [a] -> [a]
++ (CTree b -> Tree String) -> [CTree b] -> Forest String
forall a b. (a -> b) -> [a] -> [b]
map CTree b -> Tree String
forall a. Show a => CTree a -> Tree String
showCTree (NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor (TreeCursor a b) (CTree b)
forestCursorListCursor)

mapForestCursor :: (a -> c) -> (b -> d) -> ForestCursor a b -> ForestCursor c d
mapForestCursor :: (a -> c) -> (b -> d) -> ForestCursor a b -> ForestCursor c d
mapForestCursor a -> c
f b -> d
g = (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> Identity (NonEmptyCursor (TreeCursor c d) (CTree d)))
-> ForestCursor a b -> Identity (ForestCursor c d)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((NonEmptyCursor (TreeCursor a b) (CTree b)
  -> Identity (NonEmptyCursor (TreeCursor c d) (CTree d)))
 -> ForestCursor a b -> Identity (ForestCursor c d))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> NonEmptyCursor (TreeCursor c d) (CTree d))
-> ForestCursor a b
-> ForestCursor c d
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TreeCursor a b -> TreeCursor c d)
-> (CTree b -> CTree d)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> NonEmptyCursor (TreeCursor c d) (CTree d)
forall a c b d.
(a -> c) -> (b -> d) -> NonEmptyCursor a b -> NonEmptyCursor c d
mapNonEmptyCursor ((a -> c) -> (b -> d) -> TreeCursor a b -> TreeCursor c d
forall a c b d.
(a -> c) -> (b -> d) -> TreeCursor a b -> TreeCursor c d
mapTreeCursor a -> c
f b -> d
g) ((b -> d) -> CTree b -> CTree d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> d
g)

forestCursorListCursorL ::
  Lens (ForestCursor a b) (ForestCursor c d) (NonEmptyCursor (TreeCursor a b) (CTree b)) (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL :: (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> f (NonEmptyCursor (TreeCursor c d) (CTree d)))
-> ForestCursor a b -> f (ForestCursor c d)
forestCursorListCursorL = (ForestCursor a b -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> (ForestCursor a b
    -> NonEmptyCursor (TreeCursor c d) (CTree d) -> ForestCursor c d)
-> Lens
     (ForestCursor a b)
     (ForestCursor c d)
     (NonEmptyCursor (TreeCursor a b) (CTree b))
     (NonEmptyCursor (TreeCursor c d) (CTree d))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ForestCursor a b -> NonEmptyCursor (TreeCursor a b) (CTree b)
forall a b.
ForestCursor a b -> NonEmptyCursor (TreeCursor a b) (CTree b)
forestCursorListCursor ((ForestCursor a b
  -> NonEmptyCursor (TreeCursor c d) (CTree d) -> ForestCursor c d)
 -> Lens
      (ForestCursor a b)
      (ForestCursor c d)
      (NonEmptyCursor (TreeCursor a b) (CTree b))
      (NonEmptyCursor (TreeCursor c d) (CTree d)))
-> (ForestCursor a b
    -> NonEmptyCursor (TreeCursor c d) (CTree d) -> ForestCursor c d)
-> Lens
     (ForestCursor a b)
     (ForestCursor c d)
     (NonEmptyCursor (TreeCursor a b) (CTree b))
     (NonEmptyCursor (TreeCursor c d) (CTree d))
forall a b. (a -> b) -> a -> b
$ \ForestCursor a b
fc NonEmptyCursor (TreeCursor c d) (CTree d)
lc -> ForestCursor a b
fc {forestCursorListCursor :: NonEmptyCursor (TreeCursor c d) (CTree d)
forestCursorListCursor = NonEmptyCursor (TreeCursor c d) (CTree d)
lc}

forestCursorSelectedTreeL :: Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL :: (TreeCursor a b -> f (TreeCursor a b))
-> ForestCursor a b -> f (ForestCursor a b)
forestCursorSelectedTreeL = (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> f (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> f (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((NonEmptyCursor (TreeCursor a b) (CTree b)
  -> f (NonEmptyCursor (TreeCursor a b) (CTree b)))
 -> ForestCursor a b -> f (ForestCursor a b))
-> ((TreeCursor a b -> f (TreeCursor a b))
    -> NonEmptyCursor (TreeCursor a b) (CTree b)
    -> f (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> (TreeCursor a b -> f (TreeCursor a b))
-> ForestCursor a b
-> f (ForestCursor a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TreeCursor a b -> f (TreeCursor a b))
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> f (NonEmptyCursor (TreeCursor a b) (CTree b))
forall a c b. Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b
nonEmptyCursorElemL

forestCursorSelectPrevTreeCursor ::
  (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrevTreeCursor :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrevTreeCursor a -> b
f b -> a
g =
  (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> Maybe (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((NonEmptyCursor (TreeCursor a b) (CTree b)
  -> Maybe (NonEmptyCursor (TreeCursor a b) (CTree b)))
 -> ForestCursor a b -> Maybe (ForestCursor a b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> Maybe (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b
-> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$ (TreeCursor a b -> CTree b)
-> (CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> Maybe (NonEmptyCursor (TreeCursor a b) (CTree b))
forall a b.
(a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectPrev ((a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f) ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g)

forestCursorSelectNextTreeCursor ::
  (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNextTreeCursor :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNextTreeCursor a -> b
f b -> a
g =
  (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> Maybe (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((NonEmptyCursor (TreeCursor a b) (CTree b)
  -> Maybe (NonEmptyCursor (TreeCursor a b) (CTree b)))
 -> ForestCursor a b -> Maybe (ForestCursor a b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> Maybe (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b
-> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$ (TreeCursor a b -> CTree b)
-> (CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> Maybe (NonEmptyCursor (TreeCursor a b) (CTree b))
forall a b.
(a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectNext ((a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f) ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g)

forestCursorSelectFirstTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectFirstTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectFirstTreeCursor a -> b
f b -> a
g =
  (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((NonEmptyCursor (TreeCursor a b) (CTree b)
  -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TreeCursor a b -> CTree b)
-> (CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
forall a b.
(a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectFirst ((a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f) ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g)

forestCursorSelectLastTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectLastTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectLastTreeCursor a -> b
f b -> a
g =
  (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((NonEmptyCursor (TreeCursor a b) (CTree b)
  -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TreeCursor a b -> CTree b)
-> (CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
forall a b.
(a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectLast ((a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f) ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g)

forestCursorSelectNext :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNext :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNext a -> b
f b -> a
g ForestCursor a b
fc =
  (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> Maybe (ForestCursor a b))
-> Maybe (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorSelectNext a -> b
f b -> a
g))
    Maybe (ForestCursor a b)
-> Maybe (ForestCursor a b) -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNextTreeCursor a -> b
f b -> a
g ForestCursor a b
fc

forestCursorSelectPrev :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrev :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrev a -> b
f b -> a
g ForestCursor a b
fc =
  (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> Maybe (ForestCursor a b))
-> Maybe (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorSelectPrev a -> b
f b -> a
g))
    Maybe (ForestCursor a b)
-> Maybe (ForestCursor a b) -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrevTreeCursor a -> b
f b -> a
g ForestCursor a b
fc
            Maybe (ForestCursor a b)
-> (ForestCursor a b -> Maybe (ForestCursor a b))
-> Maybe (ForestCursor a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorSelectBelowAtEndRecursively a -> b
f b -> a
g)
        )
    Maybe (ForestCursor a b)
-> Maybe (ForestCursor a b) -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrevTreeCursor a -> b
f b -> a
g ForestCursor a b
fc

forestCursorSelectNextOnSameLevel ::
  (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNextOnSameLevel :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNextOnSameLevel a -> b
f b -> a
g ForestCursor a b
fc =
  (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> Maybe (ForestCursor a b))
-> Maybe (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorSelectNextOnSameLevel a -> b
f b -> a
g))
    Maybe (ForestCursor a b)
-> Maybe (ForestCursor a b) -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNextTreeCursor a -> b
f b -> a
g ForestCursor a b
fc

forestCursorSelectPrevOnSameLevel ::
  (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrevOnSameLevel :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrevOnSameLevel a -> b
f b -> a
g ForestCursor a b
fc =
  (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> Maybe (ForestCursor a b))
-> Maybe (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorSelectPrevOnSameLevel a -> b
f b -> a
g))
    Maybe (ForestCursor a b)
-> Maybe (ForestCursor a b) -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrevTreeCursor a -> b
f b -> a
g ForestCursor a b
fc

forestCursorSelectLastOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectLastOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectLastOnSameLevel a -> b
f b -> a
g ForestCursor a b
fc =
  case (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNextOnSameLevel a -> b
f b -> a
g ForestCursor a b
fc of
    Maybe (ForestCursor a b)
Nothing -> ForestCursor a b
fc
    Just ForestCursor a b
fc' -> (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectLastOnSameLevel a -> b
f b -> a
g ForestCursor a b
fc'

forestCursorSelectFirstOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectFirstOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectFirstOnSameLevel a -> b
f b -> a
g ForestCursor a b
fc =
  case (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrevOnSameLevel a -> b
f b -> a
g ForestCursor a b
fc of
    Maybe (ForestCursor a b)
Nothing -> ForestCursor a b
fc
    Just ForestCursor a b
fc' -> (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectLastOnSameLevel a -> b
f b -> a
g ForestCursor a b
fc'

forestCursorSelectFirst :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectFirst :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectFirst a -> b
f b -> a
g ForestCursor a b
fc =
  case (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrevTreeCursor a -> b
f b -> a
g ForestCursor a b
fc of
    Just ForestCursor a b
fc' -> (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectFirst a -> b
f b -> a
g ForestCursor a b
fc'
    Maybe (ForestCursor a b)
Nothing ->
      case (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectPrev a -> b
f b -> a
g ForestCursor a b
fc of
        Just ForestCursor a b
fc' -> (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectFirst a -> b
f b -> a
g ForestCursor a b
fc'
        Maybe (ForestCursor a b)
Nothing -> ForestCursor a b
fc

forestCursorSelectLast :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectLast :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectLast a -> b
f b -> a
g ForestCursor a b
fc =
  case (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNextTreeCursor a -> b
f b -> a
g ForestCursor a b
fc of
    Just ForestCursor a b
fc' -> (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectLast a -> b
f b -> a
g ForestCursor a b
fc'
    Maybe (ForestCursor a b)
Nothing ->
      case (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectNext a -> b
f b -> a
g ForestCursor a b
fc of
        Just ForestCursor a b
fc' -> (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
forestCursorSelectLast a -> b
f b -> a
g ForestCursor a b
fc'
        Maybe (ForestCursor a b)
Nothing -> ForestCursor a b
fc

forestCursorSelectAbove :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectAbove :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectAbove a -> b
f b -> a
g = (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Maybe (TreeCursor a b))
 -> ForestCursor a b -> Maybe (ForestCursor a b))
-> (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b
-> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorSelectAbove a -> b
f b -> a
g

forestCursorSelectBelowAtPos ::
  (a -> b) -> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectBelowAtPos :: (a -> b)
-> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectBelowAtPos a -> b
f b -> a
g Int
i = (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Maybe (TreeCursor a b))
 -> ForestCursor a b -> Maybe (ForestCursor a b))
-> (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b
-> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> (b -> a) -> Int -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> Int -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorSelectBelowAtPos a -> b
f b -> a
g Int
i

forestCursorSelectBelowAtStart ::
  (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectBelowAtStart :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectBelowAtStart a -> b
f b -> a
g = (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Maybe (TreeCursor a b))
 -> ForestCursor a b -> Maybe (ForestCursor a b))
-> (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b
-> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorSelectBelowAtStart a -> b
f b -> a
g

forestCursorSelectBelowAtEnd :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectBelowAtEnd :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectBelowAtEnd a -> b
f b -> a
g = (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Maybe (TreeCursor a b))
 -> ForestCursor a b -> Maybe (ForestCursor a b))
-> (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b
-> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorSelectBelowAtEnd a -> b
f b -> a
g

forestCursorSelection :: ForestCursor a b -> Int
forestCursorSelection :: ForestCursor a b -> Int
forestCursorSelection ForestCursor a b
fc = NonEmptyCursor (TreeCursor a b) (CTree b) -> Int
forall a b. NonEmptyCursor a b -> Int
nonEmptyCursorSelection (NonEmptyCursor (TreeCursor a b) (CTree b) -> Int)
-> NonEmptyCursor (TreeCursor a b) (CTree b) -> Int
forall a b. (a -> b) -> a -> b
$ ForestCursor a b
fc ForestCursor a b
-> Getting
     (NonEmptyCursor (TreeCursor a b) (CTree b))
     (ForestCursor a b)
     (NonEmptyCursor (TreeCursor a b) (CTree b))
-> NonEmptyCursor (TreeCursor a b) (CTree b)
forall s a. s -> Getting a s a -> a
^. Getting
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (ForestCursor a b)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL

forestCursorSelectIndex ::
  (a -> b) -> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectIndex :: (a -> b)
-> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSelectIndex a -> b
f b -> a
g Int
i =
  (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> Maybe (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((TreeCursor a b -> CTree b)
-> (CTree b -> TreeCursor a b)
-> Int
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> Maybe (NonEmptyCursor (TreeCursor a b) (CTree b))
forall a b.
(a -> b)
-> (b -> a)
-> Int
-> NonEmptyCursor a b
-> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectIndex ((a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f) ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g) Int
i)

forestCursorOpenCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorOpenCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorOpenCurrentForest = (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL TreeCursor a b -> Maybe (TreeCursor a b)
forall a b. TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorOpenCurrentForest

forestCursorCloseCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorCloseCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorCloseCurrentForest = (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL TreeCursor a b -> Maybe (TreeCursor a b)
forall a b. TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorCloseCurrentForest

forestCursorToggleCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorToggleCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorToggleCurrentForest = (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL TreeCursor a b -> Maybe (TreeCursor a b)
forall a b. TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorToggleCurrentForest

forestCursorOpenCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorOpenCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorOpenCurrentForestRecursively =
  (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL TreeCursor a b -> Maybe (TreeCursor a b)
forall a b. TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorOpenCurrentForestRecursively

forestCursorToggleCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorToggleCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorToggleCurrentForestRecursively =
  (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL TreeCursor a b -> Maybe (TreeCursor a b)
forall a b. TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorToggleCurrentForestRecursively

forestCursorInsertEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertEntireTree Tree b
t = (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((NonEmptyCursor (TreeCursor a b) (CTree b)
  -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CTree b
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
forall b a. b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsert (Tree b -> CTree b
forall a. Tree a -> CTree a
makeCTree Tree b
t)

forestCursorInsertAndSelectTreeCursor ::
  (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertAndSelectTreeCursor :: (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertAndSelectTreeCursor a -> b
f TreeCursor a b
tc =
  (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((NonEmptyCursor (TreeCursor a b) (CTree b)
  -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TreeCursor a b -> CTree b)
-> TreeCursor a b
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
forall a b.
(a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsertAndSelect ((a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f) TreeCursor a b
tc

forestCursorAppendEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendEntireTree Tree b
t = (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((NonEmptyCursor (TreeCursor a b) (CTree b)
  -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CTree b
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
forall b a. b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppend (Tree b -> CTree b
forall a. Tree a -> CTree a
makeCTree Tree b
t)

forestCursorAppendAndSelectTreeCursor ::
  (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendAndSelectTreeCursor :: (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendAndSelectTreeCursor a -> b
f TreeCursor a b
tc =
  (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((NonEmptyCursor (TreeCursor a b) (CTree b)
  -> Identity (NonEmptyCursor (TreeCursor a b) (CTree b)))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> NonEmptyCursor (TreeCursor a b) (CTree b))
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TreeCursor a b -> CTree b)
-> TreeCursor a b
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
forall a b.
(a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppendAndSelect ((a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f) TreeCursor a b
tc

forestCursorInsertTree :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertTree :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertTree Tree b
t ForestCursor a b
fc =
  ForestCursor a b -> Maybe (ForestCursor a b) -> ForestCursor a b
forall a. a -> Maybe a -> a
fromMaybe (Tree b -> ForestCursor a b -> ForestCursor a b
forall b a. Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertEntireTree Tree b
t ForestCursor a b
fc) (Maybe (ForestCursor a b) -> ForestCursor a b)
-> Maybe (ForestCursor a b) -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$
    ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> Maybe (ForestCursor a b))
-> Maybe (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL (Tree b -> TreeCursor a b -> Maybe (TreeCursor a b)
forall b a. Tree b -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorInsert Tree b
t)

forestCursorInsertAndSelectTree ::
  (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertAndSelectTree :: (a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertAndSelectTree a -> b
f b -> a
g (Node b
value Forest b
forest) =
  (a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertNodeAndSelect a -> b
f (b -> a
g b
value) (Forest b -> CForest b
forall a. Forest a -> CForest a
makeCForest Forest b
forest)

forestCursorAppendTree :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendTree :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendTree Tree b
t ForestCursor a b
fc =
  ForestCursor a b -> Maybe (ForestCursor a b) -> ForestCursor a b
forall a. a -> Maybe a -> a
fromMaybe (Tree b -> ForestCursor a b -> ForestCursor a b
forall b a. Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendEntireTree Tree b
t ForestCursor a b
fc) (Maybe (ForestCursor a b) -> ForestCursor a b)
-> Maybe (ForestCursor a b) -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$
    ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> Maybe (ForestCursor a b))
-> Maybe (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL (Tree b -> TreeCursor a b -> Maybe (TreeCursor a b)
forall b a. Tree b -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorAppend Tree b
t)

forestCursorAppendAndSelectTree ::
  (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendAndSelectTree :: (a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendAndSelectTree a -> b
f b -> a
g (Node b
value Forest b
forest) =
  (a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendNodeAndSelect a -> b
f (b -> a
g b
value) (Forest b -> CForest b
forall a. Forest a -> CForest a
makeCForest Forest b
forest)

forestCursorInsert :: b -> ForestCursor a b -> ForestCursor a b
forestCursorInsert :: b -> ForestCursor a b -> ForestCursor a b
forestCursorInsert b
b = Tree b -> ForestCursor a b -> ForestCursor a b
forall b a. Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertTree (Tree b -> ForestCursor a b -> ForestCursor a b)
-> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$ b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b []

forestCursorInsertAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertAndSelect a -> b
f b -> a
g b
b = (a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertAndSelectTree a -> b
f b -> a
g (Tree b -> ForestCursor a b -> ForestCursor a b)
-> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$ b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b []

forestCursorInsertNodeSingleAndSelect :: (a -> b) -> a -> ForestCursor a b -> ForestCursor a b
forestCursorInsertNodeSingleAndSelect :: (a -> b) -> a -> ForestCursor a b -> ForestCursor a b
forestCursorInsertNodeSingleAndSelect a -> b
f a
value = (a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertNodeAndSelect a -> b
f a
value CForest b
forall a. CForest a
EmptyCForest

forestCursorInsertNodeAndSelect :: (a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertNodeAndSelect :: (a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertNodeAndSelect a -> b
f a
value CForest b
forest ForestCursor a b
fc =
  ForestCursor a b -> Maybe (ForestCursor a b) -> ForestCursor a b
forall a. a -> Maybe a -> a
fromMaybe ((a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b
forestCursorInsertAndSelectTreeCursor a -> b
f (a -> CForest b -> TreeCursor a b
forall a b. a -> CForest b -> TreeCursor a b
makeNodeTreeCursor a
value CForest b
forest) ForestCursor a b
fc) (Maybe (ForestCursor a b) -> ForestCursor a b)
-> Maybe (ForestCursor a b) -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$
    ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> Maybe (ForestCursor a b))
-> Maybe (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b)
-> a -> CForest b -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b)
-> a -> CForest b -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorInsertNodeAndSelect a -> b
f a
value CForest b
forest)

forestCursorAppend :: b -> ForestCursor a b -> ForestCursor a b
forestCursorAppend :: b -> ForestCursor a b -> ForestCursor a b
forestCursorAppend b
b = Tree b -> ForestCursor a b -> ForestCursor a b
forall b a. Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendTree (Tree b -> ForestCursor a b -> ForestCursor a b)
-> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$ b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b []

forestCursorAppendAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendAndSelect a -> b
f b -> a
g b
b = (a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendAndSelectTree a -> b
f b -> a
g (Tree b -> ForestCursor a b -> ForestCursor a b)
-> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$ b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b []

forestCursorAppendNodeSingleAndSelect :: (a -> b) -> a -> ForestCursor a b -> ForestCursor a b
forestCursorAppendNodeSingleAndSelect :: (a -> b) -> a -> ForestCursor a b -> ForestCursor a b
forestCursorAppendNodeSingleAndSelect a -> b
f a
value = (a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendNodeAndSelect a -> b
f a
value CForest b
forall a. CForest a
EmptyCForest

forestCursorAppendNodeAndSelect :: (a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendNodeAndSelect :: (a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendNodeAndSelect a -> b
f a
value CForest b
forest ForestCursor a b
fc =
  ForestCursor a b -> Maybe (ForestCursor a b) -> ForestCursor a b
forall a. a -> Maybe a -> a
fromMaybe ((a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b
forestCursorAppendAndSelectTreeCursor a -> b
f (a -> CForest b -> TreeCursor a b
forall a b. a -> CForest b -> TreeCursor a b
makeNodeTreeCursor a
value CForest b
forest) ForestCursor a b
fc) (Maybe (ForestCursor a b) -> ForestCursor a b)
-> Maybe (ForestCursor a b) -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$
    ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> Maybe (ForestCursor a b))
-> Maybe (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b)
-> a -> CForest b -> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b.
(a -> b)
-> a -> CForest b -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorAppendNodeAndSelect a -> b
f a
value CForest b
forest)

forestCursorAddChildTreeToNodeAtPos :: Int -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtPos :: Int -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtPos Int
i Tree b
t = (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Tree b -> TreeCursor a b -> TreeCursor a b
forall b a. Int -> Tree b -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildAtPos Int
i Tree b
t

forestCursorAddChildTreeToNodeAtStart :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtStart :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtStart Tree b
t = (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Tree b -> TreeCursor a b -> TreeCursor a b
forall b a. Tree b -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildAtStart Tree b
t

forestCursorAddChildTreeToNodeAtEnd :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtEnd :: Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtEnd Tree b
t ForestCursor a b
fc =
  ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> ForestCursor a b) -> ForestCursor a b
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Tree b -> TreeCursor a b -> TreeCursor a b
forall b a. Tree b -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildAtEnd Tree b
t

forestCursorAddChildToNodeAtPos :: Int -> b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtPos :: Int -> b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtPos Int
i b
b = Int -> Tree b -> ForestCursor a b -> ForestCursor a b
forall b a. Int -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtPos Int
i (Tree b -> ForestCursor a b -> ForestCursor a b)
-> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$ b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b []

forestCursorAddChildToNodeAtStart :: b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtStart :: b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtStart b
b = Tree b -> ForestCursor a b -> ForestCursor a b
forall b a. Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtStart (Tree b -> ForestCursor a b -> ForestCursor a b)
-> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$ b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b []

forestCursorAddChildToNodeAtEnd :: b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtEnd :: b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtEnd b
b = Tree b -> ForestCursor a b -> ForestCursor a b
forall b a. Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtEnd (Tree b -> ForestCursor a b -> ForestCursor a b)
-> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$ b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b []

forestCursorAddChildTreeToNodeAtPosAndSelect ::
  (a -> b) -> (b -> a) -> Int -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtPosAndSelect :: (a -> b)
-> (b -> a)
-> Int
-> Tree b
-> ForestCursor a b
-> ForestCursor a b
forestCursorAddChildTreeToNodeAtPosAndSelect a -> b
f b -> a
g Int
i Tree b
t =
  (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a -> b)
-> (b -> a) -> Int -> Tree b -> TreeCursor a b -> TreeCursor a b
forall a b.
(a -> b)
-> (b -> a) -> Int -> Tree b -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildAtPosAndSelect a -> b
f b -> a
g Int
i Tree b
t

forestCursorAddChildTreeToNodeAtStartAndSelect ::
  (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtStartAndSelect :: (a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtStartAndSelect a -> b
f b -> a
g Tree b
t =
  (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a -> b) -> (b -> a) -> Tree b -> TreeCursor a b -> TreeCursor a b
forall a b.
(a -> b) -> (b -> a) -> Tree b -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildAtStartAndSelect a -> b
f b -> a
g Tree b
t

forestCursorAddChildTreeToNodeAtEndAndSelect ::
  (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtEndAndSelect :: (a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtEndAndSelect a -> b
f b -> a
g Tree b
t ForestCursor a b
fc =
  ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> ForestCursor a b) -> ForestCursor a b
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a -> b) -> (b -> a) -> Tree b -> TreeCursor a b -> TreeCursor a b
forall a b.
(a -> b) -> (b -> a) -> Tree b -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildAtEndAndSelect a -> b
f b -> a
g Tree b
t

forestCursorAddChildToNodeAtPosAndSelect ::
  (a -> b) -> (b -> a) -> Int -> b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtPosAndSelect :: (a -> b)
-> (b -> a) -> Int -> b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtPosAndSelect a -> b
f b -> a
g Int
i b
b =
  (a -> b)
-> (b -> a)
-> Int
-> Tree b
-> ForestCursor a b
-> ForestCursor a b
forall a b.
(a -> b)
-> (b -> a)
-> Int
-> Tree b
-> ForestCursor a b
-> ForestCursor a b
forestCursorAddChildTreeToNodeAtPosAndSelect a -> b
f b -> a
g Int
i (Tree b -> ForestCursor a b -> ForestCursor a b)
-> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$ b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b []

forestCursorAddChildToNodeAtStartAndSelect ::
  (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtStartAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtStartAndSelect a -> b
f b -> a
g b
b =
  (a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtStartAndSelect a -> b
f b -> a
g (Tree b -> ForestCursor a b -> ForestCursor a b)
-> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$ b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b []

forestCursorAddChildToNodeAtEndAndSelect ::
  (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtEndAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildToNodeAtEndAndSelect a -> b
f b -> a
g b
b =
  (a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b.
(a -> b)
-> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildTreeToNodeAtEndAndSelect a -> b
f b -> a
g (Tree b -> ForestCursor a b -> ForestCursor a b)
-> Tree b -> ForestCursor a b -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$ b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b []

forestCursorAddChildNodeSingleToNodeAtPosAndSelect ::
  (a -> b) -> Int -> a -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeSingleToNodeAtPosAndSelect :: (a -> b) -> Int -> a -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeSingleToNodeAtPosAndSelect a -> b
f Int
i a
t = (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a -> b) -> Int -> a -> TreeCursor a b -> TreeCursor a b
forall a b.
(a -> b) -> Int -> a -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildNodeSingleAtPosAndSelect a -> b
f Int
i a
t

forestCursorAddChildNodeSingleToNodeAtStartAndSelect ::
  (a -> b) -> a -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeSingleToNodeAtStartAndSelect :: (a -> b) -> a -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeSingleToNodeAtStartAndSelect a -> b
f a
t = (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a -> b) -> a -> TreeCursor a b -> TreeCursor a b
forall a b. (a -> b) -> a -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildNodeSingleAtStartAndSelect a -> b
f a
t

forestCursorAddChildNodeSingleToNodeAtEndAndSelect ::
  (a -> b) -> a -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeSingleToNodeAtEndAndSelect :: (a -> b) -> a -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeSingleToNodeAtEndAndSelect a -> b
f a
t = (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a -> b) -> a -> TreeCursor a b -> TreeCursor a b
forall a b. (a -> b) -> a -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildNodeSingleAtEndAndSelect a -> b
f a
t

forestCursorAddChildNodeToNodeAtPosAndSelect ::
  (a -> b) -> Int -> a -> Forest b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeToNodeAtPosAndSelect :: (a -> b)
-> Int -> a -> Forest b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeToNodeAtPosAndSelect a -> b
f Int
i a
t Forest b
ts = (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a -> b)
-> Int -> a -> Forest b -> TreeCursor a b -> TreeCursor a b
forall a b.
(a -> b)
-> Int -> a -> Forest b -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildNodeAtPosAndSelect a -> b
f Int
i a
t Forest b
ts

forestCursorAddChildNodeToNodeAtStartAndSelect ::
  (a -> b) -> a -> Forest b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeToNodeAtStartAndSelect :: (a -> b) -> a -> Forest b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeToNodeAtStartAndSelect a -> b
f a
t Forest b
ts = (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a -> b) -> a -> Forest b -> TreeCursor a b -> TreeCursor a b
forall a b.
(a -> b) -> a -> Forest b -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildNodeAtStartAndSelect a -> b
f a
t Forest b
ts

forestCursorAddChildNodeToNodeAtEndAndSelect ::
  (a -> b) -> a -> Forest b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeToNodeAtEndAndSelect :: (a -> b) -> a -> Forest b -> ForestCursor a b -> ForestCursor a b
forestCursorAddChildNodeToNodeAtEndAndSelect a -> b
f a
t Forest b
ts = (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a -> b) -> a -> Forest b -> TreeCursor a b -> TreeCursor a b
forall a b.
(a -> b) -> a -> Forest b -> TreeCursor a b -> TreeCursor a b
treeCursorAddChildNodeAtEndAndSelect a -> b
f a
t Forest b
ts

forestCursorRemoveElemAndSelectPrev ::
  (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
forestCursorRemoveElemAndSelectPrev :: (b -> a)
-> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
forestCursorRemoveElemAndSelectPrev b -> a
g ForestCursor a b
fc =
  case ForestCursor a b
fc
    ForestCursor a b
-> (ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall a b. a -> (a -> b) -> b
& Lens' (ForestCursor a b) (TreeCursor a b)
-> (TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b)))
-> ForestCursor a b
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate
      forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL
      ((b -> a)
-> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))
forall b a.
(b -> a)
-> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))
treeCursorDeleteElemAndSelectPrevious b -> a
g) of
    Just DeleteOrUpdate (ForestCursor a b)
Deleted ->
      ForestCursor a b
fc
        ForestCursor a b
-> (ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall a b. a -> (a -> b) -> b
& Lens'
  (ForestCursor a b) (NonEmptyCursor (TreeCursor a b) (CTree b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> Maybe
         (DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b))))
-> ForestCursor a b
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate
          forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
Lens'
  (ForestCursor a b) (NonEmptyCursor (TreeCursor a b) (CTree b))
forestCursorListCursorL
          ((CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> Maybe
     (DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b)))
forall b a.
(b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorRemoveElemAndSelectPrev ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g))
    Maybe (DeleteOrUpdate (ForestCursor a b))
r -> Maybe (DeleteOrUpdate (ForestCursor a b))
r

forestCursorDeleteElemAndSelectNext ::
  (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
forestCursorDeleteElemAndSelectNext :: (b -> a)
-> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
forestCursorDeleteElemAndSelectNext b -> a
g ForestCursor a b
fc =
  case ForestCursor a b
fc
    ForestCursor a b
-> (ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall a b. a -> (a -> b) -> b
& Lens' (ForestCursor a b) (TreeCursor a b)
-> (TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b)))
-> ForestCursor a b
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((b -> a)
-> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))
forall b a.
(b -> a)
-> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))
treeCursorDeleteElemAndSelectNext b -> a
g) of
    Just DeleteOrUpdate (ForestCursor a b)
Deleted ->
      ForestCursor a b
fc
        ForestCursor a b
-> (ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall a b. a -> (a -> b) -> b
& Lens'
  (ForestCursor a b) (NonEmptyCursor (TreeCursor a b) (CTree b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> Maybe
         (DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b))))
-> ForestCursor a b
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate
          forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
Lens'
  (ForestCursor a b) (NonEmptyCursor (TreeCursor a b) (CTree b))
forestCursorListCursorL
          ((CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> Maybe
     (DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b)))
forall b a.
(b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorDeleteElemAndSelectNext ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g))
    Maybe (DeleteOrUpdate (ForestCursor a b))
r -> Maybe (DeleteOrUpdate (ForestCursor a b))
r

forestCursorRemoveElem :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forestCursorRemoveElem :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forestCursorRemoveElem b -> a
g ForestCursor a b
fc =
  (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> DeleteOrUpdate (ForestCursor a b))
-> DeleteOrUpdate (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> DeleteOrUpdate (TreeCursor a b))
-> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
forall b a.
(b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
treeCursorRemoveElem b -> a
g))
    DeleteOrUpdate (ForestCursor a b)
-> DeleteOrUpdate (ForestCursor a b)
-> DeleteOrUpdate (ForestCursor a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> DeleteOrUpdate (ForestCursor a b))
-> DeleteOrUpdate (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b))
forall b a.
(b -> a)
-> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
nonEmptyCursorRemoveElem ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g)))

forestCursorDeleteElem :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forestCursorDeleteElem :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forestCursorDeleteElem b -> a
g ForestCursor a b
fc =
  (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> DeleteOrUpdate (ForestCursor a b))
-> DeleteOrUpdate (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> DeleteOrUpdate (TreeCursor a b))
-> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
forall b a.
(b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
treeCursorDeleteElem b -> a
g))
    DeleteOrUpdate (ForestCursor a b)
-> DeleteOrUpdate (ForestCursor a b)
-> DeleteOrUpdate (ForestCursor a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> DeleteOrUpdate (ForestCursor a b))
-> DeleteOrUpdate (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b))
forall b a.
(b -> a)
-> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
nonEmptyCursorDeleteElem ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g)))

forestCursorRemoveSubTreeAndSelectPrev ::
  (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
forestCursorRemoveSubTreeAndSelectPrev :: (b -> a)
-> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
forestCursorRemoveSubTreeAndSelectPrev b -> a
g ForestCursor a b
fc =
  Maybe (DeleteOrUpdate (ForestCursor a b))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall a.
Maybe (DeleteOrUpdate a)
-> Maybe (DeleteOrUpdate a) -> Maybe (DeleteOrUpdate a)
joinPossibleDeletes
    ( ForestCursor a b
fc
        ForestCursor a b
-> (ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall a b. a -> (a -> b) -> b
& Lens' (ForestCursor a b) (TreeCursor a b)
-> (TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b)))
-> ForestCursor a b
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate
          forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL
          ((b -> a)
-> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))
forall b a.
(b -> a)
-> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))
treeCursorDeleteSubTreeAndSelectPrevious b -> a
g)
    )
    ( ForestCursor a b
fc
        ForestCursor a b
-> (ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall a b. a -> (a -> b) -> b
& Lens'
  (ForestCursor a b) (NonEmptyCursor (TreeCursor a b) (CTree b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> Maybe
         (DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b))))
-> ForestCursor a b
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate
          forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
Lens'
  (ForestCursor a b) (NonEmptyCursor (TreeCursor a b) (CTree b))
forestCursorListCursorL
          ((CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> Maybe
     (DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b)))
forall b a.
(b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorRemoveElemAndSelectPrev ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g))
    )

forestCursorDeleteSubTreeAndSelectNext ::
  (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
forestCursorDeleteSubTreeAndSelectNext :: (b -> a)
-> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
forestCursorDeleteSubTreeAndSelectNext b -> a
g ForestCursor a b
fc =
  Maybe (DeleteOrUpdate (ForestCursor a b))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall a.
Maybe (DeleteOrUpdate a)
-> Maybe (DeleteOrUpdate a) -> Maybe (DeleteOrUpdate a)
joinPossibleDeletes
    ( ForestCursor a b
fc
        ForestCursor a b
-> (ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall a b. a -> (a -> b) -> b
& Lens' (ForestCursor a b) (TreeCursor a b)
-> (TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b)))
-> ForestCursor a b
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((b -> a)
-> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))
forall b a.
(b -> a)
-> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))
treeCursorDeleteSubTreeAndSelectNext b -> a
g)
    )
    ( ForestCursor a b
fc
        ForestCursor a b
-> (ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)))
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall a b. a -> (a -> b) -> b
& Lens'
  (ForestCursor a b) (NonEmptyCursor (TreeCursor a b) (CTree b))
-> (NonEmptyCursor (TreeCursor a b) (CTree b)
    -> Maybe
         (DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b))))
-> ForestCursor a b
-> Maybe (DeleteOrUpdate (ForestCursor a b))
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate
          forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
Lens'
  (ForestCursor a b) (NonEmptyCursor (TreeCursor a b) (CTree b))
forestCursorListCursorL
          ((CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> Maybe
     (DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b)))
forall b a.
(b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorDeleteElemAndSelectNext ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g))
    )

forestCursorRemoveSubTree :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forestCursorRemoveSubTree :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forestCursorRemoveSubTree b -> a
g ForestCursor a b
fc =
  (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> DeleteOrUpdate (ForestCursor a b))
-> DeleteOrUpdate (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> DeleteOrUpdate (TreeCursor a b))
-> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
forall b a.
(b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
treeCursorRemoveSubTree b -> a
g))
    DeleteOrUpdate (ForestCursor a b)
-> DeleteOrUpdate (ForestCursor a b)
-> DeleteOrUpdate (ForestCursor a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> DeleteOrUpdate (ForestCursor a b))
-> DeleteOrUpdate (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b))
forall b a.
(b -> a)
-> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
nonEmptyCursorRemoveElem ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g)))

forestCursorDeleteSubTree :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forestCursorDeleteSubTree :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forestCursorDeleteSubTree b -> a
g ForestCursor a b
fc =
  (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> DeleteOrUpdate (ForestCursor a b))
-> DeleteOrUpdate (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> DeleteOrUpdate (TreeCursor a b))
-> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
forall b a.
(b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
treeCursorDeleteSubTree b -> a
g))
    DeleteOrUpdate (ForestCursor a b)
-> DeleteOrUpdate (ForestCursor a b)
-> DeleteOrUpdate (ForestCursor a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> DeleteOrUpdate (ForestCursor a b))
-> DeleteOrUpdate (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (NonEmptyCursor (TreeCursor a b) (CTree b)
 -> DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b)))
-> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
forall a b c d.
Lens
  (ForestCursor a b)
  (ForestCursor c d)
  (NonEmptyCursor (TreeCursor a b) (CTree b))
  (NonEmptyCursor (TreeCursor c d) (CTree d))
forestCursorListCursorL ((CTree b -> TreeCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b)
-> DeleteOrUpdate (NonEmptyCursor (TreeCursor a b) (CTree b))
forall b a.
(b -> a)
-> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
nonEmptyCursorDeleteElem ((b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g)))

forestCursorAddRoot :: (a -> b) -> (b -> a) -> ForestCursor a b -> a -> TreeCursor a b
forestCursorAddRoot :: (a -> b) -> (b -> a) -> ForestCursor a b -> a -> TreeCursor a b
forestCursorAddRoot a -> b
f b -> a
g ForestCursor a b
fc a
v =
  (b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g (CTree b -> TreeCursor a b) -> CTree b -> TreeCursor a b
forall a b. (a -> b) -> a -> b
$ b -> CForest b -> CTree b
forall a. a -> CForest a -> CTree a
CNode (a -> b
f a
v) (CForest b -> CTree b) -> CForest b -> CTree b
forall a b. (a -> b) -> a -> b
$ NonEmpty (CTree b) -> CForest b
forall a. NonEmpty (CTree a) -> CForest a
OpenForest (NonEmpty (CTree b) -> CForest b)
-> NonEmpty (CTree b) -> CForest b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> ForestCursor a b -> NonEmpty (CTree b)
forall a b. (a -> b) -> ForestCursor a b -> NonEmpty (CTree b)
rebuildForestCursor a -> b
f ForestCursor a b
fc

-- | Swaps the current node with the previous node on the same level
--
-- Example:
--
-- Before:
--
-- > - a
-- > - b <--
--
-- After:
--
-- > - b <--
-- > - a
forestCursorSwapPrev :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSwapPrev :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSwapPrev fc :: ForestCursor a b
fc@(ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne) =
  case ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> SwapResult (ForestCursor a b))
-> SwapResult (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> SwapResult (TreeCursor a b))
-> ForestCursor a b -> SwapResult (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL TreeCursor a b -> SwapResult (TreeCursor a b)
forall a b. TreeCursor a b -> SwapResult (TreeCursor a b)
treeCursorSwapPrev of
    Swapped ForestCursor a b
fc' -> ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForestCursor a b
fc'
    SwapResult (ForestCursor a b)
NoSiblingsToSwapWith -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing
    SwapResult (ForestCursor a b)
SwapperIsTopNode ->
      case NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor (TreeCursor a b) (CTree b)
ne of
        [] -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing
        (CTree b
t : [CTree b]
ts) ->
          ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForestCursor a b -> Maybe (ForestCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$
            NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b.
NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne {nonEmptyCursorPrev :: [CTree b]
nonEmptyCursorPrev = [CTree b]
ts, nonEmptyCursorNext :: [CTree b]
nonEmptyCursorNext = CTree b
t CTree b -> [CTree b] -> [CTree b]
forall a. a -> [a] -> [a]
: NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor (TreeCursor a b) (CTree b)
ne}

-- | Swaps the current node with the next node on the same level
--
-- Example:
--
-- Before:
--
-- > - a <--
-- > - b
--
-- After:
--
-- > - b
-- > - a <--
forestCursorSwapNext :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSwapNext :: ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorSwapNext fc :: ForestCursor a b
fc@(ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne) =
  case ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> SwapResult (ForestCursor a b))
-> SwapResult (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> SwapResult (TreeCursor a b))
-> ForestCursor a b -> SwapResult (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL TreeCursor a b -> SwapResult (TreeCursor a b)
forall a b. TreeCursor a b -> SwapResult (TreeCursor a b)
treeCursorSwapNext of
    Swapped ForestCursor a b
fc' -> ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForestCursor a b
fc'
    SwapResult (ForestCursor a b)
NoSiblingsToSwapWith -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing
    SwapResult (ForestCursor a b)
SwapperIsTopNode ->
      case NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor (TreeCursor a b) (CTree b)
ne of
        [] -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing
        (CTree b
t : [CTree b]
ts) ->
          ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForestCursor a b -> Maybe (ForestCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$
            NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b.
NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne {nonEmptyCursorPrev :: [CTree b]
nonEmptyCursorPrev = CTree b
t CTree b -> [CTree b] -> [CTree b]
forall a. a -> [a] -> [a]
: NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor (TreeCursor a b) (CTree b)
ne, nonEmptyCursorNext :: [CTree b]
nonEmptyCursorNext = [CTree b]
ts}

-- | Promotes the current node to the level of its parent.
--
-- Example:
--
-- Before:
--
-- > - a
-- >   |- b
-- >   |  |- c
-- >   |- d <--
-- >   |  |- e
-- >   |- f
-- >      |- g
-- > - h
--
-- After:
--
-- > - a
-- >   |- b
-- >   |  |- c
-- >   |  |- e
-- >   |- f
-- >      |- g
-- > - d <--
-- > - h
forestCursorPromoteElem :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorPromoteElem :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorPromoteElem a -> b
f b -> a
g fc :: ForestCursor a b
fc@(ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne) =
  case ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> PromoteElemResult (ForestCursor a b))
-> PromoteElemResult (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> PromoteElemResult (TreeCursor a b))
-> ForestCursor a b -> PromoteElemResult (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b)
-> (b -> a) -> TreeCursor a b -> PromoteElemResult (TreeCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> TreeCursor a b -> PromoteElemResult (TreeCursor a b)
treeCursorPromoteElem a -> b
f b -> a
g) of
    PromotedElem ForestCursor a b
fc' -> ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForestCursor a b
fc'
    PromoteElemResult (ForestCursor a b)
CannotPromoteTopElem -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing
    PromoteElemResult (ForestCursor a b)
NoSiblingsToAdoptChildren -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing
    PromoteElemResult (ForestCursor a b)
NoGrandparentToPromoteElemUnder -> do
      let tc :: TreeCursor a b
tc = ForestCursor a b
fc ForestCursor a b
-> Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
-> TreeCursor a b
forall s a. s -> Getting a s a -> a
^. Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL
      TreeAbove b
ta <- TreeCursor a b -> Maybe (TreeAbove b)
forall a b. TreeCursor a b -> Maybe (TreeAbove b)
treeAbove TreeCursor a b
tc
      [CTree b]
lefts <-
        case TreeCursor a b -> CForest b
forall a b. TreeCursor a b -> CForest b
treeBelow TreeCursor a b
tc of
          CForest b
EmptyCForest -> [CTree b] -> Maybe [CTree b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CTree b] -> Maybe [CTree b]) -> [CTree b] -> Maybe [CTree b]
forall a b. (a -> b) -> a -> b
$ TreeAbove b -> [CTree b]
forall b. TreeAbove b -> [CTree b]
treeAboveLefts TreeAbove b
ta
          CForest b
_ ->
            case TreeAbove b -> [CTree b]
forall b. TreeAbove b -> [CTree b]
treeAboveLefts TreeAbove b
ta of
              [] -> Maybe [CTree b]
forall a. Maybe a
Nothing
              (CNode b
t CForest b
ls : [CTree b]
ts) ->
                [CTree b] -> Maybe [CTree b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CTree b] -> Maybe [CTree b]) -> [CTree b] -> Maybe [CTree b]
forall a b. (a -> b) -> a -> b
$ b -> CForest b -> CTree b
forall a. a -> CForest a -> CTree a
CNode b
t ([CTree b] -> CForest b
forall a. [CTree a] -> CForest a
openForest ([CTree b] -> CForest b) -> [CTree b] -> CForest b
forall a b. (a -> b) -> a -> b
$ CForest b -> [CTree b]
forall a. CForest a -> [CTree a]
unpackCForest CForest b
ls [CTree b] -> [CTree b] -> [CTree b]
forall a. [a] -> [a] -> [a]
++ CForest b -> [CTree b]
forall a. CForest a -> [CTree a]
unpackCForest (TreeCursor a b -> CForest b
forall a b. TreeCursor a b -> CForest b
treeBelow TreeCursor a b
tc)) CTree b -> [CTree b] -> [CTree b]
forall a. a -> [a] -> [a]
: [CTree b]
ts
      let ta' :: TreeAbove b
ta' = TreeAbove b
ta {treeAboveLefts :: [CTree b]
treeAboveLefts = [CTree b]
lefts}
      let tc' :: TreeCursor a b
tc' = TreeCursor a b
tc {treeAbove :: Maybe (TreeAbove b)
treeAbove = TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just TreeAbove b
ta'}
      TreeCursor a b
tc'' <-
        case (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
forall b a.
(b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
treeCursorDeleteSubTree b -> a
g TreeCursor a b
tc' of
          DeleteOrUpdate (TreeCursor a b)
Deleted -> Maybe (TreeCursor a b)
forall a. Maybe a
Nothing -- Cannot happen, otherwise we would have gotten 'CannotPromoteTopNode'.
          Updated TreeCursor a b
tc'' -> TreeCursor a b -> Maybe (TreeCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TreeCursor a b
tc''
      ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForestCursor a b -> Maybe (ForestCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$
        NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b.
NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
ForestCursor (NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$
          NonEmptyCursor (TreeCursor a b) (CTree b)
ne
            { nonEmptyCursorPrev :: [CTree b]
nonEmptyCursorPrev = (a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f TreeCursor a b
tc'' CTree b -> [CTree b] -> [CTree b]
forall a. a -> [a] -> [a]
: NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor (TreeCursor a b) (CTree b)
ne,
              nonEmptyCursorCurrent :: TreeCursor a b
nonEmptyCursorCurrent =
                a -> TreeCursor a b
forall a b. a -> TreeCursor a b
singletonTreeCursor (a -> TreeCursor a b) -> a -> TreeCursor a b
forall a b. (a -> b) -> a -> b
$ TreeCursor a b -> a
forall a b. TreeCursor a b -> a
treeCurrent (TreeCursor a b -> a) -> TreeCursor a b -> a
forall a b. (a -> b) -> a -> b
$ ForestCursor a b
fc ForestCursor a b
-> Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
-> TreeCursor a b
forall s a. s -> Getting a s a -> a
^. Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL
            }

-- | Promotes the current node to the level of its parent.
--
-- Example:
--
-- Before:
--
-- >  - a
-- >    |- b
-- >    |  |- c
-- >    |- d <--
-- >    |  |- e
-- >    |- f
-- >       |- g
-- >  - h
--
-- After:
--
-- >
-- > - a
-- >   |- b
-- >   |  |- c
-- >   |- f
-- >      |- g
-- > - d <--
-- >   |- e
-- > - h
forestCursorPromoteSubTree :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorPromoteSubTree :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorPromoteSubTree a -> b
f b -> a
g fc :: ForestCursor a b
fc@(ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne) =
  case ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> PromoteResult (ForestCursor a b))
-> PromoteResult (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> PromoteResult (TreeCursor a b))
-> ForestCursor a b -> PromoteResult (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b)
-> (b -> a) -> TreeCursor a b -> PromoteResult (TreeCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> TreeCursor a b -> PromoteResult (TreeCursor a b)
treeCursorPromoteSubTree a -> b
f b -> a
g) of
    Promoted ForestCursor a b
fc' -> ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForestCursor a b
fc'
    PromoteResult (ForestCursor a b)
CannotPromoteTopNode -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing
    PromoteResult (ForestCursor a b)
NoGrandparentToPromoteUnder ->
      case (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
forall b a.
(b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
treeCursorDeleteSubTree b -> a
g (TreeCursor a b -> DeleteOrUpdate (TreeCursor a b))
-> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)
forall a b. (a -> b) -> a -> b
$ ForestCursor a b
fc ForestCursor a b
-> Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
-> TreeCursor a b
forall s a. s -> Getting a s a -> a
^. Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL of
        DeleteOrUpdate (TreeCursor a b)
Deleted -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing -- Cannot happen, otherwise we would have gotten 'CannotPromoteTopNode'.
        Updated TreeCursor a b
tc' ->
          ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForestCursor a b -> Maybe (ForestCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$
            NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b.
NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
ForestCursor (NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$
              NonEmptyCursor (TreeCursor a b) (CTree b)
ne
                { nonEmptyCursorPrev :: [CTree b]
nonEmptyCursorPrev = (a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f TreeCursor a b
tc' CTree b -> [CTree b] -> [CTree b]
forall a. a -> [a] -> [a]
: NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor (TreeCursor a b) (CTree b)
ne,
                  nonEmptyCursorCurrent :: TreeCursor a b
nonEmptyCursorCurrent = (ForestCursor a b
fc ForestCursor a b
-> Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
-> TreeCursor a b
forall s a. s -> Getting a s a -> a
^. Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL) {treeAbove :: Maybe (TreeAbove b)
treeAbove = Maybe (TreeAbove b)
forall a. Maybe a
Nothing}
                }

-- | Demotes the current node to the level of its children.
--
-- Example:
--
-- Before:
--
-- > - a
-- >   |- b
-- > - c <--
-- >   |- d
-- > - e
--
-- After:
--
-- > - a
-- >   |- b
-- >   |- c <--
-- >   |- d
-- > - e
forestCursorDemoteElem :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorDemoteElem :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorDemoteElem a -> b
f b -> a
g fc :: ForestCursor a b
fc@(ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne) =
  case ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> DemoteResult (ForestCursor a b))
-> DemoteResult (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> DemoteResult (TreeCursor a b))
-> ForestCursor a b -> DemoteResult (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b)
-> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b)
treeCursorDemoteElem a -> b
f b -> a
g) of
    Demoted ForestCursor a b
fc' -> ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForestCursor a b
fc'
    DemoteResult (ForestCursor a b)
CannotDemoteTopNode ->
      case NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor (TreeCursor a b) (CTree b)
ne of
        [] -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing
        (CNode b
v CForest b
vts : [CTree b]
ts) -> do
          let CNode b
v' CForest b
vts' = (a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f (ForestCursor a b
fc ForestCursor a b
-> Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
-> TreeCursor a b
forall s a. s -> Getting a s a -> a
^. Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL)
          let n' :: CTree b
n' =
                b -> CForest b -> CTree b
forall a. a -> CForest a -> CTree a
CNode b
v (CForest b -> CTree b) -> CForest b -> CTree b
forall a b. (a -> b) -> a -> b
$
                  [CTree b] -> CForest b
forall a. [CTree a] -> CForest a
openForest ([CTree b] -> CForest b) -> [CTree b] -> CForest b
forall a b. (a -> b) -> a -> b
$
                    CForest b -> [CTree b]
forall a. CForest a -> [CTree a]
unpackCForest CForest b
vts [CTree b] -> [CTree b] -> [CTree b]
forall a. [a] -> [a] -> [a]
++ b -> CForest b -> CTree b
forall a. a -> CForest a -> CTree a
CNode b
v' CForest b
forall a. CForest a
emptyCForest CTree b -> [CTree b] -> [CTree b]
forall a. a -> [a] -> [a]
: CForest b -> [CTree b]
forall a. CForest a -> [CTree a]
unpackCForest CForest b
vts'
          TreeCursor a b
tc <- (a -> b)
-> (b -> a)
-> TreeCursorSelection
-> CTree b
-> Maybe (TreeCursor a b)
forall a b.
(a -> b)
-> (b -> a)
-> TreeCursorSelection
-> CTree b
-> Maybe (TreeCursor a b)
makeTreeCursorWithSelection a -> b
f b -> a
g (Int -> TreeCursorSelection -> TreeCursorSelection
SelectChild (CForest b -> Int
forall a. CForest a -> Int
lengthCForest CForest b
vts) TreeCursorSelection
SelectNode) CTree b
n'
          ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForestCursor a b -> Maybe (ForestCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b.
NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne {nonEmptyCursorPrev :: [CTree b]
nonEmptyCursorPrev = [CTree b]
ts, nonEmptyCursorCurrent :: TreeCursor a b
nonEmptyCursorCurrent = TreeCursor a b
tc}
    DemoteResult (ForestCursor a b)
NoSiblingsToDemoteUnder -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing

-- | Demotes the current subtree to the level of its children.
--
-- Example:
--
-- Before:
--
-- >  - a
-- >    |- b
-- >  - c <--
-- >    |- d
--
-- After:
--
-- >  - a
-- >    |- b
-- >    |- c <--
-- >       |- d
forestCursorDemoteSubTree :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorDemoteSubTree :: (a -> b)
-> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
forestCursorDemoteSubTree a -> b
f b -> a
g fc :: ForestCursor a b
fc@(ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne) =
  case ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> DemoteResult (ForestCursor a b))
-> DemoteResult (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> DemoteResult (TreeCursor a b))
-> ForestCursor a b -> DemoteResult (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((a -> b)
-> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b)
treeCursorDemoteSubTree a -> b
f b -> a
g) of
    Demoted ForestCursor a b
fc' -> ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForestCursor a b
fc'
    DemoteResult (ForestCursor a b)
CannotDemoteTopNode ->
      case NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor (TreeCursor a b) (CTree b)
ne of
        [] -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing
        (CNode b
v CForest b
vts : [CTree b]
ts) -> do
          let n' :: CTree b
n' =
                b -> CForest b -> CTree b
forall a. a -> CForest a -> CTree a
CNode b
v (CForest b -> CTree b) -> CForest b -> CTree b
forall a b. (a -> b) -> a -> b
$
                  [CTree b] -> CForest b
forall a. [CTree a] -> CForest a
openForest ([CTree b] -> CForest b) -> [CTree b] -> CForest b
forall a b. (a -> b) -> a -> b
$
                    CForest b -> [CTree b]
forall a. CForest a -> [CTree a]
unpackCForest CForest b
vts [CTree b] -> [CTree b] -> [CTree b]
forall a. [a] -> [a] -> [a]
++ [(a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f (ForestCursor a b
fc ForestCursor a b
-> Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
-> TreeCursor a b
forall s a. s -> Getting a s a -> a
^. Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL)]
          TreeCursor a b
tc <- (a -> b)
-> (b -> a)
-> TreeCursorSelection
-> CTree b
-> Maybe (TreeCursor a b)
forall a b.
(a -> b)
-> (b -> a)
-> TreeCursorSelection
-> CTree b
-> Maybe (TreeCursor a b)
makeTreeCursorWithSelection a -> b
f b -> a
g (Int -> TreeCursorSelection -> TreeCursorSelection
SelectChild (CForest b -> Int
forall a. CForest a -> Int
lengthCForest CForest b
vts) TreeCursorSelection
SelectNode) CTree b
n'
          ForestCursor a b -> Maybe (ForestCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForestCursor a b -> Maybe (ForestCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b.
NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne {nonEmptyCursorPrev :: [CTree b]
nonEmptyCursorPrev = [CTree b]
ts, nonEmptyCursorCurrent :: TreeCursor a b
nonEmptyCursorCurrent = TreeCursor a b
tc}
    DemoteResult (ForestCursor a b)
NoSiblingsToDemoteUnder -> Maybe (ForestCursor a b)
forall a. Maybe a
Nothing

-- | Demotes the current node to the level of its children, by adding two roots.
-- One for the current node and one for its children that are left behind.
--
-- Example:
--
-- Before:
--
-- >  - a <--
-- >    |- b
--
-- After:
--
-- >  - <given element 1>
-- >    |- a <--
-- >  - <given element 2>
-- >    |- b
forestCursorDemoteElemUnder :: b -> b -> ForestCursor a b -> ForestCursor a b
forestCursorDemoteElemUnder :: b -> b -> ForestCursor a b -> ForestCursor a b
forestCursorDemoteElemUnder b
b1 b
b2 fc :: ForestCursor a b
fc@(ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne) =
  case ForestCursor a b
fc ForestCursor a b
-> (ForestCursor a b -> Maybe (ForestCursor a b))
-> Maybe (ForestCursor a b)
forall a b. a -> (a -> b) -> b
& (TreeCursor a b -> Maybe (TreeCursor a b))
-> ForestCursor a b -> Maybe (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL (b -> b -> TreeCursor a b -> Maybe (TreeCursor a b)
forall b a. b -> b -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorDemoteElemUnder b
b1 b
b2) of
    Just ForestCursor a b
fc' -> ForestCursor a b
fc'
    Maybe (ForestCursor a b)
Nothing ->
      let t :: TreeCursor a b
t = ForestCursor a b
fc ForestCursor a b
-> Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
-> TreeCursor a b
forall s a. s -> Getting a s a -> a
^. Getting (TreeCursor a b) (ForestCursor a b) (TreeCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL
       in NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b.
NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
ForestCursor (NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b)
-> NonEmptyCursor (TreeCursor a b) (CTree b) -> ForestCursor a b
forall a b. (a -> b) -> a -> b
$
            NonEmptyCursor (TreeCursor a b) (CTree b)
ne
              { nonEmptyCursorCurrent :: TreeCursor a b
nonEmptyCursorCurrent =
                  TreeCursor :: forall a b. Maybe (TreeAbove b) -> a -> CForest b -> TreeCursor a b
TreeCursor
                    { treeAbove :: Maybe (TreeAbove b)
treeAbove =
                        TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just
                          TreeAbove :: forall b.
[CTree b] -> Maybe (TreeAbove b) -> b -> [CTree b] -> TreeAbove b
TreeAbove
                            { treeAboveLefts :: [CTree b]
treeAboveLefts = [],
                              treeAboveAbove :: Maybe (TreeAbove b)
treeAboveAbove = Maybe (TreeAbove b)
forall a. Maybe a
Nothing,
                              treeAboveNode :: b
treeAboveNode = b
b1,
                              treeAboveRights :: [CTree b]
treeAboveRights = []
                            },
                      treeCurrent :: a
treeCurrent = TreeCursor a b -> a
forall a b. TreeCursor a b -> a
treeCurrent TreeCursor a b
t,
                      treeBelow :: CForest b
treeBelow = CForest b
forall a. CForest a
emptyCForest
                    },
                nonEmptyCursorNext :: [CTree b]
nonEmptyCursorNext = b -> CForest b -> CTree b
forall a. a -> CForest a -> CTree a
CNode b
b2 (TreeCursor a b -> CForest b
forall a b. TreeCursor a b -> CForest b
treeBelow TreeCursor a b
t) CTree b -> [CTree b] -> [CTree b]
forall a. a -> [a] -> [a]
: NonEmptyCursor (TreeCursor a b) (CTree b) -> [CTree b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor (TreeCursor a b) (CTree b)
ne
              }

-- | Demotes the current subtree to the level of its children, by adding a root.
--
-- Example:
--
-- Before:
--
-- >  a <--
-- >  |- b
--
-- After:
--
-- >  <given element>
-- >  |- a <--
-- >     |- b
forestCursorDemoteSubTreeUnder :: b -> ForestCursor a b -> ForestCursor a b
forestCursorDemoteSubTreeUnder :: b -> ForestCursor a b -> ForestCursor a b
forestCursorDemoteSubTreeUnder b
b = (TreeCursor a b -> Identity (TreeCursor a b))
-> ForestCursor a b -> Identity (ForestCursor a b)
forall a b. Lens' (ForestCursor a b) (TreeCursor a b)
forestCursorSelectedTreeL ((TreeCursor a b -> Identity (TreeCursor a b))
 -> ForestCursor a b -> Identity (ForestCursor a b))
-> (TreeCursor a b -> TreeCursor a b)
-> ForestCursor a b
-> ForestCursor a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ b -> TreeCursor a b -> TreeCursor a b
forall b a. b -> TreeCursor a b -> TreeCursor a b
treeCursorDemoteSubTreeUnder b
b

traverseForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> f c) -> ForestCursor a b -> f c
traverseForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> f c)
-> ForestCursor a b -> f c
traverseForestCursor = ([CTree b] -> TreeCursor a b -> [CTree b] -> f c)
-> ForestCursor a b -> f c
forall b a c.
([CTree b] -> TreeCursor a b -> [CTree b] -> c)
-> ForestCursor a b -> c
foldForestCursor

foldForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> c) -> ForestCursor a b -> c
foldForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> c)
-> ForestCursor a b -> c
foldForestCursor [CTree b] -> TreeCursor a b -> [CTree b] -> c
func (ForestCursor NonEmptyCursor (TreeCursor a b) (CTree b)
ne) = ([CTree b] -> TreeCursor a b -> [CTree b] -> c)
-> NonEmptyCursor (TreeCursor a b) (CTree b) -> c
forall b a c. ([b] -> a -> [b] -> c) -> NonEmptyCursor a b -> c
foldNonEmptyCursor [CTree b] -> TreeCursor a b -> [CTree b] -> c
func NonEmptyCursor (TreeCursor a b) (CTree b)
ne