cursor-0.3.1.0: Purely Functional Cursors
Safe HaskellNone
LanguageHaskell2010

Cursor.Simple.Tree

Synopsis

Documentation

data TreeAbove b Source #

Constructors

TreeAbove 

Instances

Instances details
Functor TreeAbove Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

fmap :: (a -> b) -> TreeAbove a -> TreeAbove b #

(<$) :: a -> TreeAbove b -> TreeAbove a #

Eq b => Eq (TreeAbove b) Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

(==) :: TreeAbove b -> TreeAbove b -> Bool #

(/=) :: TreeAbove b -> TreeAbove b -> Bool #

Show b => Show (TreeAbove b) Source # 
Instance details

Defined in Cursor.Tree.Types

Generic (TreeAbove b) Source # 
Instance details

Defined in Cursor.Tree.Types

Associated Types

type Rep (TreeAbove b) :: Type -> Type #

Methods

from :: TreeAbove b -> Rep (TreeAbove b) x #

to :: Rep (TreeAbove b) x -> TreeAbove b #

NFData b => NFData (TreeAbove b) Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

rnf :: TreeAbove b -> () #

Validity b => Validity (TreeAbove b) Source # 
Instance details

Defined in Cursor.Tree.Types

type Rep (TreeAbove b) Source # 
Instance details

Defined in Cursor.Tree.Types

