Safe Haskell | None |
---|---|
Language | Haskell2010 |
Cursor.Forest
Synopsis
- newtype ForestCursor a b = ForestCursor {
- forestCursorListCursor :: NonEmptyCursor (TreeCursor a b) (CTree b)
- makeForestCursor :: (b -> a) -> NonEmpty (CTree b) -> ForestCursor a b
- rebuildForestCursor :: (a -> b) -> ForestCursor a b -> NonEmpty (CTree b)
- drawForestCursor :: (Show a, Show b) => ForestCursor a b -> String
- mapForestCursor :: (a -> c) -> (b -> d) -> ForestCursor a b -> ForestCursor c d
- forestCursorListCursorL :: Lens (ForestCursor a b) (ForestCursor c d) (NonEmptyCursor (TreeCursor a b) (CTree b)) (NonEmptyCursor (TreeCursor c d) (CTree d))
- forestCursorSelectedTreeL :: Lens' (ForestCursor a b) (TreeCursor a b)
- forestCursorSelectPrevTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSelectNextTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSelectFirstTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
- forestCursorSelectLastTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
- forestCursorSelectPrev :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSelectNext :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSelectPrevOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSelectNextOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSelectFirst :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
- forestCursorSelectLast :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b
- forestCursorSelectAbove :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSelectBelowAtPos :: (a -> b) -> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSelectBelowAtStart :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSelectBelowAtEnd :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSelection :: ForestCursor a b -> Int
- forestCursorSelectIndex :: (a -> b) -> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorOpenCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorCloseCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorToggleCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorOpenCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorToggleCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorInsertEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b
- forestCursorAppendEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b
- forestCursorInsertAndSelectTreeCursor :: (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b
- forestCursorAppendAndSelectTreeCursor :: (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b
- forestCursorInsertTree :: Tree b -> ForestCursor a b -> ForestCursor a b
- forestCursorAppendTree :: Tree b -> ForestCursor a b -> ForestCursor a b
- forestCursorInsertAndSelectTree :: (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
- forestCursorInsert :: b -> ForestCursor a b -> ForestCursor a b
- forestCursorAppend :: b -> ForestCursor a b -> ForestCursor a b
- forestCursorInsertAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b
- forestCursorAppendAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b
- forestCursorAddChildTreeToNodeAtPos :: Int -> Tree b -> ForestCursor a b -> ForestCursor a b
- forestCursorAddChildTreeToNodeAtStart :: Tree b -> ForestCursor a b -> ForestCursor a b
- forestCursorAddChildTreeToNodeAtEnd :: Tree b -> ForestCursor a b -> ForestCursor a b
- forestCursorAddChildToNodeAtPos :: Int -> b -> ForestCursor a b -> ForestCursor a b
- forestCursorAddChildToNodeAtStart :: b -> ForestCursor a b -> ForestCursor a b
- forestCursorAddChildToNodeAtEnd :: b -> ForestCursor a b -> ForestCursor a b
- forestCursorRemoveElemAndSelectPrev :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
- forestCursorDeleteElemAndSelectNext :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
- forestCursorRemoveElem :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
- forestCursorDeleteElem :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
- forestCursorRemoveSubTreeAndSelectPrev :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
- forestCursorDeleteSubTreeAndSelectNext :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))
- forestCursorRemoveSubTree :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
- forestCursorDeleteSubTree :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)
- forestCursorAddRoot :: (a -> b) -> (b -> a) -> ForestCursor a b -> a -> TreeCursor a b
- forestCursorSwapPrev :: ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorSwapNext :: ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorPromoteElem :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorPromoteSubTree :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorDemoteElem :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorDemoteSubTree :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)
- forestCursorDemoteElemUnder :: b -> b -> ForestCursor a b -> ForestCursor a b
- forestCursorDemoteSubTreeUnder :: b -> ForestCursor a b -> ForestCursor a b
- data CTree a = CNode !a (CForest a)
- makeCTree :: Tree a -> CTree a
- cTree :: Bool -> Tree a -> CTree a
- rebuildCTree :: CTree a -> Tree a
- data CForest a
- = EmptyCForest
- | ClosedForest !(NonEmpty (Tree a))
- | OpenForest !(NonEmpty (CTree a))
- makeCForest :: Forest a -> CForest a
- cForest :: Bool -> Forest a -> CForest a
- rebuildCForest :: CForest a -> Forest a
- traverseForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> f c) -> ForestCursor a b -> f c
- foldForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> c) -> ForestCursor a b -> c
Documentation
newtype ForestCursor a b Source #
Constructors
ForestCursor | |
Fields
|
Instances
makeForestCursor :: (b -> a) -> NonEmpty (CTree b) -> ForestCursor a b Source #
rebuildForestCursor :: (a -> b) -> ForestCursor a b -> NonEmpty (CTree b) Source #
drawForestCursor :: (Show a, Show b) => ForestCursor a b -> String Source #
mapForestCursor :: (a -> c) -> (b -> d) -> ForestCursor a b -> ForestCursor c d Source #
forestCursorListCursorL :: Lens (ForestCursor a b) (ForestCursor c d) (NonEmptyCursor (TreeCursor a b) (CTree b)) (NonEmptyCursor (TreeCursor c d) (CTree d)) Source #
forestCursorSelectedTreeL :: Lens' (ForestCursor a b) (TreeCursor a b) Source #
forestCursorSelectPrevTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorSelectNextTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorSelectFirstTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b Source #
forestCursorSelectLastTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b Source #
forestCursorSelectPrev :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorSelectNext :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorSelectPrevOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorSelectNextOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorSelectFirst :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b Source #
forestCursorSelectLast :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b Source #
forestCursorSelectAbove :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorSelectBelowAtPos :: (a -> b) -> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorSelectBelowAtStart :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorSelectBelowAtEnd :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorSelection :: ForestCursor a b -> Int Source #
forestCursorSelectIndex :: (a -> b) -> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorOpenCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorCloseCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorToggleCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorOpenCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorToggleCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b) Source #
forestCursorInsertEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAppendEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorInsertAndSelectTreeCursor :: (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAppendAndSelectTreeCursor :: (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorInsertTree :: Tree b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAppendTree :: Tree b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorInsertAndSelectTree :: (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAppendAndSelectTree :: (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorInsert :: b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAppend :: b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorInsertAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAppendAndSelect :: (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAddChildTreeToNodeAtPos :: Int -> Tree b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAddChildTreeToNodeAtStart :: Tree b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAddChildTreeToNodeAtEnd :: Tree b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAddChildToNodeAtPos :: Int -> b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAddChildToNodeAtStart :: b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorAddChildToNodeAtEnd :: b -> ForestCursor a b -> ForestCursor a b Source #
forestCursorRemoveElemAndSelectPrev :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)) Source #
forestCursorDeleteElemAndSelectNext :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)) Source #
forestCursorRemoveElem :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) Source #
forestCursorDeleteElem :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) Source #
forestCursorRemoveSubTreeAndSelectPrev :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)) Source #
forestCursorDeleteSubTreeAndSelectNext :: (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b)) Source #
forestCursorRemoveSubTree :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) Source #
forestCursorDeleteSubTree :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) Source #
forestCursorAddRoot :: (a -> b) -> (b -> a) -> ForestCursor a b -> a -> TreeCursor a b Source #
forestCursorSwapPrev :: ForestCursor a b -> Maybe (ForestCursor a b) Source #
Swaps the current node with the previous node on the same level
Example:
Before:
- a - b <--
After:
- b <-- - a
forestCursorSwapNext :: ForestCursor a b -> Maybe (ForestCursor a b) Source #
Swaps the current node with the next node on the same level
Example:
Before:
- a <-- - b
After:
- b - a <--
forestCursorPromoteElem :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
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
forestCursorPromoteSubTree :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
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
forestCursorDemoteElem :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
Demotes the current node to the level of its children.
Example:
Before:
- a |- b - c <-- |- d - e
After:
- a |- b |- c <-- |- d - e
forestCursorDemoteSubTree :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) Source #
Demotes the current subtree to the level of its children.
Example:
Before:
- a |- b - c <-- |- d
After:
- a |- b |- c <-- |- d
forestCursorDemoteElemUnder :: b -> b -> ForestCursor a b -> ForestCursor a b Source #
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
forestCursorDemoteSubTreeUnder :: b -> ForestCursor a b -> ForestCursor a b Source #
Demotes the current subtree to the level of its children, by adding a root.
Example:
Before:
a <-- |- b
After:
<given element> |- a <-- |- b
Instances
Functor CTree Source # | |
Eq a => Eq (CTree a) Source # | |
Show a => Show (CTree a) Source # | |
Generic (CTree a) Source # | |
Validity a => Validity (CTree a) Source # | |
Defined in Cursor.Tree.Types Methods validate :: CTree a -> Validation # | |
type Rep (CTree a) Source # | |
Defined in Cursor.Tree.Types type Rep (CTree a) = D1 (MetaData "CTree" "Cursor.Tree.Types" "cursor-0.1.0.1-B4Ve9845sGB2dEksN2X1wh" False) (C1 (MetaCons "CNode" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 a) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (CForest a)))) |
rebuildCTree :: CTree a -> Tree a Source #
Constructors
EmptyCForest | |
ClosedForest !(NonEmpty (Tree a)) | |
OpenForest !(NonEmpty (CTree a)) |
Instances
Functor CForest Source # | |
Eq a => Eq (CForest a) Source # | |
Show a => Show (CForest a) Source # | |
Generic (CForest a) Source # | |
Validity a => Validity (CForest a) Source # | |
Defined in Cursor.Tree.Types Methods validate :: CForest a -> Validation # | |
type Rep (CForest a) Source # | |
Defined in Cursor.Tree.Types type Rep (CForest a) = D1 (MetaData "CForest" "Cursor.Tree.Types" "cursor-0.1.0.1-B4Ve9845sGB2dEksN2X1wh" False) (C1 (MetaCons "EmptyCForest" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "ClosedForest" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (NonEmpty (Tree a)))) :+: C1 (MetaCons "OpenForest" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (NonEmpty (CTree a)))))) |
makeCForest :: Forest a -> CForest a Source #
rebuildCForest :: CForest a -> Forest a Source #
traverseForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> f c) -> ForestCursor a b -> f c Source #
foldForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> c) -> ForestCursor a b -> c Source #