{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Rosebud
(
Tree(Node, rootLabel, subForest)
, Forest
, NEForest
, sortTree
, sortTreeOn
, sortForest
, sortForestOn
, sortNEForest
, sortNEForestOn
, findNodeInTree
, isSubtreeOf
, isExactSubtreeOf
, isSubtreeOfUsing
, findNodeInForest
, isSubtreeIn
, isExactSubtreeIn
, isSubtreeInUsing
, enumerateTree
, zipTree
, zipWithTree
, pathsTree
, leavesTree
, enumerateForest
, enumerateNEForest
, mapForest
, mapNEForest
, zipForest
, zipNEForest
, zipWithForest
, zipWithNEForest
, pathsForest
, pathsNEForest
, leavesForest
, leavesNEForest
, flattenForest
, flattenNEForest
, singletonTree
, indicesTree
, eitherTreeFromLabels
, unsafeTreeFromLabels
, singletonForest
, singletonNEForest
, indicesForest
, indicesNEForest
, subtrees
, neSubtrees
, eitherNEForestFromPartitionedLabels
, unsafeNEForestFromPartitionedLabels
, eitherNEForestFromLabels
, unsafeNEForestFromLabels
, neForest
, unsafeNEForest
, FromPartitionedLabelsError(OrphansFoundError)
, FromLabelsError(NoRootsFoundError, FromPartitionedLabels)
) where
import Control.Exception (Exception)
import Control.Monad.Trans.State (State)
import Data.List.NonEmpty (NonEmpty((:|)), NonEmpty)
import Data.Monoid (Alt(Alt))
import Data.Sequence ((<|), Seq)
import Data.Tree (Tree(Node, rootLabel, subForest), Forest)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Prelude
import qualified Control.Exception as Ex
import qualified Control.Monad.Trans.State as State
import qualified Control.Monad.Zip as Zip
import qualified Data.Bifunctor as Bifunctor
import qualified Data.Foldable as Foldable
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Monoid as Monoid
import qualified Data.Ord as Ord
import qualified Data.Semigroup as Semigroup
import qualified Data.Traversable as Traversable
import qualified Data.Tree as Tree
type NEForest a = NonEmpty (Tree a)
data FromPartitionedLabelsError a
=
OrphansFoundError (NEForest a) (NonEmpty a)
deriving stock (FromPartitionedLabelsError a
-> FromPartitionedLabelsError a -> Bool
(FromPartitionedLabelsError a
-> FromPartitionedLabelsError a -> Bool)
-> (FromPartitionedLabelsError a
-> FromPartitionedLabelsError a -> Bool)
-> Eq (FromPartitionedLabelsError a)
forall a.
Eq a =>
FromPartitionedLabelsError a
-> FromPartitionedLabelsError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromPartitionedLabelsError a
-> FromPartitionedLabelsError a -> Bool
$c/= :: forall a.
Eq a =>
FromPartitionedLabelsError a
-> FromPartitionedLabelsError a -> Bool
== :: FromPartitionedLabelsError a
-> FromPartitionedLabelsError a -> Bool
$c== :: forall a.
Eq a =>
FromPartitionedLabelsError a
-> FromPartitionedLabelsError a -> Bool
Eq, Int -> FromPartitionedLabelsError a -> ShowS
[FromPartitionedLabelsError a] -> ShowS
FromPartitionedLabelsError a -> String
(Int -> FromPartitionedLabelsError a -> ShowS)
-> (FromPartitionedLabelsError a -> String)
-> ([FromPartitionedLabelsError a] -> ShowS)
-> Show (FromPartitionedLabelsError a)
forall a. Show a => Int -> FromPartitionedLabelsError a -> ShowS
forall a. Show a => [FromPartitionedLabelsError a] -> ShowS
forall a. Show a => FromPartitionedLabelsError a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromPartitionedLabelsError a] -> ShowS
$cshowList :: forall a. Show a => [FromPartitionedLabelsError a] -> ShowS
show :: FromPartitionedLabelsError a -> String
$cshow :: forall a. Show a => FromPartitionedLabelsError a -> String
showsPrec :: Int -> FromPartitionedLabelsError a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FromPartitionedLabelsError a -> ShowS
Show, (forall x.
FromPartitionedLabelsError a
-> Rep (FromPartitionedLabelsError a) x)
-> (forall x.
Rep (FromPartitionedLabelsError a) x
-> FromPartitionedLabelsError a)
-> Generic (FromPartitionedLabelsError a)
forall x.
Rep (FromPartitionedLabelsError a) x
-> FromPartitionedLabelsError a
forall x.
FromPartitionedLabelsError a
-> Rep (FromPartitionedLabelsError a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x.
Rep (FromPartitionedLabelsError a) x
-> FromPartitionedLabelsError a
forall a x.
FromPartitionedLabelsError a
-> Rep (FromPartitionedLabelsError a) x
$cto :: forall a x.
Rep (FromPartitionedLabelsError a) x
-> FromPartitionedLabelsError a
$cfrom :: forall a x.
FromPartitionedLabelsError a
-> Rep (FromPartitionedLabelsError a) x
Generic)
deriving anyclass (Show (FromPartitionedLabelsError a)
Typeable (FromPartitionedLabelsError a)
Typeable (FromPartitionedLabelsError a)
-> Show (FromPartitionedLabelsError a)
-> (FromPartitionedLabelsError a -> SomeException)
-> (SomeException -> Maybe (FromPartitionedLabelsError a))
-> (FromPartitionedLabelsError a -> String)
-> Exception (FromPartitionedLabelsError a)
SomeException -> Maybe (FromPartitionedLabelsError a)
FromPartitionedLabelsError a -> String
FromPartitionedLabelsError a -> SomeException
forall a.
(Typeable a, Show a) =>
Show (FromPartitionedLabelsError a)
forall a.
(Typeable a, Show a) =>
Typeable (FromPartitionedLabelsError a)
forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (FromPartitionedLabelsError a)
forall a.
(Typeable a, Show a) =>
FromPartitionedLabelsError a -> String
forall a.
(Typeable a, Show a) =>
FromPartitionedLabelsError a -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: FromPartitionedLabelsError a -> String
$cdisplayException :: forall a.
(Typeable a, Show a) =>
FromPartitionedLabelsError a -> String
fromException :: SomeException -> Maybe (FromPartitionedLabelsError a)
$cfromException :: forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (FromPartitionedLabelsError a)
toException :: FromPartitionedLabelsError a -> SomeException
$ctoException :: forall a.
(Typeable a, Show a) =>
FromPartitionedLabelsError a -> SomeException
$cp2Exception :: forall a.
(Typeable a, Show a) =>
Show (FromPartitionedLabelsError a)
$cp1Exception :: forall a.
(Typeable a, Show a) =>
Typeable (FromPartitionedLabelsError a)
Exception)
data FromLabelsError a
=
NoRootsFoundError (NonEmpty a)
| FromPartitionedLabels (FromPartitionedLabelsError a)
deriving stock (FromLabelsError a -> FromLabelsError a -> Bool
(FromLabelsError a -> FromLabelsError a -> Bool)
-> (FromLabelsError a -> FromLabelsError a -> Bool)
-> Eq (FromLabelsError a)
forall a. Eq a => FromLabelsError a -> FromLabelsError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromLabelsError a -> FromLabelsError a -> Bool
$c/= :: forall a. Eq a => FromLabelsError a -> FromLabelsError a -> Bool
== :: FromLabelsError a -> FromLabelsError a -> Bool
$c== :: forall a. Eq a => FromLabelsError a -> FromLabelsError a -> Bool
Eq, Int -> FromLabelsError a -> ShowS
[FromLabelsError a] -> ShowS
FromLabelsError a -> String
(Int -> FromLabelsError a -> ShowS)
-> (FromLabelsError a -> String)
-> ([FromLabelsError a] -> ShowS)
-> Show (FromLabelsError a)
forall a. Show a => Int -> FromLabelsError a -> ShowS
forall a. Show a => [FromLabelsError a] -> ShowS
forall a. Show a => FromLabelsError a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromLabelsError a] -> ShowS
$cshowList :: forall a. Show a => [FromLabelsError a] -> ShowS
show :: FromLabelsError a -> String
$cshow :: forall a. Show a => FromLabelsError a -> String
showsPrec :: Int -> FromLabelsError a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FromLabelsError a -> ShowS
Show, (forall x. FromLabelsError a -> Rep (FromLabelsError a) x)
-> (forall x. Rep (FromLabelsError a) x -> FromLabelsError a)
-> Generic (FromLabelsError a)
forall x. Rep (FromLabelsError a) x -> FromLabelsError a
forall x. FromLabelsError a -> Rep (FromLabelsError a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FromLabelsError a) x -> FromLabelsError a
forall a x. FromLabelsError a -> Rep (FromLabelsError a) x
$cto :: forall a x. Rep (FromLabelsError a) x -> FromLabelsError a
$cfrom :: forall a x. FromLabelsError a -> Rep (FromLabelsError a) x
Generic)
deriving anyclass (Show (FromLabelsError a)
Typeable (FromLabelsError a)
Typeable (FromLabelsError a)
-> Show (FromLabelsError a)
-> (FromLabelsError a -> SomeException)
-> (SomeException -> Maybe (FromLabelsError a))
-> (FromLabelsError a -> String)
-> Exception (FromLabelsError a)
SomeException -> Maybe (FromLabelsError a)
FromLabelsError a -> String
FromLabelsError a -> SomeException
forall a. (Typeable a, Show a) => Show (FromLabelsError a)
forall a. (Typeable a, Show a) => Typeable (FromLabelsError a)
forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (FromLabelsError a)
forall a. (Typeable a, Show a) => FromLabelsError a -> String
forall a.
(Typeable a, Show a) =>
FromLabelsError a -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: FromLabelsError a -> String
$cdisplayException :: forall a. (Typeable a, Show a) => FromLabelsError a -> String
fromException :: SomeException -> Maybe (FromLabelsError a)
$cfromException :: forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (FromLabelsError a)
toException :: FromLabelsError a -> SomeException
$ctoException :: forall a.
(Typeable a, Show a) =>
FromLabelsError a -> SomeException
$cp2Exception :: forall a. (Typeable a, Show a) => Show (FromLabelsError a)
$cp1Exception :: forall a. (Typeable a, Show a) => Typeable (FromLabelsError a)
Exception)
sortTree :: (Ord a) => Tree a -> Tree a
sortTree :: Tree a -> Tree a
sortTree = (a -> a) -> Tree a -> Tree a
forall b a. Ord b => (a -> b) -> Tree a -> Tree a
sortTreeOn a -> a
forall a. a -> a
id
sortTreeOn :: (Ord b) => (a -> b) -> Tree a -> Tree a
sortTreeOn :: (a -> b) -> Tree a -> Tree a
sortTreeOn a -> b
f =
(Tree a -> (a, [Tree a])) -> Tree a -> Tree a
forall b a. (b -> (a, [b])) -> b -> Tree a
Tree.unfoldTree \Node { a
rootLabel :: a
rootLabel :: forall a. Tree a -> a
rootLabel, [Tree a]
subForest :: [Tree a]
subForest :: forall a. Tree a -> Forest a
subForest } ->
(a
rootLabel, (Tree a -> b) -> [Tree a] -> [Tree a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (a -> b
f (a -> b) -> (Tree a -> a) -> Tree a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> a
forall a. Tree a -> a
Tree.rootLabel) [Tree a]
subForest)
sortForest :: (Ord a) => Forest a -> Forest a
sortForest :: Forest a -> Forest a
sortForest = (a -> a) -> Forest a -> Forest a
forall b a. Ord b => (a -> b) -> Forest a -> Forest a
sortForestOn a -> a
forall a. a -> a
id
sortForestOn :: (Ord b) => (a -> b) -> Forest a -> Forest a
sortForestOn :: (a -> b) -> Forest a -> Forest a
sortForestOn a -> b
f =
(Tree a -> b) -> Forest a -> Forest a
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (a -> b
f (a -> b) -> (Tree a -> a) -> Tree a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> a
forall a. Tree a -> a
Tree.rootLabel) (Forest a -> Forest a)
-> (Forest a -> Forest a) -> Forest a -> Forest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> Tree a) -> Forest a -> Forest a
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Tree a -> Tree a
forall b a. Ord b => (a -> b) -> Tree a -> Tree a
sortTreeOn a -> b
f)
sortNEForest :: (Ord a) => NEForest a -> NEForest a
sortNEForest :: NEForest a -> NEForest a
sortNEForest = (a -> a) -> NEForest a -> NEForest a
forall b a. Ord b => (a -> b) -> NEForest a -> NEForest a
sortNEForestOn a -> a
forall a. a -> a
id
sortNEForestOn :: (Ord b) => (a -> b) -> NEForest a -> NEForest a
sortNEForestOn :: (a -> b) -> NEForest a -> NEForest a
sortNEForestOn a -> b
f NEForest a
forest =
(Tree a -> Tree a -> Ordering) -> NEForest a -> NEForest a
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NonEmpty.sortBy ((Tree a -> b) -> Tree a -> Tree a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing (a -> b
f (a -> b) -> (Tree a -> a) -> Tree a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> a
forall a. Tree a -> a
Tree.rootLabel))
(NEForest a -> NEForest a) -> NEForest a -> NEForest a
forall a b. (a -> b) -> a -> b
$ (Tree a -> Tree a) -> NEForest a -> NEForest a
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map ((a -> b) -> Tree a -> Tree a
forall b a. Ord b => (a -> b) -> Tree a -> Tree a
sortTreeOn a -> b
f) NEForest a
forest
findNodeInTree :: (a -> Bool) -> Tree a -> Maybe (Tree a)
findNodeInTree :: (a -> Bool) -> Tree a -> Maybe (Tree a)
findNodeInTree a -> Bool
p = \case
node :: Tree a
node@Node { a
rootLabel :: a
rootLabel :: forall a. Tree a -> a
rootLabel, Forest a
subForest :: Forest a
subForest :: forall a. Tree a -> Forest a
subForest }
| a -> Bool
p a
rootLabel -> Tree a -> Maybe (Tree a)
forall a. a -> Maybe a
Just Tree a
node
| Bool
otherwise -> (a -> Bool) -> Forest a -> Maybe (Tree a)
forall (t :: * -> *) a.
Foldable t =>
(a -> Bool) -> t (Tree a) -> Maybe (Tree a)
findNodeInForest a -> Bool
p Forest a
subForest
isSubtreeOf :: (Ord a) => Tree a -> Tree a -> Bool
isSubtreeOf :: Tree a -> Tree a -> Bool
isSubtreeOf = (Tree a -> Tree a) -> Tree a -> Tree a -> Bool
forall a. Eq a => (Tree a -> Tree a) -> Tree a -> Tree a -> Bool
isSubtreeOfUsing Tree a -> Tree a
forall a. Ord a => Tree a -> Tree a
sortTree
isExactSubtreeOf :: (Eq a) => Tree a -> Tree a -> Bool
isExactSubtreeOf :: Tree a -> Tree a -> Bool
isExactSubtreeOf = (Tree a -> Tree a) -> Tree a -> Tree a -> Bool
forall a. Eq a => (Tree a -> Tree a) -> Tree a -> Tree a -> Bool
isSubtreeOfUsing Tree a -> Tree a
forall a. a -> a
id
isSubtreeOfUsing
:: forall a. (Eq a)
=> (Tree a -> Tree a)
-> Tree a
-> Tree a
-> Bool
isSubtreeOfUsing :: (Tree a -> Tree a) -> Tree a -> Tree a -> Bool
isSubtreeOfUsing Tree a -> Tree a
f Tree a
subtree = Tree a -> Bool
go (Tree a -> Bool) -> (Tree a -> Tree a) -> Tree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> Tree a
f
where
go :: Tree a -> Bool
go :: Tree a -> Bool
go = \case
tree :: Tree a
tree@Node { Forest a
subForest :: Forest a
subForest :: forall a. Tree a -> Forest a
subForest }
| Tree a
subtree' Tree a -> Tree a -> Bool
forall a. Eq a => a -> a -> Bool
== Tree a
tree -> Bool
True
| Bool
otherwise -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Tree a -> Bool) -> Forest a -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> Bool
go Forest a
subForest
subtree' :: Tree a
subtree' :: Tree a
subtree' = Tree a -> Tree a
f Tree a
subtree
findNodeInForest :: (Foldable t) => (a -> Bool) -> t (Tree a) -> Maybe (Tree a)
findNodeInForest :: (a -> Bool) -> t (Tree a) -> Maybe (Tree a)
findNodeInForest a -> Bool
p t (Tree a)
forest =
Alt Maybe (Tree a) -> Maybe (Tree a)
forall k (f :: k -> *) (a :: k). Alt f a -> f a
Monoid.getAlt (Alt Maybe (Tree a) -> Maybe (Tree a))
-> Alt Maybe (Tree a) -> Maybe (Tree a)
forall a b. (a -> b) -> a -> b
$ (Tree a -> Alt Maybe (Tree a)) -> t (Tree a) -> Alt Maybe (Tree a)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (Maybe (Tree a) -> Alt Maybe (Tree a)
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (Maybe (Tree a) -> Alt Maybe (Tree a))
-> (Tree a -> Maybe (Tree a)) -> Tree a -> Alt Maybe (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Tree a -> Maybe (Tree a)
forall a. (a -> Bool) -> Tree a -> Maybe (Tree a)
findNodeInTree a -> Bool
p) t (Tree a)
forest
isSubtreeIn :: (Foldable t, Ord a) => Tree a -> t (Tree a) -> Bool
isSubtreeIn :: Tree a -> t (Tree a) -> Bool
isSubtreeIn = (Tree a -> Tree a) -> Tree a -> t (Tree a) -> Bool
forall a (t :: * -> *).
(Eq a, Foldable t) =>
(Tree a -> Tree a) -> Tree a -> t (Tree a) -> Bool
isSubtreeInUsing Tree a -> Tree a
forall a. Ord a => Tree a -> Tree a
sortTree
isExactSubtreeIn :: (Eq a, Foldable t) => Tree a -> t (Tree a) -> Bool
isExactSubtreeIn :: Tree a -> t (Tree a) -> Bool
isExactSubtreeIn = (Tree a -> Tree a) -> Tree a -> t (Tree a) -> Bool
forall a (t :: * -> *).
(Eq a, Foldable t) =>
(Tree a -> Tree a) -> Tree a -> t (Tree a) -> Bool
isSubtreeInUsing Tree a -> Tree a
forall a. a -> a
id
isSubtreeInUsing
:: (Eq a, Foldable t)
=> (Tree a -> Tree a)
-> Tree a
-> t (Tree a)
-> Bool
isSubtreeInUsing :: (Tree a -> Tree a) -> Tree a -> t (Tree a) -> Bool
isSubtreeInUsing Tree a -> Tree a
f Tree a
subtree =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> (t (Tree a) -> [Bool]) -> t (Tree a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> Bool) -> [Tree a] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((Tree a -> Tree a) -> Tree a -> Tree a -> Bool
forall a. Eq a => (Tree a -> Tree a) -> Tree a -> Tree a -> Bool
isSubtreeOfUsing Tree a -> Tree a
f Tree a
subtree) ([Tree a] -> [Bool])
-> (t (Tree a) -> [Tree a]) -> t (Tree a) -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (Tree a) -> [Tree a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
enumerateTree :: (Enum a, Num a) => Tree b -> Tree (a, b)
enumerateTree :: Tree b -> Tree (a, b)
enumerateTree = Tree a -> Tree b -> Tree (a, b)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
Zip.mzip Tree a
forall a. (Enum a, Num a) => Tree a
indicesTree
zipTree :: Tree a -> Tree b -> Tree (a, b)
zipTree :: Tree a -> Tree b -> Tree (a, b)
zipTree = Tree a -> Tree b -> Tree (a, b)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
Zip.mzip
zipWithTree :: (a -> b -> c) -> Tree a -> Tree b -> Tree c
zipWithTree :: (a -> b -> c) -> Tree a -> Tree b -> Tree c
zipWithTree a -> b -> c
f = (a -> b -> c) -> Tree a -> Tree b -> Tree c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
Zip.mzipWith a -> b -> c
f
pathsTree :: forall a. Tree a -> NonEmpty (Seq a)
pathsTree :: Tree a -> NonEmpty (Seq a)
pathsTree = [Seq a] -> NonEmpty (Seq a)
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([Seq a] -> NonEmpty (Seq a))
-> (Tree a -> [Seq a]) -> Tree a -> NonEmpty (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [Seq a]
go
where
go :: Tree a -> [Seq a]
go :: Tree a -> [Seq a]
go = \case
Node { a
rootLabel :: a
rootLabel :: forall a. Tree a -> a
rootLabel, Forest a
subForest :: Forest a
subForest :: forall a. Tree a -> Forest a
subForest } ->
a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
rootLabel Seq a -> [Seq a] -> [Seq a]
forall a. a -> [a] -> [a]
: (Tree a -> [Seq a]) -> Forest a -> [Seq a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Seq a -> Seq a) -> [Seq a] -> [Seq a]
forall a b. (a -> b) -> [a] -> [b]
map (a
rootLabel a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<|) ([Seq a] -> [Seq a]) -> (Tree a -> [Seq a]) -> Tree a -> [Seq a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [Seq a]
go) Forest a
subForest
leavesTree :: Tree a -> NonEmpty a
leavesTree :: Tree a -> NonEmpty a
leavesTree = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([a] -> NonEmpty a) -> (Tree a -> [a]) -> Tree a -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [a]
forall a. Tree a -> [a]
go
where
go :: Tree a -> [a]
go = \case
Node { a
rootLabel :: a
rootLabel :: forall a. Tree a -> a
rootLabel, Forest a
subForest :: Forest a
subForest :: forall a. Tree a -> Forest a
subForest }
| Forest a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest a
subForest -> a
rootLabel a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest
| Bool
otherwise -> [a]
rest
where
rest :: [a]
rest = (Tree a -> [a]) -> Forest a -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree a -> [a]
go Forest a
subForest
enumerateForest :: (Enum a, Num a) => Forest b -> Forest (a, b)
enumerateForest :: Forest b -> Forest (a, b)
enumerateForest = Forest a -> Forest b -> Forest (a, b)
forall a b. Forest a -> Forest b -> Forest (a, b)
zipForest Forest a
forall a. (Enum a, Num a) => Forest a
indicesForest
enumerateNEForest :: (Enum a, Num a) => NEForest b -> NEForest (a, b)
enumerateNEForest :: NEForest b -> NEForest (a, b)
enumerateNEForest = NEForest a -> NEForest b -> NEForest (a, b)
forall a b. NEForest a -> NEForest b -> NEForest (a, b)
zipNEForest NEForest a
forall a. (Enum a, Num a) => NEForest a
indicesNEForest
mapForest :: (a -> b) -> Forest a -> Forest b
mapForest :: (a -> b) -> Forest a -> Forest b
mapForest a -> b
f = (Tree a -> Tree b) -> Forest a -> Forest b
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
mapNEForest :: (a -> b) -> NEForest a -> NEForest b
mapNEForest :: (a -> b) -> NEForest a -> NEForest b
mapNEForest a -> b
f = (Tree a -> Tree b) -> NEForest a -> NEForest b
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map ((a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
zipForest :: Forest a -> Forest b -> Forest (a, b)
zipForest :: Forest a -> Forest b -> Forest (a, b)
zipForest = (a -> b -> (a, b)) -> Forest a -> Forest b -> Forest (a, b)
forall a b c. (a -> b -> c) -> Forest a -> Forest b -> Forest c
zipWithForest (,)
zipNEForest :: NEForest a -> NEForest b -> NEForest (a, b)
zipNEForest :: NEForest a -> NEForest b -> NEForest (a, b)
zipNEForest = (a -> b -> (a, b)) -> NEForest a -> NEForest b -> NEForest (a, b)
forall a b c.
(a -> b -> c) -> NEForest a -> NEForest b -> NEForest c
zipWithNEForest (,)
zipWithForest :: (a -> b -> c) -> Forest a -> Forest b -> Forest c
zipWithForest :: (a -> b -> c) -> Forest a -> Forest b -> Forest c
zipWithForest a -> b -> c
f = (Tree a -> Tree b -> Tree c) -> Forest a -> Forest b -> Forest c
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((a -> b -> c) -> Tree a -> Tree b -> Tree c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
Zip.mzipWith a -> b -> c
f)
zipWithNEForest :: (a -> b -> c) -> NEForest a -> NEForest b -> NEForest c
zipWithNEForest :: (a -> b -> c) -> NEForest a -> NEForest b -> NEForest c
zipWithNEForest a -> b -> c
f = (Tree a -> Tree b -> Tree c)
-> NEForest a -> NEForest b -> NEForest c
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NonEmpty.zipWith ((a -> b -> c) -> Tree a -> Tree b -> Tree c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
Zip.mzipWith a -> b -> c
f)
pathsForest :: Forest a -> Maybe (NonEmpty (Seq a))
pathsForest :: Forest a -> Maybe (NonEmpty (Seq a))
pathsForest = \case
[] -> Maybe (NonEmpty (Seq a))
forall a. Maybe a
Nothing
Forest a
forest -> NonEmpty (Seq a) -> Maybe (NonEmpty (Seq a))
forall a. a -> Maybe a
Just (NonEmpty (Seq a) -> Maybe (NonEmpty (Seq a)))
-> NonEmpty (Seq a) -> Maybe (NonEmpty (Seq a))
forall a b. (a -> b) -> a -> b
$ NEForest a -> NonEmpty (Seq a)
forall a. NEForest a -> NonEmpty (Seq a)
pathsNEForest (NEForest a -> NonEmpty (Seq a)) -> NEForest a -> NonEmpty (Seq a)
forall a b. (a -> b) -> a -> b
$ Forest a -> NEForest a
forall a. [a] -> NonEmpty a
NonEmpty.fromList Forest a
forest
pathsNEForest :: NEForest a -> NonEmpty (Seq a)
pathsNEForest :: NEForest a -> NonEmpty (Seq a)
pathsNEForest = NonEmpty (NonEmpty (Seq a)) -> NonEmpty (Seq a)
forall a. Semigroup a => NonEmpty a -> a
Semigroup.sconcat (NonEmpty (NonEmpty (Seq a)) -> NonEmpty (Seq a))
-> (NEForest a -> NonEmpty (NonEmpty (Seq a)))
-> NEForest a
-> NonEmpty (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> NonEmpty (Seq a))
-> NEForest a -> NonEmpty (NonEmpty (Seq a))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map Tree a -> NonEmpty (Seq a)
forall a. Tree a -> NonEmpty (Seq a)
pathsTree
leavesForest :: Forest a -> Maybe (NonEmpty a)
leavesForest :: Forest a -> Maybe (NonEmpty a)
leavesForest = \case
[] -> Maybe (NonEmpty a)
forall a. Maybe a
Nothing
Forest a
forest -> NonEmpty a -> Maybe (NonEmpty a)
forall a. a -> Maybe a
Just (NonEmpty a -> Maybe (NonEmpty a))
-> NonEmpty a -> Maybe (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ NEForest a -> NonEmpty a
forall a. NEForest a -> NonEmpty a
leavesNEForest (NEForest a -> NonEmpty a) -> NEForest a -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ Forest a -> NEForest a
forall a. [a] -> NonEmpty a
NonEmpty.fromList Forest a
forest
leavesNEForest :: NEForest a -> NonEmpty a
leavesNEForest :: NEForest a -> NonEmpty a
leavesNEForest = NonEmpty (NonEmpty a) -> NonEmpty a
forall a. Semigroup a => NonEmpty a -> a
Semigroup.sconcat (NonEmpty (NonEmpty a) -> NonEmpty a)
-> (NEForest a -> NonEmpty (NonEmpty a))
-> NEForest a
-> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> NonEmpty a) -> NEForest a -> NonEmpty (NonEmpty a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map Tree a -> NonEmpty a
forall a. Tree a -> NonEmpty a
leavesTree
flattenForest :: Forest a -> [a]
flattenForest :: Forest a -> [a]
flattenForest = (Tree a -> [a]) -> Forest a -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree a -> [a]
forall a. Tree a -> [a]
Tree.flatten
flattenNEForest :: NEForest a -> NonEmpty a
flattenNEForest :: NEForest a -> NonEmpty a
flattenNEForest NEForest a
forest =
NonEmpty (NonEmpty a) -> NonEmpty a
forall a. Semigroup a => NonEmpty a -> a
Semigroup.sconcat
(NonEmpty (NonEmpty a) -> NonEmpty a)
-> NonEmpty (NonEmpty a) -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ (Tree a -> NonEmpty a) -> NEForest a -> NonEmpty (NonEmpty a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map ([a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([a] -> NonEmpty a) -> (Tree a -> [a]) -> Tree a -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [a]
forall a. Tree a -> [a]
Tree.flatten) NEForest a
forest
singletonTree :: a -> Tree a
singletonTree :: a -> Tree a
singletonTree = a -> Tree a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
subtrees :: Tree a -> Forest a
subtrees :: Tree a -> Forest a
subtrees tree :: Tree a
tree@Node { Forest a
subForest :: Forest a
subForest :: forall a. Tree a -> Forest a
subForest } = Tree a
tree Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
: (Forest a
subForest Forest a -> (Tree a -> Forest a) -> Forest a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tree a -> Forest a
forall a. Tree a -> Forest a
subtrees)
neSubtrees :: Tree a -> NEForest a
neSubtrees :: Tree a -> NEForest a
neSubtrees = [Tree a] -> NEForest a
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([Tree a] -> NEForest a)
-> (Tree a -> [Tree a]) -> Tree a -> NEForest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [Tree a]
forall a. Tree a -> Forest a
subtrees
indicesTree :: (Enum a, Num a) => Tree a
indicesTree :: Tree a
indicesTree = (a -> (a, [a])) -> a -> Tree a
forall b a. (b -> (a, [b])) -> b -> Tree a
Tree.unfoldTree ((a -> [a] -> (a, [a])) -> [a] -> a -> (a, [a])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [a
0..]) a
0
eitherTreeFromLabels
:: (a -> a -> Bool)
-> a
-> [a]
-> Either (FromPartitionedLabelsError a) (Tree a)
eitherTreeFromLabels :: (a -> a -> Bool)
-> a -> [a] -> Either (FromPartitionedLabelsError a) (Tree a)
eitherTreeFromLabels a -> a -> Bool
isImmediateChildOf a
root [a]
children = do
(NonEmpty (Tree a) -> Tree a)
-> Either (FromPartitionedLabelsError a) (NonEmpty (Tree a))
-> Either (FromPartitionedLabelsError a) (Tree a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
Bifunctor.second NonEmpty (Tree a) -> Tree a
forall a. NonEmpty a -> a
NonEmpty.head
(Either (FromPartitionedLabelsError a) (NonEmpty (Tree a))
-> Either (FromPartitionedLabelsError a) (Tree a))
-> Either (FromPartitionedLabelsError a) (NonEmpty (Tree a))
-> Either (FromPartitionedLabelsError a) (Tree a)
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool)
-> NonEmpty a
-> [a]
-> Either (FromPartitionedLabelsError a) (NonEmpty (Tree a))
forall a.
(a -> a -> Bool)
-> NonEmpty a
-> [a]
-> Either (FromPartitionedLabelsError a) (NEForest a)
eitherNEForestFromPartitionedLabels a -> a -> Bool
isImmediateChildOf (a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
root) [a]
children
unsafeTreeFromLabels
:: (Show a, Typeable a)
=> (a -> a -> Bool)
-> a
-> [a]
-> Tree a
unsafeTreeFromLabels :: (a -> a -> Bool) -> a -> [a] -> Tree a
unsafeTreeFromLabels a -> a -> Bool
isImmediateChildOf a
root [a]
children = do
(FromPartitionedLabelsError a -> Tree a)
-> (Tree a -> Tree a)
-> Either (FromPartitionedLabelsError a) (Tree a)
-> Tree a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FromPartitionedLabelsError a -> Tree a
forall a e. Exception e => e -> a
Ex.throw Tree a -> Tree a
forall a. a -> a
id (Either (FromPartitionedLabelsError a) (Tree a) -> Tree a)
-> Either (FromPartitionedLabelsError a) (Tree a) -> Tree a
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool)
-> a -> [a] -> Either (FromPartitionedLabelsError a) (Tree a)
forall a.
(a -> a -> Bool)
-> a -> [a] -> Either (FromPartitionedLabelsError a) (Tree a)
eitherTreeFromLabels a -> a -> Bool
isImmediateChildOf a
root [a]
children
singletonForest :: a -> Forest a
singletonForest :: a -> Forest a
singletonForest = Tree a -> Forest a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree a -> Forest a) -> (a -> Tree a) -> a -> Forest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Tree a
forall a. a -> Tree a
singletonTree
singletonNEForest :: a -> NEForest a
singletonNEForest :: a -> NEForest a
singletonNEForest = Tree a -> NEForest a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree a -> NEForest a) -> (a -> Tree a) -> a -> NEForest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Tree a
forall a. a -> Tree a
singletonTree
indicesForest :: (Enum a, Num a) => Forest a
indicesForest :: Forest a
indicesForest = (a -> (a, [a])) -> [a] -> Forest a
forall b a. (b -> (a, [b])) -> [b] -> Forest a
Tree.unfoldForest ((a -> [a] -> (a, [a])) -> [a] -> a -> (a, [a])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [a
0..]) [a
0..]
indicesNEForest :: (Enum a, Num a) => NEForest a
indicesNEForest :: NEForest a
indicesNEForest = [Tree a] -> NEForest a
forall a. [a] -> NonEmpty a
NonEmpty.fromList [Tree a]
forall a. (Enum a, Num a) => Forest a
indicesForest
eitherNEForestFromPartitionedLabels
:: forall a. (a -> a -> Bool)
-> NonEmpty a
-> [a]
-> Either (FromPartitionedLabelsError a) (NEForest a)
eitherNEForestFromPartitionedLabels :: (a -> a -> Bool)
-> NonEmpty a
-> [a]
-> Either (FromPartitionedLabelsError a) (NEForest a)
eitherNEForestFromPartitionedLabels a -> a -> Bool
isImmediateChildOf NonEmpty a
roots [a]
children =
case (NEForest a, [a])
forestWithOrphans of
(NEForest a
forest, (a
orphan : [a]
orphans)) ->
FromPartitionedLabelsError a
-> Either (FromPartitionedLabelsError a) (NEForest a)
forall a b. a -> Either a b
Left (FromPartitionedLabelsError a
-> Either (FromPartitionedLabelsError a) (NEForest a))
-> FromPartitionedLabelsError a
-> Either (FromPartitionedLabelsError a) (NEForest a)
forall a b. (a -> b) -> a -> b
$ NEForest a -> NonEmpty a -> FromPartitionedLabelsError a
forall a. NEForest a -> NonEmpty a -> FromPartitionedLabelsError a
OrphansFoundError NEForest a
forest (NonEmpty a -> FromPartitionedLabelsError a)
-> NonEmpty a -> FromPartitionedLabelsError a
forall a b. (a -> b) -> a -> b
$ a
orphan a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
orphans
(NEForest a
forest, []) ->
NEForest a -> Either (FromPartitionedLabelsError a) (NEForest a)
forall a b. b -> Either a b
Right NEForest a
forest
where
forestWithOrphans :: (NEForest a, [a])
forestWithOrphans :: (NEForest a, [a])
forestWithOrphans = do
(State [a] (NEForest a) -> [a] -> (NEForest a, [a]))
-> [a] -> State [a] (NEForest a) -> (NEForest a, [a])
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [a] (NEForest a) -> [a] -> (NEForest a, [a])
forall s a. State s a -> s -> (a, s)
State.runState [a]
children do
NonEmpty a
-> (a -> StateT [a] Identity (Tree a)) -> State [a] (NEForest a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
Traversable.for NonEmpty a
roots \a
rootLabel -> do
(a -> StateT [a] Identity (a, [a]))
-> a -> StateT [a] Identity (Tree a)
forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> b -> m (Tree a)
Tree.unfoldTreeM a -> StateT [a] Identity (a, [a])
parentChildrenPair a
rootLabel
parentChildrenPair :: a -> State [a] (a, [a])
parentChildrenPair :: a -> StateT [a] Identity (a, [a])
parentChildrenPair a
parent = do
([a]
cs, [a]
rest) <- ([a] -> ([a], [a]))
-> StateT [a] Identity [a] -> StateT [a] Identity ([a], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> ([a], [a])
partitionChildren StateT [a] Identity [a]
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
[a] -> StateT [a] Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put [a]
rest
(a, [a]) -> StateT [a] Identity (a, [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
parent, [a]
cs)
where
partitionChildren :: [a] -> ([a], [a])
partitionChildren :: [a] -> ([a], [a])
partitionChildren =
(a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition \a
possibleChild ->
a
possibleChild a -> a -> Bool
`isImmediateChildOf` a
parent
unsafeNEForestFromPartitionedLabels
:: (Show a, Typeable a)
=> (a -> a -> Bool)
-> NonEmpty a
-> [a]
-> NEForest a
unsafeNEForestFromPartitionedLabels :: (a -> a -> Bool) -> NonEmpty a -> [a] -> NEForest a
unsafeNEForestFromPartitionedLabels a -> a -> Bool
isImmediateChildOf NonEmpty a
roots [a]
children =
(FromPartitionedLabelsError a -> NEForest a)
-> (NEForest a -> NEForest a)
-> Either (FromPartitionedLabelsError a) (NEForest a)
-> NEForest a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FromPartitionedLabelsError a -> NEForest a
forall a e. Exception e => e -> a
Ex.throw NEForest a -> NEForest a
forall a. a -> a
id
(Either (FromPartitionedLabelsError a) (NEForest a) -> NEForest a)
-> Either (FromPartitionedLabelsError a) (NEForest a) -> NEForest a
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool)
-> NonEmpty a
-> [a]
-> Either (FromPartitionedLabelsError a) (NEForest a)
forall a.
(a -> a -> Bool)
-> NonEmpty a
-> [a]
-> Either (FromPartitionedLabelsError a) (NEForest a)
eitherNEForestFromPartitionedLabels a -> a -> Bool
isImmediateChildOf NonEmpty a
roots [a]
children
eitherNEForestFromLabels
:: forall a. (a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (FromLabelsError a) (NEForest a)
eitherNEForestFromLabels :: (a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (FromLabelsError a) (NEForest a)
eitherNEForestFromLabels a -> Bool
isRoot a -> a -> Bool
isImmediateChildOf NonEmpty a
labels =
case (a -> Bool) -> NonEmpty a -> ([a], [a])
forall a. (a -> Bool) -> NonEmpty a -> ([a], [a])
NonEmpty.partition a -> Bool
isRoot NonEmpty a
labels of
([], [a]
_children) -> FromLabelsError a -> Either (FromLabelsError a) (NEForest a)
forall a b. a -> Either a b
Left (FromLabelsError a -> Either (FromLabelsError a) (NEForest a))
-> FromLabelsError a -> Either (FromLabelsError a) (NEForest a)
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> FromLabelsError a
forall a. NonEmpty a -> FromLabelsError a
NoRootsFoundError NonEmpty a
labels
([a]
roots, [a]
children) ->
(FromPartitionedLabelsError a -> FromLabelsError a)
-> Either (FromPartitionedLabelsError a) (NEForest a)
-> Either (FromLabelsError a) (NEForest a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first FromPartitionedLabelsError a -> FromLabelsError a
forall a. FromPartitionedLabelsError a -> FromLabelsError a
FromPartitionedLabels
(Either (FromPartitionedLabelsError a) (NEForest a)
-> Either (FromLabelsError a) (NEForest a))
-> Either (FromPartitionedLabelsError a) (NEForest a)
-> Either (FromLabelsError a) (NEForest a)
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool)
-> NonEmpty a
-> [a]
-> Either (FromPartitionedLabelsError a) (NEForest a)
forall a.
(a -> a -> Bool)
-> NonEmpty a
-> [a]
-> Either (FromPartitionedLabelsError a) (NEForest a)
eitherNEForestFromPartitionedLabels
a -> a -> Bool
isImmediateChildOf
([a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList [a]
roots)
[a]
children
unsafeNEForestFromLabels
:: (Show a, Typeable a)
=> (a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> NEForest a
unsafeNEForestFromLabels :: (a -> Bool) -> (a -> a -> Bool) -> NonEmpty a -> NEForest a
unsafeNEForestFromLabels a -> Bool
isRoot a -> a -> Bool
isImmediateChildOf NonEmpty a
labels =
(FromLabelsError a -> NEForest a)
-> (NEForest a -> NEForest a)
-> Either (FromLabelsError a) (NEForest a)
-> NEForest a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FromLabelsError a -> NEForest a
forall a e. Exception e => e -> a
Ex.throw NEForest a -> NEForest a
forall a. a -> a
id (Either (FromLabelsError a) (NEForest a) -> NEForest a)
-> Either (FromLabelsError a) (NEForest a) -> NEForest a
forall a b. (a -> b) -> a -> b
$ (a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (FromLabelsError a) (NEForest a)
forall a.
(a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (FromLabelsError a) (NEForest a)
eitherNEForestFromLabels a -> Bool
isRoot a -> a -> Bool
isImmediateChildOf NonEmpty a
labels
neForest :: Forest a -> Maybe (NEForest a)
neForest :: Forest a -> Maybe (NEForest a)
neForest = \case
[] -> Maybe (NEForest a)
forall a. Maybe a
Nothing
Tree a
t : Forest a
ts -> NEForest a -> Maybe (NEForest a)
forall a. a -> Maybe a
Just (NEForest a -> Maybe (NEForest a))
-> NEForest a -> Maybe (NEForest a)
forall a b. (a -> b) -> a -> b
$ Tree a
t Tree a -> Forest a -> NEForest a
forall a. a -> [a] -> NonEmpty a
:| Forest a
ts
unsafeNEForest :: Forest a -> NEForest a
unsafeNEForest :: Forest a -> NEForest a
unsafeNEForest Forest a
forest =
case Forest a -> Maybe (NEForest a)
forall a. Forest a -> Maybe (NEForest a)
neForest Forest a
forest of
Maybe (NEForest a)
Nothing -> String -> NEForest a
forall a. HasCallStack => String -> a
error String
"Rosebud.unsafeNEForest: empty forest"
Just NEForest a
forest' -> NEForest a
forest'