type Rep (TreeAbove b) = D1 ('MetaData "TreeAbove" "Cursor.Tree.Types" "cursor-0.3.1.0-2FAY4bJgmEY7nee1TnZoZ6" 'False) (C1 ('MetaCons "TreeAbove" 'PrefixI 'True) ((S1 ('MetaSel ('Just "treeAboveLefts") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [CTree b]) :*: S1 ('MetaSel ('Just "treeAboveAbove") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe (TreeAbove b)))) :*: (S1 ('MetaSel ('Just "treeAboveNode") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "treeAboveRights") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [CTree b]))))

data TreeCursorSelection Source #

Instances

Instances details
Eq TreeCursorSelection Source # 
Instance details

Defined in Cursor.Tree.Types

Show TreeCursorSelection Source # 
Instance details

Defined in Cursor.Tree.Types

Generic TreeCursorSelection Source # 
Instance details

Defined in Cursor.Tree.Types

Associated Types

type Rep TreeCursorSelection :: Type -> Type #

NFData TreeCursorSelection Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

rnf :: TreeCursorSelection -> () #

Validity TreeCursorSelection Source # 
Instance details

Defined in Cursor.Tree.Types

type Rep TreeCursorSelection Source # 
Instance details

Defined in Cursor.Tree.Types

type Rep TreeCursorSelection = D1 ('MetaData "TreeCursorSelection" "Cursor.Tree.Types" "cursor-0.3.1.0-2FAY4bJgmEY7nee1TnZoZ6" 'False) (C1 ('MetaCons "SelectNode" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SelectChild" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TreeCursorSelection)))

treeCursorSelectAbovePrev :: TreeCursor a -> Maybe (TreeCursor a) Source #

Go back and down as far as necessary to find a previous element on a level below

treeCursorSelectAboveNext :: TreeCursor a -> Maybe (TreeCursor a) Source #

Go up as far as necessary to find a next element on a level above and forward

Note: This will fail if there is a next node on the same level or any node below the current node

treeCursorSwapPrev :: TreeCursor a b -> SwapResult (TreeCursor a b) Source #

Swaps the current node with the previous node on the same level

Example:

Before:

p
|- a
|- b <--

After:

p
|- b <--
|- a

treeCursorSwapNext :: TreeCursor a b -> SwapResult (TreeCursor a b) Source #

Swaps the current node with the next node on the same level

Example:

Before:

p
|- a <--
|- b

After:

p
|- b
|- a <--

data SwapResult a Source #

Instances

Instances details
Functor SwapResult Source # 
Instance details

Defined in Cursor.Tree.Swap

Methods

fmap :: (a -> b) -> SwapResult a -> SwapResult b #

(<$) :: a -> SwapResult b -> SwapResult a #

Eq a => Eq (SwapResult a) Source # 
Instance details

Defined in Cursor.Tree.Swap

Methods

(==) :: SwapResult a -> SwapResult a -> Bool #

(/=) :: SwapResult a -> SwapResult a -> Bool #

Show a => Show (SwapResult a) Source # 
Instance details

Defined in Cursor.Tree.Swap

Generic (SwapResult a) Source # 
Instance details

Defined in Cursor.Tree.Swap

Associated Types

type Rep (SwapResult a) :: Type -> Type #

Methods

from :: SwapResult a -> Rep (SwapResult a) x #

to :: Rep (SwapResult a) x -> SwapResult a #

NFData a => NFData (SwapResult a) Source # 
Instance details

Defined in Cursor.Tree.Swap

Methods

rnf :: SwapResult a -> () #

Validity a => Validity (SwapResult a) Source # 
Instance details

Defined in Cursor.Tree.Swap

type Rep (SwapResult a) Source # 
Instance details

Defined in Cursor.Tree.Swap

type Rep (SwapResult a) = D1 ('MetaData "SwapResult" "Cursor.Tree.Swap" "cursor-0.3.1.0-2FAY4bJgmEY7nee1TnZoZ6" 'False) (C1 ('MetaCons "SwapperIsTopNode" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "NoSiblingsToSwapWith" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Swapped" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a))))

data PromoteElemResult a Source #

Instances

Instances details
Monad PromoteElemResult Source # 
Instance details

Defined in Cursor.Tree.Promote

Functor PromoteElemResult Source # 
Instance details

Defined in Cursor.Tree.Promote

Applicative PromoteElemResult Source # 
Instance details

Defined in Cursor.Tree.Promote

Eq a => Eq (PromoteElemResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

Show a => Show (PromoteElemResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

Generic (PromoteElemResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

Associated Types

type Rep (PromoteElemResult a) :: Type -> Type #

NFData a => NFData (PromoteElemResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

Methods

rnf :: PromoteElemResult a -> () #

Validity a => Validity (PromoteElemResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

type Rep (PromoteElemResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

type Rep (PromoteElemResult a) = D1 ('MetaData "PromoteElemResult" "Cursor.Tree.Promote" "cursor-0.3.1.0-2FAY4bJgmEY7nee1TnZoZ6" 'False) ((C1 ('MetaCons "CannotPromoteTopElem" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NoGrandparentToPromoteElemUnder" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "NoSiblingsToAdoptChildren" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PromotedElem" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a))))

data PromoteResult a Source #

Instances

Instances details
Monad PromoteResult Source # 
Instance details

Defined in Cursor.Tree.Promote

Functor PromoteResult Source # 
Instance details

Defined in Cursor.Tree.Promote

Methods

fmap :: (a -> b) -> PromoteResult a -> PromoteResult b #

(<$) :: a -> PromoteResult b -> PromoteResult a #

Applicative PromoteResult Source # 
Instance details

Defined in Cursor.Tree.Promote

Eq a => Eq (PromoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

Show a => Show (PromoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

Generic (PromoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

Associated Types

type Rep (PromoteResult a) :: Type -> Type #

NFData a => NFData (PromoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

Methods

rnf :: PromoteResult a -> () #

Validity a => Validity (PromoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

type Rep (PromoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Promote

type Rep (PromoteResult a) = D1 ('MetaData "PromoteResult" "Cursor.Tree.Promote" "cursor-0.3.1.0-2FAY4bJgmEY7nee1TnZoZ6" 'False) (C1 ('MetaCons "CannotPromoteTopNode" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "NoGrandparentToPromoteUnder" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Promoted" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a))))

data DemoteResult a Source #

Instances

Instances details
Functor DemoteResult Source # 
Instance details

Defined in Cursor.Tree.Demote

Methods

fmap :: (a -> b) -> DemoteResult a -> DemoteResult b #

(<$) :: a -> DemoteResult b -> DemoteResult a #

Eq a => Eq (DemoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Demote

Show a => Show (DemoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Demote

Generic (DemoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Demote

Associated Types

type Rep (DemoteResult a) :: Type -> Type #

Methods

from :: DemoteResult a -> Rep (DemoteResult a) x #

to :: Rep (DemoteResult a) x -> DemoteResult a #

NFData a => NFData (DemoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Demote

Methods

rnf :: DemoteResult a -> () #

Validity a => Validity (DemoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Demote

type Rep (DemoteResult a) Source # 
Instance details

Defined in Cursor.Tree.Demote

type Rep (DemoteResult a) = D1 ('MetaData "DemoteResult" "Cursor.Tree.Demote" "cursor-0.3.1.0-2FAY4bJgmEY7nee1TnZoZ6" 'False) (C1 ('MetaCons "CannotDemoteTopNode" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "NoSiblingsToDemoteUnder" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Demoted" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a))))

treeCursorDemoteElemUnder :: b -> b -> TreeCursor a b -> Maybe (TreeCursor 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:

 p
 |- a <--
    |- b

After:

 p
 |- <given element 1>
 |  |- a <--
 |- <given element 2>
 |  |- b

treeCursorDemoteSubTreeUnder :: b -> TreeCursor a b -> TreeCursor 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

data CTree a Source #

Constructors

CNode !a (CForest a) 

Instances

Instances details
Functor CTree Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

fmap :: (a -> b) -> CTree a -> CTree b #

(<$) :: a -> CTree b -> CTree a #

Eq a => Eq (CTree a) Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

(==) :: CTree a -> CTree a -> Bool #

(/=) :: CTree a -> CTree a -> Bool #

Show a => Show (CTree a) Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

showsPrec :: Int -> CTree a -> ShowS #

show :: CTree a -> String #

showList :: [CTree a] -> ShowS #

Generic (CTree a) Source # 
Instance details

Defined in Cursor.Tree.Types

Associated Types

type Rep (CTree a) :: Type -> Type #

Methods

from :: CTree a -> Rep (CTree a) x #

to :: Rep (CTree a) x -> CTree a #

NFData a => NFData (CTree a) Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

rnf :: CTree a -> () #

Validity a => Validity (CTree a) Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

validate :: CTree a -> Validation #

type Rep (CTree a) Source # 
Instance details

Defined in Cursor.Tree.Types

type Rep (CTree a) = D1 ('MetaData "CTree" "Cursor.Tree.Types" "cursor-0.3.1.0-2FAY4bJgmEY7nee1TnZoZ6" '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))))

data CForest a Source #

Instances

Instances details
Functor CForest Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

fmap :: (a -> b) -> CForest a -> CForest b #

(<$) :: a -> CForest b -> CForest a #

Eq a => Eq (CForest a) Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

(==) :: CForest a -> CForest a -> Bool #

(/=) :: CForest a -> CForest a -> Bool #

Show a => Show (CForest a) Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

showsPrec :: Int -> CForest a -> ShowS #

show :: CForest a -> String #

showList :: [CForest a] -> ShowS #

Generic (CForest a) Source # 
Instance details

Defined in Cursor.Tree.Types

Associated Types

type Rep (CForest a) :: Type -> Type #

Methods

from :: CForest a -> Rep (CForest a) x #

to :: Rep (CForest a) x -> CForest a #

NFData a => NFData (CForest a) Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

rnf :: CForest a -> () #

Validity a => Validity (CForest a) Source # 
Instance details

Defined in Cursor.Tree.Types

Methods

validate :: CForest a -> Validation #

type Rep (CForest a) Source # 
Instance details

Defined in Cursor.Tree.Types

type Rep (CForest a) = D1 ('MetaData "CForest" "Cursor.Tree.Types" "cursor-0.3.1.0-2FAY4bJgmEY7nee1TnZoZ6" '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))))))

cTree :: Bool -> Tree a -> CTree a Source #