{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Rosebud
  ( -- * Introduction
    -- $intro

    -- * Re-exports
    Tree(Node, rootLabel, subForest)
  , Forest

    -- * Types
  , NEForest

    -- * Sorting
    -- ** Trees
  , sortTree
  , sortTreeOn
    -- ** Forests
  , sortForest
  , sortForestOn
  , sortNEForest
  , sortNEForestOn

    -- * Searching
    -- ** Trees
  , findNodeInTree
  , isSubtreeOf
  , isExactSubtreeOf
  , isSubtreeOfUsing
    -- ** Forests
  , findNodeInForest
  , isSubtreeIn
  , isExactSubtreeIn
  , isSubtreeInUsing

    -- * Transformation
    -- ** Trees
  , enumerateTree
  , zipTree
  , zipWithTree
  , pathsTree
  , leavesTree
    -- ** Forests
  , enumerateForest
  , enumerateNEForest
  , mapForest
  , mapNEForest
  , zipForest
  , zipNEForest
  , zipWithForest
  , zipWithNEForest
  , pathsForest
  , pathsNEForest
  , leavesForest
  , leavesNEForest
  , flattenForest
  , flattenNEForest

    -- * Construction
    -- ** Trees
  , singletonTree
  , indicesTree
  , eitherTreeFromLabels
  , unsafeTreeFromLabels
    -- ** Forests
  , singletonForest
  , singletonNEForest
  , indicesForest
  , indicesNEForest
  , subtrees
  , neSubtrees
  , eitherNEForestFromPartitionedLabels
  , unsafeNEForestFromPartitionedLabels
  , eitherNEForestFromLabels
  , unsafeNEForestFromLabels
  , neForest
  , unsafeNEForest

    -- * Errors
  , 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

-- | A convenience type alias for a non-empty 'Forest'.
--
-- @since 0.1.0.0
type NEForest a = NonEmpty (Tree a)

-- | The error type when building a 'Tree'/'NEForest' from labels already
-- partitioned into roots and children.
--
-- @since 0.2.0.0
data FromPartitionedLabelsError a
  = -- | Orphan labels were found. Provides the assembled 'NEForest' and a flat
    -- list of orphan labels.
    --
    -- @since 0.2.0.0
    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)

-- | The error type when building an 'NEForest' from a flat list of labels.
--
-- @since 0.2.0.0
data FromLabelsError a
  = -- | No root label(s) were found. Provides the flat list of input labels.
    --
    -- @since 0.2.0.0
    NoRootsFoundError (NonEmpty a)
    -- | Produced via internally building from partitioned labels.
    --
    -- @since 0.2.0.0
  | 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)

-- | Sort from lowest to highest at each level in the 'Tree'.
--
-- @since 0.1.0.0
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

-- | 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
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)

-- | 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
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

-- | 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
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)

-- | 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
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

-- | 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
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

-- | Find a particular 'Node' in a 'Tree' via the provided label predicate.
-- Unlike 'Foldable.find', this function will return the entire subtree instead
-- of just the label value.
--
-- @since 0.1.0.0
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

-- | 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
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

-- | 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
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

-- | 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
isSubtreeOfUsing
  :: forall a. (Eq a)
  => (Tree a -> Tree a) -- ^ Transforms 'Tree' values prior to equality-checking
  -> 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

-- | 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
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

-- | 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
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

-- | 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
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

-- | 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
isSubtreeInUsing
  :: (Eq a, Foldable t)
  => (Tree a -> Tree a) -- ^ Transforms 'Tree' values prior to equality-checking
  -> 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

-- | Number each level of labels in the tree, starting from 0 at each level.
--
-- @since 0.1.0.0
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

-- | 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
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

-- | 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
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

-- | 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
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

-- | Produce all the leaves for the given 'Tree'.
--
-- @since 0.1.0.0
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

-- | Number each level of labels in the 'Forest', starting from 0 at each level.
--
-- @since 0.1.0.0
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

-- | Number each level of labels in the 'NEForest', starting from 0 at each
-- level.
--
-- @since 0.1.0.0
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

-- | Apply a function to each label in each 'Tree' in the 'Forest'.
--
-- @since 0.1.0.0
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)

-- | Apply a function to each label in each 'Tree' in the 'NEForest'.
--
-- @since 0.1.0.0
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)

-- | Given two input 'Forest' values, provide a 'Forest' of corresponding label
-- pairs.
--
-- @since 0.1.0.0
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 (,)

-- | Given two input 'NEForest' values, provide an 'NEForest' of corresponding
-- label pairs.
--
-- @since 0.1.0.0
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 (,)

-- | Generalizes 'zipForest' by zipping label values via the provided function.
--
-- @since 0.1.0.0
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)

-- | Generalizes 'zipNEForest' by zipping label values via the provided
-- function.
--
-- @since 0.1.0.0
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)

-- | Produce all the paths for the given 'Forest', if any 'Tree' values exist
-- in the 'Forest'.
--
-- @since 0.1.0.0
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

-- | Produce all the paths for the given 'NEForest'.
--
-- @since 0.1.0.0
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

-- | Produce all the leaves for the given 'Forest', if any 'Tree' values exist
-- in the 'Forest.
--
-- @since 0.1.0.0
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

-- | Produce all the leaves for the given 'NEForest'.
--
-- @since 0.1.0.0
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

-- | Flatten each 'Tree' in the input 'Forest', then concatenate the results.
--
-- @since 0.1.0.0
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

-- | Flatten each 'Tree' in the input 'NEForest', then concatenate the results.
--
-- @since 0.1.0.0
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

-- | Creates a 'Tree' containing the provided label and no children.
--
-- @since 0.1.0.0
singletonTree :: a -> Tree a
singletonTree :: a -> Tree a
singletonTree = a -> Tree a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | 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
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)

-- | Produces all subtrees of the given 'Tree'.
--
-- @since 0.1.0.0
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

-- | Produce an infinite 'Tree' of indices, starting from 0 at each level.
--
-- @since 0.1.0.0
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

-- | Build a 'Tree' from a root label and a flat list of child labels.
--
-- @since 0.2.0.0
eitherTreeFromLabels
  :: (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)
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

-- | 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
unsafeTreeFromLabels
  :: (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
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

-- | Creates a 'Forest' containing a single 'Tree' that contains the provided
-- label and no children.
--
-- @since 0.1.0.0
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

-- | Creates an 'NEForest' containing a single 'Tree' that contains the provided
-- label and no children.
--
-- @since 0.1.0.0
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

-- | Produce an infinite 'Forest' of indices, starting from 0 at each level.
--
-- @since 0.1.0.0
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..]

-- | Produce an infinite 'NEForest' of indices, starting from 0 at each level.
--
-- @since 0.1.0.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

-- | Build an 'NEForest' from flat input lists of root and child labels.
--
-- @since 0.2.0.0
eitherNEForestFromPartitionedLabels
  :: 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)
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

-- | 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
unsafeNEForestFromPartitionedLabels
  :: (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
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

-- | Build an 'NEForest' from a flat input list of labels.
--
-- @since 0.1.0.0
eitherNEForestFromLabels
  :: 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)
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

-- | 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
unsafeNEForestFromLabels
  :: (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
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

-- | Build an 'NEForest' from a 'Forest', producing 'Nothing' if the input
-- 'Forest' is empty.
--
-- @since 0.1.0.0
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

-- | Build an 'NEForest' from a 'Forest', raising an error if the input 'Forest'
-- is empty.
--
-- @since 0.1.0.0
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'

-- $intro
--
-- This module captures functions and patterns often reached for when working
-- with "Data.Tree" from the @containers@ package.