{-# 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 { forestCursorListCursor :: NonEmptyCursor (TreeCursor a b) (CTree b) } deriving (Show, Eq, 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 = ForestCursor . singletonNonEmptyCursor . singletonTreeCursor makeForestCursor :: (b -> a) -> NonEmpty (CTree b) -> ForestCursor a b makeForestCursor g = ForestCursor . makeNonEmptyCursor (makeTreeCursor g) rebuildForestCursor :: (a -> b) -> ForestCursor a b -> NonEmpty (CTree b) rebuildForestCursor f = rebuildNonEmptyCursor (rebuildTreeCursor f) . forestCursorListCursor drawForestCursor :: (Show a, Show b) => ForestCursor a b -> String drawForestCursor ForestCursor {..} = drawForest $ map showCTree (reverse $ nonEmptyCursorPrev forestCursorListCursor) ++ [treeCursorWithPointer $ nonEmptyCursorCurrent forestCursorListCursor] ++ map showCTree (nonEmptyCursorNext forestCursorListCursor) mapForestCursor :: (a -> c) -> (b -> d) -> ForestCursor a b -> ForestCursor c d mapForestCursor f g = forestCursorListCursorL %~ mapNonEmptyCursor (mapTreeCursor f g) (fmap g) forestCursorListCursorL :: Lens (ForestCursor a b) (ForestCursor c d) (NonEmptyCursor (TreeCursor a b) (CTree b)) (NonEmptyCursor (TreeCursor c d) (CTree d)) forestCursorListCursorL = lens forestCursorListCursor $ \fc lc -> fc {forestCursorListCursor = lc} forestCursorSelectedTreeL :: Lens' (ForestCursor a b) (TreeCursor a b) forestCursorSelectedTreeL = forestCursorListCursorL . nonEmptyCursorElemL forestCursorSelectPrevTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectPrevTreeCursor f g = forestCursorListCursorL $ nonEmptyCursorSelectPrev (rebuildTreeCursor f) (makeTreeCursor g) forestCursorSelectNextTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectNextTreeCursor f g = forestCursorListCursorL $ nonEmptyCursorSelectNext (rebuildTreeCursor f) (makeTreeCursor g) forestCursorSelectFirstTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b forestCursorSelectFirstTreeCursor f g = forestCursorListCursorL %~ nonEmptyCursorSelectFirst (rebuildTreeCursor f) (makeTreeCursor g) forestCursorSelectLastTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b forestCursorSelectLastTreeCursor f g = forestCursorListCursorL %~ nonEmptyCursorSelectLast (rebuildTreeCursor f) (makeTreeCursor g) forestCursorSelectNext :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectNext f g fc = (fc & forestCursorSelectedTreeL (treeCursorSelectNext f g)) <|> forestCursorSelectNextTreeCursor f g fc forestCursorSelectPrev :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectPrev f g fc = (fc & forestCursorSelectedTreeL (treeCursorSelectPrev f g)) <|> ( forestCursorSelectPrevTreeCursor f g fc >>= forestCursorSelectedTreeL (treeCursorSelectBelowAtEndRecursively f g) ) <|> forestCursorSelectPrevTreeCursor f g fc forestCursorSelectNextOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectNextOnSameLevel f g fc = (fc & forestCursorSelectedTreeL (treeCursorSelectNextOnSameLevel f g)) <|> forestCursorSelectNextTreeCursor f g fc forestCursorSelectPrevOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectPrevOnSameLevel f g fc = (fc & forestCursorSelectedTreeL (treeCursorSelectPrevOnSameLevel f g)) <|> forestCursorSelectPrevTreeCursor f g fc forestCursorSelectLastOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b forestCursorSelectLastOnSameLevel f g fc = case forestCursorSelectNextOnSameLevel f g fc of Nothing -> fc Just fc' -> forestCursorSelectLastOnSameLevel f g fc' forestCursorSelectFirstOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b forestCursorSelectFirstOnSameLevel f g fc = case forestCursorSelectPrevOnSameLevel f g fc of Nothing -> fc Just fc' -> forestCursorSelectLastOnSameLevel f g fc' forestCursorSelectFirst :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b forestCursorSelectFirst f g fc = case forestCursorSelectPrevTreeCursor f g fc of Just fc' -> forestCursorSelectFirst f g fc' Nothing -> case forestCursorSelectPrev f g fc of Just fc' -> forestCursorSelectFirst f g fc' Nothing -> fc forestCursorSelectLast :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b forestCursorSelectLast f g fc = case forestCursorSelectNextTreeCursor f g fc of Just fc' -> forestCursorSelectLast f g fc' Nothing -> case forestCursorSelectNext f g fc of Just fc' -> forestCursorSelectLast f g fc' Nothing -> fc forestCursorSelectAbove :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectAbove f g = forestCursorSelectedTreeL $ treeCursorSelectAbove f g forestCursorSelectBelowAtPos :: (a -> b) -> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectBelowAtPos f g i = forestCursorSelectedTreeL $ treeCursorSelectBelowAtPos f g i forestCursorSelectBelowAtStart :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectBelowAtStart f g = forestCursorSelectedTreeL $ treeCursorSelectBelowAtStart f g forestCursorSelectBelowAtEnd :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectBelowAtEnd f g = forestCursorSelectedTreeL $ treeCursorSelectBelowAtEnd f g forestCursorSelection :: ForestCursor a b -> Int forestCursorSelection fc = nonEmptyCursorSelection $ fc ^. forestCursorListCursorL forestCursorSelectIndex :: (a -> b) -> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectIndex f g i = forestCursorListCursorL (nonEmptyCursorSelectIndex (rebuildTreeCursor f) (makeTreeCursor g) i) forestCursorOpenCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b) forestCursorOpenCurrentForest = forestCursorSelectedTreeL treeCursorOpenCurrentForest forestCursorCloseCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b) forestCursorCloseCurrentForest = forestCursorSelectedTreeL treeCursorCloseCurrentForest forestCursorToggleCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b) forestCursorToggleCurrentForest = forestCursorSelectedTreeL treeCursorToggleCurrentForest forestCursorOpenCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b) forestCursorOpenCurrentForestRecursively = forestCursorSelectedTreeL treeCursorOpenCurrentForestRecursively forestCursorToggleCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b) forestCursorToggleCurrentForestRecursively = forestCursorSelectedTreeL treeCursorToggleCurrentForestRecursively forestCursorInsertEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b forestCursorInsertEntireTree t = forestCursorListCursorL %~ nonEmptyCursorInsert (makeCTree t) forestCursorInsertAndSelectTreeCursor :: (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b forestCursorInsertAndSelectTreeCursor f tc = forestCursorListCursorL %~ nonEmptyCursorInsertAndSelect (rebuildTreeCursor f) tc forestCursorAppendEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b forestCursorAppendEntireTree t = forestCursorListCursorL %~ nonEmptyCursorAppend (makeCTree t) forestCursorAppendAndSelectTreeCursor :: (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b forestCursorAppendAndSelectTreeCursor f tc = forestCursorListCursorL %~ nonEmptyCursorAppendAndSelect (rebuildTreeCursor f) tc forestCursorInsertTree :: Tree b -> ForestCursor a b -> ForestCursor a b forestCursorInsertTree t fc = fromMaybe (forestCursorInsertEntireTree t fc) $ fc & forestCursorSelectedTreeL (treeCursorInsert t) forestCursorInsertAndSelectTree :: (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b forestCursorInsertAndSelectTree f g (Node value forest) = forestCursorInsertNodeAndSelect f (g value) (makeCForest forest) forestCursorAppendTree :: Tree b -> ForestCursor a b -> ForestCursor a b forestCursorAppendTree t fc = fromMaybe (forestCursorAppendEntireTree t fc) $ fc & forestCursorSelectedTreeL (treeCursorAppend t) forestCursorAppendAndSelectTree :: (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b forestCursorAppendAndSelectTree f g (Node value forest) = forestCursorAppendNodeAndSelect f (g value) (makeCForest forest) forestCursorInsert :: b -> ForestCursor a b -> ForestCursor a b forestCursorInsert b = forestCursorInsertTree $ Node b [] forestCursorInsertAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b forestCursorInsertAndSelect f g b = forestCursorInsertAndSelectTree f g $ Node b [] forestCursorInsertNodeSingleAndSelect :: (a -> b) -> a -> ForestCursor a b -> ForestCursor a b forestCursorInsertNodeSingleAndSelect f value = forestCursorInsertNodeAndSelect f value EmptyCForest forestCursorInsertNodeAndSelect :: (a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b forestCursorInsertNodeAndSelect f value forest fc = fromMaybe (forestCursorInsertAndSelectTreeCursor f (makeNodeTreeCursor value forest) fc) $ fc & forestCursorSelectedTreeL (treeCursorInsertNodeAndSelect f value forest) forestCursorAppend :: b -> ForestCursor a b -> ForestCursor a b forestCursorAppend b = forestCursorAppendTree $ Node b [] forestCursorAppendAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b forestCursorAppendAndSelect f g b = forestCursorAppendAndSelectTree f g $ Node b [] forestCursorAppendNodeSingleAndSelect :: (a -> b) -> a -> ForestCursor a b -> ForestCursor a b forestCursorAppendNodeSingleAndSelect f value = forestCursorAppendNodeAndSelect f value EmptyCForest forestCursorAppendNodeAndSelect :: (a -> b) -> a -> CForest b -> ForestCursor a b -> ForestCursor a b forestCursorAppendNodeAndSelect f value forest fc = fromMaybe (forestCursorAppendAndSelectTreeCursor f (makeNodeTreeCursor value forest) fc) $ fc & forestCursorSelectedTreeL (treeCursorAppendNodeAndSelect f value forest) forestCursorAddChildTreeToNodeAtPos :: Int -> Tree b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildTreeToNodeAtPos i t = forestCursorSelectedTreeL %~ treeCursorAddChildAtPos i t forestCursorAddChildTreeToNodeAtStart :: Tree b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildTreeToNodeAtStart t = forestCursorSelectedTreeL %~ treeCursorAddChildAtStart t forestCursorAddChildTreeToNodeAtEnd :: Tree b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildTreeToNodeAtEnd t fc = fc & forestCursorSelectedTreeL %~ treeCursorAddChildAtEnd t forestCursorAddChildToNodeAtPos :: Int -> b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildToNodeAtPos i b = forestCursorAddChildTreeToNodeAtPos i $ Node b [] forestCursorAddChildToNodeAtStart :: b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildToNodeAtStart b = forestCursorAddChildTreeToNodeAtStart $ Node b [] forestCursorAddChildToNodeAtEnd :: b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildToNodeAtEnd b = forestCursorAddChildTreeToNodeAtEnd $ Node b [] forestCursorAddChildTreeToNodeAtPosAndSelect :: (a -> b) -> (b -> a) -> Int -> Tree b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildTreeToNodeAtPosAndSelect f g i t = forestCursorSelectedTreeL %~ treeCursorAddChildAtPosAndSelect f g i t forestCursorAddChildTreeToNodeAtStartAndSelect :: (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildTreeToNodeAtStartAndSelect f g t = forestCursorSelectedTreeL %~ treeCursorAddChildAtStartAndSelect f g t forestCursorAddChildTreeToNodeAtEndAndSelect :: (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildTreeToNodeAtEndAndSelect f g t fc = fc & forestCursorSelectedTreeL %~ treeCursorAddChildAtEndAndSelect f g t forestCursorAddChildToNodeAtPosAndSelect :: (a -> b) -> (b -> a) -> Int -> b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildToNodeAtPosAndSelect f g i b = forestCursorAddChildTreeToNodeAtPosAndSelect f g i $ Node b [] forestCursorAddChildToNodeAtStartAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildToNodeAtStartAndSelect f g b = forestCursorAddChildTreeToNodeAtStartAndSelect f g $ Node b [] forestCursorAddChildToNodeAtEndAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildToNodeAtEndAndSelect f g b = forestCursorAddChildTreeToNodeAtEndAndSelect f g $ Node b [] forestCursorAddChildNodeSingleToNodeAtPosAndSelect :: (a -> b) -> Int -> a -> ForestCursor a b -> ForestCursor a b forestCursorAddChildNodeSingleToNodeAtPosAndSelect f i t = forestCursorSelectedTreeL %~ treeCursorAddChildNodeSingleAtPosAndSelect f i t forestCursorAddChildNodeSingleToNodeAtStartAndSelect :: (a -> b) -> a -> ForestCursor a b -> ForestCursor a b forestCursorAddChildNodeSingleToNodeAtStartAndSelect f t = forestCursorSelectedTreeL %~ treeCursorAddChildNodeSingleAtStartAndSelect f t forestCursorAddChildNodeSingleToNodeAtEndAndSelect :: (a -> b) -> a -> ForestCursor a b -> ForestCursor a b forestCursorAddChildNodeSingleToNodeAtEndAndSelect f t = forestCursorSelectedTreeL %~ treeCursorAddChildNodeSingleAtEndAndSelect f t forestCursorAddChildNodeToNodeAtPosAndSelect :: (a -> b) -> Int -> a -> Forest b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildNodeToNodeAtPosAndSelect f i t ts = forestCursorSelectedTreeL %~ treeCursorAddChildNodeAtPosAndSelect f i t ts forestCursorAddChildNodeToNodeAtStartAndSelect :: (a -> b) -> a -> Forest b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildNodeToNodeAtStartAndSelect f t ts = forestCursorSelectedTreeL %~ treeCursorAddChildNodeAtStartAndSelect f t ts forestCursorAddChildNodeToNodeAtEndAndSelect :: (a -> b) -> a -> Forest b -> ForestCursor a b -> ForestCursor a b forestCursorAddChildNodeToNodeAtEndAndSelect f t ts = forestCursorSelectedTreeL %~ treeCursorAddChildNodeAtEndAndSelect f t ts forestCursorRemoveElemAndSelectPrev :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)) forestCursorRemoveElemAndSelectPrev g fc = case fc & focusPossibleDeleteOrUpdate forestCursorSelectedTreeL (treeCursorDeleteElemAndSelectPrevious g) of Just Deleted -> fc & focusPossibleDeleteOrUpdate forestCursorListCursorL (nonEmptyCursorRemoveElemAndSelectPrev (makeTreeCursor g)) r -> r forestCursorDeleteElemAndSelectNext :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)) forestCursorDeleteElemAndSelectNext g fc = case fc & focusPossibleDeleteOrUpdate forestCursorSelectedTreeL (treeCursorDeleteElemAndSelectNext g) of Just Deleted -> fc & focusPossibleDeleteOrUpdate forestCursorListCursorL (nonEmptyCursorDeleteElemAndSelectNext (makeTreeCursor g)) r -> r forestCursorRemoveElem :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) forestCursorRemoveElem g fc = (fc & forestCursorSelectedTreeL (treeCursorRemoveElem g)) <|> (fc & forestCursorListCursorL (nonEmptyCursorRemoveElem (makeTreeCursor g))) forestCursorDeleteElem :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) forestCursorDeleteElem g fc = (fc & forestCursorSelectedTreeL (treeCursorDeleteElem g)) <|> (fc & forestCursorListCursorL (nonEmptyCursorDeleteElem (makeTreeCursor g))) forestCursorRemoveSubTreeAndSelectPrev :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)) forestCursorRemoveSubTreeAndSelectPrev g fc = joinPossibleDeletes ( fc & focusPossibleDeleteOrUpdate forestCursorSelectedTreeL (treeCursorDeleteSubTreeAndSelectPrevious g) ) ( fc & focusPossibleDeleteOrUpdate forestCursorListCursorL (nonEmptyCursorRemoveElemAndSelectPrev (makeTreeCursor g)) ) forestCursorDeleteSubTreeAndSelectNext :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)) forestCursorDeleteSubTreeAndSelectNext g fc = joinPossibleDeletes ( fc & focusPossibleDeleteOrUpdate forestCursorSelectedTreeL (treeCursorDeleteSubTreeAndSelectNext g) ) ( fc & focusPossibleDeleteOrUpdate forestCursorListCursorL (nonEmptyCursorDeleteElemAndSelectNext (makeTreeCursor g)) ) forestCursorRemoveSubTree :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) forestCursorRemoveSubTree g fc = (fc & forestCursorSelectedTreeL (treeCursorRemoveSubTree g)) <|> (fc & forestCursorListCursorL (nonEmptyCursorRemoveElem (makeTreeCursor g))) forestCursorDeleteSubTree :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) forestCursorDeleteSubTree g fc = (fc & forestCursorSelectedTreeL (treeCursorDeleteSubTree g)) <|> (fc & forestCursorListCursorL (nonEmptyCursorDeleteElem (makeTreeCursor g))) forestCursorAddRoot :: (a -> b) -> (b -> a) -> ForestCursor a b -> a -> TreeCursor a b forestCursorAddRoot f g fc v = makeTreeCursor g $ CNode (f v) $ OpenForest $ rebuildForestCursor f 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 fc@(ForestCursor ne) = case fc & forestCursorSelectedTreeL treeCursorSwapPrev of Swapped fc' -> pure fc' NoSiblingsToSwapWith -> Nothing SwapperIsTopNode -> case nonEmptyCursorPrev ne of [] -> Nothing (t : ts) -> pure $ ForestCursor ne {nonEmptyCursorPrev = ts, nonEmptyCursorNext = t : nonEmptyCursorNext 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 fc@(ForestCursor ne) = case fc & forestCursorSelectedTreeL treeCursorSwapNext of Swapped fc' -> pure fc' NoSiblingsToSwapWith -> Nothing SwapperIsTopNode -> case nonEmptyCursorNext ne of [] -> Nothing (t : ts) -> pure $ ForestCursor ne {nonEmptyCursorPrev = t : nonEmptyCursorPrev ne, nonEmptyCursorNext = 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 f g fc@(ForestCursor ne) = case fc & forestCursorSelectedTreeL (treeCursorPromoteElem f g) of PromotedElem fc' -> pure fc' CannotPromoteTopElem -> Nothing NoSiblingsToAdoptChildren -> Nothing NoGrandparentToPromoteElemUnder -> do let tc = fc ^. forestCursorSelectedTreeL ta <- treeAbove tc lefts <- case treeBelow tc of EmptyCForest -> pure $ treeAboveLefts ta _ -> case treeAboveLefts ta of [] -> Nothing (CNode t ls : ts) -> pure $ CNode t (openForest $ unpackCForest ls ++ unpackCForest (treeBelow tc)) : ts let ta' = ta {treeAboveLefts = lefts} let tc' = tc {treeAbove = Just ta'} tc'' <- case treeCursorDeleteSubTree g tc' of Deleted -> Nothing -- Cannot happen, otherwise we would have gotten 'CannotPromoteTopNode'. Updated tc'' -> pure tc'' pure $ ForestCursor $ ne { nonEmptyCursorPrev = rebuildTreeCursor f tc'' : nonEmptyCursorPrev ne, nonEmptyCursorCurrent = singletonTreeCursor $ treeCurrent $ fc ^. 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 f g fc@(ForestCursor ne) = case fc & forestCursorSelectedTreeL (treeCursorPromoteSubTree f g) of Promoted fc' -> pure fc' CannotPromoteTopNode -> Nothing NoGrandparentToPromoteUnder -> case treeCursorDeleteSubTree g $ fc ^. forestCursorSelectedTreeL of Deleted -> Nothing -- Cannot happen, otherwise we would have gotten 'CannotPromoteTopNode'. Updated tc' -> pure $ ForestCursor $ ne { nonEmptyCursorPrev = rebuildTreeCursor f tc' : nonEmptyCursorPrev ne, nonEmptyCursorCurrent = (fc ^. forestCursorSelectedTreeL) {treeAbove = 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 f g fc@(ForestCursor ne) = case fc & forestCursorSelectedTreeL (treeCursorDemoteElem f g) of Demoted fc' -> pure fc' CannotDemoteTopNode -> case nonEmptyCursorPrev ne of [] -> Nothing (CNode v vts : ts) -> do let CNode v' vts' = rebuildTreeCursor f (fc ^. forestCursorSelectedTreeL) let n' = CNode v $ openForest $ unpackCForest vts ++ CNode v' emptyCForest : unpackCForest vts' tc <- makeTreeCursorWithSelection f g (SelectChild (lengthCForest vts) SelectNode) n' pure $ ForestCursor ne {nonEmptyCursorPrev = ts, nonEmptyCursorCurrent = tc} NoSiblingsToDemoteUnder -> 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 f g fc@(ForestCursor ne) = case fc & forestCursorSelectedTreeL (treeCursorDemoteSubTree f g) of Demoted fc' -> pure fc' CannotDemoteTopNode -> case nonEmptyCursorPrev ne of [] -> Nothing (CNode v vts : ts) -> do let n' = CNode v $ openForest $ unpackCForest vts ++ [rebuildTreeCursor f (fc ^. forestCursorSelectedTreeL)] tc <- makeTreeCursorWithSelection f g (SelectChild (lengthCForest vts) SelectNode) n' pure $ ForestCursor ne {nonEmptyCursorPrev = ts, nonEmptyCursorCurrent = tc} NoSiblingsToDemoteUnder -> 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: -- -- > - -- > |- a <-- -- > - -- > |- b forestCursorDemoteElemUnder :: b -> b -> ForestCursor a b -> ForestCursor a b forestCursorDemoteElemUnder b1 b2 fc@(ForestCursor ne) = case fc & forestCursorSelectedTreeL (treeCursorDemoteElemUnder b1 b2) of Just fc' -> fc' Nothing -> let t = fc ^. forestCursorSelectedTreeL in ForestCursor $ ne { nonEmptyCursorCurrent = TreeCursor { treeAbove = Just TreeAbove { treeAboveLefts = [], treeAboveAbove = Nothing, treeAboveNode = b1, treeAboveRights = [] }, treeCurrent = treeCurrent t, treeBelow = emptyCForest }, nonEmptyCursorNext = CNode b2 (treeBelow t) : nonEmptyCursorNext ne } -- | Demotes the current subtree to the level of its children, by adding a root. -- -- Example: -- -- Before: -- -- > a <-- -- > |- b -- -- After: -- -- > -- > |- a <-- -- > |- b forestCursorDemoteSubTreeUnder :: b -> ForestCursor a b -> ForestCursor a b forestCursorDemoteSubTreeUnder b = forestCursorSelectedTreeL %~ treeCursorDemoteSubTreeUnder b traverseForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> f c) -> ForestCursor a b -> f c traverseForestCursor = foldForestCursor foldForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> c) -> ForestCursor a b -> c foldForestCursor func (ForestCursor ne) = foldNonEmptyCursor func ne