rosebud-0.2.0.0: Common rose tree/forest functions
Safe HaskellSafe-Inferred
LanguageHaskell2010

Rosebud

Synopsis

Introduction

This module captures functions and patterns often reached for when working with Data.Tree from the containers package.

Re-exports

data Tree a #

Non-empty, possibly infinite, multi-way trees; also known as rose trees.

Constructors

Node 

Fields

Instances

Instances details
Monad Tree 
Instance details

Defined in Data.Tree

Methods

(>>=) :: Tree a -> (a -> Tree b) -> Tree b #

(>>) :: Tree a -> Tree b -> Tree b #

return :: a -> Tree a #

Functor Tree 
Instance details

Defined in Data.Tree

Methods

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

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

MonadFix Tree

Since: containers-0.5.11

Instance details

Defined in Data.Tree

Methods

mfix :: (a -> Tree a) -> Tree a #

Applicative Tree 
Instance details

Defined in Data.Tree

Methods

pure :: a -> Tree a #

(<*>) :: Tree (a -> b) -> Tree a -> Tree b #

liftA2 :: (a -> b -> c) -> Tree a -> Tree b -> Tree c #

(*>) :: Tree a -> Tree b -> Tree b #

(<*) :: Tree a -> Tree b -> Tree a #

Foldable Tree 
Instance details

Defined in Data.Tree

Methods

fold :: Monoid m => Tree m -> m #

foldMap :: Monoid m => (a -> m) -> Tree a -> m #

foldMap' :: Monoid m => (a -> m) -> Tree a -> m #

foldr :: (a -> b -> b) -> b -> Tree a -> b #

foldr' :: (a -> b -> b) -> b -> Tree a -> b #

foldl :: (b -> a -> b) -> b -> Tree a -> b #

foldl' :: (b -> a -> b) -> b -> Tree a -> b #

foldr1 :: (a -> a -> a) -> Tree a -> a #

foldl1 :: (a -> a -> a) -> Tree a -> a #

toList :: Tree a -> [a] #

null :: Tree a -> Bool #

length :: Tree a -> Int #

elem :: Eq a => a -> Tree a -> Bool #

maximum :: Ord a => Tree a -> a #

minimum :: Ord a => Tree a -> a #

sum :: Num a => Tree a -> a #

product :: Num a => Tree a -> a #

Traversable Tree 
Instance details

Defined in Data.Tree

Methods

traverse :: Applicative f => (a -> f b) -> Tree a -> f (Tree b) #

sequenceA :: Applicative f => Tree (f a) -> f (Tree a) #

mapM :: Monad m => (a -> m b) -> Tree a -> m (Tree b) #

sequence :: Monad m => Tree (m a) -> m (Tree a) #

Eq1 Tree

Since: containers-0.5.9

Instance details

Defined in Data.Tree

Methods

liftEq :: (a -> b -> Bool) -> Tree a -> Tree b -> Bool #

Ord1 Tree

Since: containers-0.5.9

Instance details

Defined in Data.Tree

Methods

liftCompare :: (a -> b -> Ordering) -> Tree a -> Tree b -> Ordering #

Read1 Tree

Since: containers-0.5.9

Instance details

Defined in Data.Tree

Methods

liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Tree a) #

liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [Tree a] #

liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Tree a) #

liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [Tree a] #

Show1 Tree

Since: containers-0.5.9

Instance details

Defined in Data.Tree

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Tree a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Tree a] -> ShowS #

MonadZip Tree 
Instance details

Defined in Data.Tree

Methods

mzip :: Tree a -> Tree b -> Tree (a, b) #

mzipWith :: (a -> b -> c) -> Tree a -> Tree b -> Tree c #

munzip :: Tree (a, b) -> (Tree a, Tree b) #

Eq a => Eq (Tree a) 
Instance details

Defined in Data.Tree

Methods

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

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

Data a => Data (Tree a) 
Instance details

Defined in Data.Tree

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Tree a -> c (Tree a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Tree a) #

toConstr :: Tree a -> Constr #

dataTypeOf :: Tree a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Tree a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a)) #

gmapT :: (forall b. Data b => b -> b) -> Tree a -> Tree a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Tree a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Tree a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Tree a -> m (Tree a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Tree a -> m (Tree a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Tree a -> m (Tree a) #

Read a => Read (Tree a) 
Instance details

Defined in Data.Tree

Show a => Show (Tree a) 
Instance details

Defined in Data.Tree

Methods

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

show :: Tree a -> String #

showList :: [Tree a] -> ShowS #

Generic (Tree a)

Since: containers-0.5.8

Instance details

Defined in Data.Tree

Associated Types

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

Methods

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

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

NFData a => NFData (Tree a) 
Instance details

Defined in Data.Tree

Methods

rnf :: Tree a -> () #

Generic1 Tree

Since: containers-0.5.8

Instance details

Defined in Data.Tree

Associated Types

type Rep1 Tree :: k -> Type #

Methods

from1 :: forall (a :: k). Tree a -> Rep1 Tree a #

to1 :: forall (a :: k). Rep1 Tree a -> Tree a #

type Rep (Tree a) 
Instance details

Defined in Data.Tree

type Rep (Tree a) = D1 ('MetaData "Tree" "Data.Tree" "containers-0.6.2.1" 'False) (C1 ('MetaCons "Node" 'PrefixI 'True) (S1 ('MetaSel ('Just "rootLabel") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Just "subForest") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Forest a))))
type Rep1 Tree 
Instance details

Defined in Data.Tree

type Rep1 Tree = D1 ('MetaData "Tree" "Data.Tree" "containers-0.6.2.1" 'False) (C1 ('MetaCons "Node" 'PrefixI 'True) (S1 ('MetaSel ('Just "rootLabel") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) Par1 :*: S1 ('MetaSel ('Just "subForest") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) ([] :.: Rec1 Tree)))

type Forest a = [Tree a] #

Types

type NEForest a = NonEmpty (Tree a) Source #

A convenience type alias for a non-empty Forest.

Since: 0.1.0.0

Sorting

Trees

sortTree :: Ord a => Tree a -> Tree a Source #

Sort from lowest to highest at each level in the Tree.

Since: 0.1.0.0

sortTreeOn :: Ord b => (a -> b) -> Tree a -> Tree a Source #

Sort from lowest to highest at each level in the Tree, using the results of a key function applied to each label.

Since: 0.1.0.0

Forests

sortForest :: Ord a => Forest a -> Forest a Source #

For each Tree in the Forest, sort from lowest to highest at each level in the Tree. The Forest itself is also sorted from lowest to highest via the root labels of each Tree in the Forest.

Since: 0.1.0.0

sortForestOn :: Ord b => (a -> b) -> Forest a -> Forest a Source #

For each Tree in the Forest, sort from lowest to highest at each level in the Tree, using the results of a key function applied at each label. The Forest itself is also sorted from lowest to highest via applying the key function to the root labels of each Tree in the Forest.

Since: 0.1.0.0

sortNEForest :: Ord a => NEForest a -> NEForest a Source #

For each Tree in the NEForest, sort from lowest to highest at each level in the Tree. The NEForest itself is also sorted from lowest to highest via the root labels of each Tree in the NEForest.

Since: 0.1.0.0

sortNEForestOn :: Ord b => (a -> b) -> NEForest a -> NEForest a Source #

For each Tree in the NEForest, sort from lowest to highest at each level in the Tree, using the results of a key function applied at each label. The NEForest itself is also sorted from lowest to highest via applying the key function to the root labels of each Tree in the NEForest.

Since: 0.1.0.0

Searching

Trees

findNodeInTree :: (a -> Bool) -> Tree a -> Maybe (Tree a) Source #

Find a particular Node in a Tree via the provided label predicate. Unlike find, this function will return the entire subtree instead of just the label value.

Since: 0.1.0.0

isSubtreeOf :: Ord a => Tree a -> Tree a -> Bool Source #

Check if the first Tree is a subtree of the second, meaning each level of labels in the first Tree exists in a subtree of the second regardless of the label ordering at each level.

Since: 0.1.0.0

isExactSubtreeOf :: Eq a => Tree a -> Tree a -> Bool Source #

Check if the first Tree is an exact subtree of the second, meaning each level of labels in the first Tree exists in the same order in a subtree of the second.

Since: 0.1.0.0

isSubtreeOfUsing Source #

Arguments

:: forall a. Eq a 
=> (Tree a -> Tree a)

Transforms Tree values prior to equality-checking

-> Tree a 
-> Tree a 
-> Bool 

Check if the first Tree is a subtree of the second via equality of the first Tree with any node in the second Tree.

This is a lower-level function. Users should prefer isSubtreeOf and isExactSubtreeOf over this function. The function argument enables pre-processing over the Tree values involved, before equality-checking is performed.

Since: 0.1.0.0

Forests

findNodeInForest :: Foldable t => (a -> Bool) -> t (Tree a) -> Maybe (Tree a) Source #

Find a particular Node in a forest via the provided label predicate. This function delegates to findNodeInTree for each Tree in the forest.

Since: 0.1.0.0

isSubtreeIn :: (Foldable t, Ord a) => Tree a -> t (Tree a) -> Bool Source #

Check if the Tree is a subtree in the forest, meaning each level of labels in the Tree exists in a subtree of some Tree in the forest regardless of the label ordering at each level.

Since: 0.1.0.0

isExactSubtreeIn :: (Eq a, Foldable t) => Tree a -> t (Tree a) -> Bool Source #

Check if the Tree is an exact subtree in the forest, meaning each level of labels in the Tree exists in the same order in a subtree of some Tree in the forest.

Since: 0.1.0.0

isSubtreeInUsing Source #

Arguments

:: (Eq a, Foldable t) 
=> (Tree a -> Tree a)

Transforms Tree values prior to equality-checking

-> Tree a 
-> t (Tree a) 
-> Bool 

Check if the first Tree is a subtree in the forest via equality of the first Tree with any node in any Tree in the forest.

This is a lower-level function. Users should prefer isSubtreeIn and isExactSubtreeIn over this function. The function argument enables pre-processing over the Tree values involved, before equality-checking is performed.

Since: 0.1.0.0

Transformation

Trees

enumerateTree :: (Enum a, Num a) => Tree b -> Tree (a, b) Source #

Number each level of labels in the tree, starting from 0 at each level.

Since: 0.1.0.0

zipTree :: Tree a -> Tree b -> Tree (a, b) Source #

Given two input Tree values, provide a Tree of corresponding label pairs. This function exists for the convenience of not needing to import Control.Monad.Zip.

Since: 0.1.0.0

zipWithTree :: (a -> b -> c) -> Tree a -> Tree b -> Tree c Source #

Generalizes zipTree by zipping label values via the provided function. This function exists for the convenience of not needing to import Control.Monad.Zip.

Since: 0.1.0.0

pathsTree :: forall a. Tree a -> NonEmpty (Seq a) Source #

Produce all the paths for the given Tree.

λ> pathsTree $ Node 1 [Node 2 [Node 4 [], Node 5 []], Node 3 []]
fromList [1] :| [fromList [1,2],fromList [1,2,4],fromList [1,2,5],fromList [1,3]]

Since: 0.1.0.0

leavesTree :: Tree a -> NonEmpty a Source #

Produce all the leaves for the given Tree.

Since: 0.1.0.0

Forests

enumerateForest :: (Enum a, Num a) => Forest b -> Forest (a, b) Source #

Number each level of labels in the Forest, starting from 0 at each level.

Since: 0.1.0.0

enumerateNEForest :: (Enum a, Num a) => NEForest b -> NEForest (a, b) Source #

Number each level of labels in the NEForest, starting from 0 at each level.

Since: 0.1.0.0

mapForest :: (a -> b) -> Forest a -> Forest b Source #

Apply a function to each label in each Tree in the Forest.

Since: 0.1.0.0

mapNEForest :: (a -> b) -> NEForest a -> NEForest b Source #

Apply a function to each label in each Tree in the NEForest.

Since: 0.1.0.0

zipForest :: Forest a -> Forest b -> Forest (a, b) Source #

Given two input Forest values, provide a Forest of corresponding label pairs.

Since: 0.1.0.0

zipNEForest :: NEForest a -> NEForest b -> NEForest (a, b) Source #

Given two input NEForest values, provide an NEForest of corresponding label pairs.

Since: 0.1.0.0

zipWithForest :: (a -> b -> c) -> Forest a -> Forest b -> Forest c Source #

Generalizes zipForest by zipping label values via the provided function.

Since: 0.1.0.0

zipWithNEForest :: (a -> b -> c) -> NEForest a -> NEForest b -> NEForest c Source #

Generalizes zipNEForest by zipping label values via the provided function.

Since: 0.1.0.0

pathsForest :: Forest a -> Maybe (NonEmpty (Seq a)) Source #

Produce all the paths for the given Forest, if any Tree values exist in the Forest.

Since: 0.1.0.0

pathsNEForest :: NEForest a -> NonEmpty (Seq a) Source #

Produce all the paths for the given NEForest.

Since: 0.1.0.0

leavesForest :: Forest a -> Maybe (NonEmpty a) Source #

Produce all the leaves for the given Forest, if any Tree values exist in the 'Forest.

Since: 0.1.0.0

leavesNEForest :: NEForest a -> NonEmpty a Source #

Produce all the leaves for the given NEForest.

Since: 0.1.0.0

flattenForest :: Forest a -> [a] Source #

Flatten each Tree in the input Forest, then concatenate the results.

Since: 0.1.0.0

flattenNEForest :: NEForest a -> NonEmpty a Source #

Flatten each Tree in the input NEForest, then concatenate the results.

Since: 0.1.0.0

Construction

Trees

singletonTree :: a -> Tree a Source #

Creates a Tree containing the provided label and no children.

Since: 0.1.0.0

indicesTree :: (Enum a, Num a) => Tree a Source #

Produce an infinite Tree of indices, starting from 0 at each level.

Since: 0.1.0.0

eitherTreeFromLabels Source #

Arguments

:: (a -> a -> Bool)

Is the first label an immediate child of the second?

-> a

Root label

-> [a]

Flat list of child labels

-> Either (FromPartitionedLabelsError a) (Tree a) 

Build a Tree from a root label and a flat list of child labels.

Since: 0.2.0.0

unsafeTreeFromLabels Source #

Arguments

:: (Show a, Typeable a) 
=> (a -> a -> Bool)

Is the first label an immediate child of the second?

-> a

Root label

-> [a]

Flat list of labels

-> Tree a 

Build a Tree from a root label and a flat list of child labels.

Throws FromPartitionedLabelsError if anything goes wrong when building the Tree.

Since: 0.2.0.0

Forests

singletonForest :: a -> Forest a Source #

Creates a Forest containing a single Tree that contains the provided label and no children.

Since: 0.1.0.0

singletonNEForest :: a -> NEForest a Source #

Creates an NEForest containing a single Tree that contains the provided label and no children.

Since: 0.1.0.0

indicesForest :: (Enum a, Num a) => Forest a Source #

Produce an infinite Forest of indices, starting from 0 at each level.

Since: 0.1.0.0

indicesNEForest :: (Enum a, Num a) => NEForest a Source #

Produce an infinite NEForest of indices, starting from 0 at each level.

Since: 0.1.0.0

subtrees :: Tree a -> Forest a Source #

Produces all subtrees of the given Tree.

The output is a Forest out of convenience, but is guaranteed non-empty as a Tree itself is non-empty by construction. See neSubtrees for a variant that returns an NEForest.

Since: 0.1.0.0

neSubtrees :: Tree a -> NEForest a Source #

Produces all subtrees of the given Tree.

Since: 0.1.0.0

eitherNEForestFromPartitionedLabels Source #

Arguments

:: forall a. (a -> a -> Bool)

Is the first label an immediate child of the second?

-> NonEmpty a

Flat list of root labels

-> [a]

Flat list of child labels

-> Either (FromPartitionedLabelsError a) (NEForest a) 

Build an NEForest from flat input lists of root and child labels.

Since: 0.2.0.0

unsafeNEForestFromPartitionedLabels Source #

Arguments

:: (Show a, Typeable a) 
=> (a -> a -> Bool)

Is the first label an immediate child of the second?

-> NonEmpty a

Flat list of root labels

-> [a]

Flat list of child labels

-> NEForest a 

Build an NEForest from flat input lists of root and child labels.

Throws FromPartitionedLabelsError if anything goes wrong when building the NEForest.

Since: 0.2.0.0

eitherNEForestFromLabels Source #

Arguments

:: forall a. (a -> Bool)

Is the label a root?

-> (a -> a -> Bool)

Is the first label an immediate child of the second?

-> NonEmpty a

Flat list of labels

-> Either (FromLabelsError a) (NEForest a) 

Build an NEForest from a flat input list of labels.

Since: 0.1.0.0

unsafeNEForestFromLabels Source #

Arguments

:: (Show a, Typeable a) 
=> (a -> Bool)

Is the label a root?

-> (a -> a -> Bool)

Is the first label an immediate child of the second?

-> NonEmpty a

Flat list of labels

-> NEForest a 

Build an NEForest from a flat input list of labels.

Throws FromLabelsError if anything goes wrong when building the NEForest.

Since: 0.1.0.0

neForest :: Forest a -> Maybe (NEForest a) Source #

Build an NEForest from a Forest, producing Nothing if the input Forest is empty.

Since: 0.1.0.0

unsafeNEForest :: Forest a -> NEForest a Source #

Build an NEForest from a Forest, raising an error if the input Forest is empty.

Since: 0.1.0.0

Errors

data FromPartitionedLabelsError a Source #

The error type when building a Tree/NEForest from labels already partitioned into roots and children.

Since: 0.2.0.0

Constructors

OrphansFoundError (NEForest a) (NonEmpty a)

Orphan labels were found. Provides the assembled NEForest and a flat list of orphan labels.

Since: 0.2.0.0

Instances

Instances details
Eq a => Eq (FromPartitionedLabelsError a) Source # 
Instance details

Defined in Rosebud

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

Defined in Rosebud

Generic (FromPartitionedLabelsError a) Source # 
Instance details

Defined in Rosebud

Associated Types

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

(Typeable a, Show a) => Exception (FromPartitionedLabelsError a) Source # 
Instance details

Defined in Rosebud

type Rep (FromPartitionedLabelsError a) Source # 
Instance details

Defined in Rosebud

type Rep (FromPartitionedLabelsError a) = D1 ('MetaData "FromPartitionedLabelsError" "Rosebud" "rosebud-0.2.0.0-DfNlAJyMIDADLYcWtp2ufx" 'False) (C1 ('MetaCons "OrphansFoundError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NEForest a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty a))))

data FromLabelsError a Source #

The error type when building an NEForest from a flat list of labels.

Since: 0.2.0.0

Constructors

NoRootsFoundError (NonEmpty a)

No root label(s) were found. Provides the flat list of input labels.

Since: 0.2.0.0

FromPartitionedLabels (FromPartitionedLabelsError a)

Produced via internally building from partitioned labels.

Since: 0.2.0.0

Instances

Instances details
Eq a => Eq (FromLabelsError a) Source # 
Instance details

Defined in Rosebud

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

Defined in Rosebud

Generic (FromLabelsError a) Source # 
Instance details

Defined in Rosebud

Associated Types

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

(Typeable a, Show a) => Exception (FromLabelsError a) Source # 
Instance details

Defined in Rosebud

type Rep (FromLabelsError a) Source # 
Instance details

Defined in Rosebud

type Rep (FromLabelsError a) = D1 ('MetaData "FromLabelsError" "Rosebud" "rosebud-0.2.0.0-DfNlAJyMIDADLYcWtp2ufx" 'False) (C1 ('MetaCons "NoRootsFoundError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty a))) :+: C1 ('MetaCons "FromPartitionedLabels" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (FromPartitionedLabelsError a))))