{-# 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
  , eitherNEForestFromLabels
  , unsafeNEForestFromLabels
  , neForest
  , unsafeNEForest

    -- * Errors
  , NEForestFromLabelsError(NoRootsFoundError, OrphansFoundError)
  , TreeFromLabelsError(TooManyTreesError, ForestFromLabelsError)
  ) 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.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.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 for 'eitherNEForestFromLabels'.
--
-- @since 0.1.0.0
data NEForestFromLabelsError a
  = -- | No root label(s) were found. Provides the flat list of input labels.
    --
    -- @since 0.1.0.0
    NoRootsFoundError (NonEmpty a)
    -- | Orphan labels were found. Provides the assembled 'Forest' and a flat
    -- list of orphan labels.
    --
    -- @since 0.1.0.0
  | OrphansFoundError (Forest a) (NonEmpty a)
  deriving stock (NEForestFromLabelsError a -> NEForestFromLabelsError a -> Bool
(NEForestFromLabelsError a -> NEForestFromLabelsError a -> Bool)
-> (NEForestFromLabelsError a -> NEForestFromLabelsError a -> Bool)
-> Eq (NEForestFromLabelsError a)
forall a.
Eq a =>
NEForestFromLabelsError a -> NEForestFromLabelsError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NEForestFromLabelsError a -> NEForestFromLabelsError a -> Bool
$c/= :: forall a.
Eq a =>
NEForestFromLabelsError a -> NEForestFromLabelsError a -> Bool
== :: NEForestFromLabelsError a -> NEForestFromLabelsError a -> Bool
$c== :: forall a.
Eq a =>
NEForestFromLabelsError a -> NEForestFromLabelsError a -> Bool
Eq, Int -> NEForestFromLabelsError a -> ShowS
[NEForestFromLabelsError a] -> ShowS
NEForestFromLabelsError a -> String
(Int -> NEForestFromLabelsError a -> ShowS)
-> (NEForestFromLabelsError a -> String)
-> ([NEForestFromLabelsError a] -> ShowS)
-> Show (NEForestFromLabelsError a)
forall a. Show a => Int -> NEForestFromLabelsError a -> ShowS
forall a. Show a => [NEForestFromLabelsError a] -> ShowS
forall a. Show a => NEForestFromLabelsError a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NEForestFromLabelsError a] -> ShowS
$cshowList :: forall a. Show a => [NEForestFromLabelsError a] -> ShowS
show :: NEForestFromLabelsError a -> String
$cshow :: forall a. Show a => NEForestFromLabelsError a -> String
showsPrec :: Int -> NEForestFromLabelsError a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NEForestFromLabelsError a -> ShowS
Show, (forall x.
 NEForestFromLabelsError a -> Rep (NEForestFromLabelsError a) x)
-> (forall x.
    Rep (NEForestFromLabelsError a) x -> NEForestFromLabelsError a)
-> Generic (NEForestFromLabelsError a)
forall x.
Rep (NEForestFromLabelsError a) x -> NEForestFromLabelsError a
forall x.
NEForestFromLabelsError a -> Rep (NEForestFromLabelsError a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x.
Rep (NEForestFromLabelsError a) x -> NEForestFromLabelsError a
forall a x.
NEForestFromLabelsError a -> Rep (NEForestFromLabelsError a) x
$cto :: forall a x.
Rep (NEForestFromLabelsError a) x -> NEForestFromLabelsError a
$cfrom :: forall a x.
NEForestFromLabelsError a -> Rep (NEForestFromLabelsError a) x
Generic)
  deriving anyclass (Show (NEForestFromLabelsError a)
Typeable (NEForestFromLabelsError a)
Typeable (NEForestFromLabelsError a)
-> Show (NEForestFromLabelsError a)
-> (NEForestFromLabelsError a -> SomeException)
-> (SomeException -> Maybe (NEForestFromLabelsError a))
-> (NEForestFromLabelsError a -> String)
-> Exception (NEForestFromLabelsError a)
SomeException -> Maybe (NEForestFromLabelsError a)
NEForestFromLabelsError a -> String
NEForestFromLabelsError a -> SomeException
forall a. (Typeable a, Show a) => Show (NEForestFromLabelsError a)
forall a.
(Typeable a, Show a) =>
Typeable (NEForestFromLabelsError a)
forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (NEForestFromLabelsError a)
forall a.
(Typeable a, Show a) =>
NEForestFromLabelsError a -> String
forall a.
(Typeable a, Show a) =>
NEForestFromLabelsError a -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: NEForestFromLabelsError a -> String
$cdisplayException :: forall a.
(Typeable a, Show a) =>
NEForestFromLabelsError a -> String
fromException :: SomeException -> Maybe (NEForestFromLabelsError a)
$cfromException :: forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (NEForestFromLabelsError a)
toException :: NEForestFromLabelsError a -> SomeException
$ctoException :: forall a.
(Typeable a, Show a) =>
NEForestFromLabelsError a -> SomeException
$cp2Exception :: forall a. (Typeable a, Show a) => Show (NEForestFromLabelsError a)
$cp1Exception :: forall a.
(Typeable a, Show a) =>
Typeable (NEForestFromLabelsError a)
Exception)

-- | The error type for 'eitherTreeFromLabels'.
--
-- @since 0.1.0.0
data TreeFromLabelsError a
  = -- | Produced more than one 'Tree' when only one 'Tree' was expected.
    -- Provides back all assembled 'Tree' values in an 'NEForest'.
    --
    -- @since 0.1.0.0
    TooManyTreesError (NEForest a)
    -- | Produced via the internal call to 'eitherNEForestFromLabels'.
    --
    -- @since 0.1.0.0
  | ForestFromLabelsError (NEForestFromLabelsError a)
  deriving stock (TreeFromLabelsError a -> TreeFromLabelsError a -> Bool
(TreeFromLabelsError a -> TreeFromLabelsError a -> Bool)
-> (TreeFromLabelsError a -> TreeFromLabelsError a -> Bool)
-> Eq (TreeFromLabelsError a)
forall a.
Eq a =>
TreeFromLabelsError a -> TreeFromLabelsError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeFromLabelsError a -> TreeFromLabelsError a -> Bool
$c/= :: forall a.
Eq a =>
TreeFromLabelsError a -> TreeFromLabelsError a -> Bool
== :: TreeFromLabelsError a -> TreeFromLabelsError a -> Bool
$c== :: forall a.
Eq a =>
TreeFromLabelsError a -> TreeFromLabelsError a -> Bool
Eq, Int -> TreeFromLabelsError a -> ShowS
[TreeFromLabelsError a] -> ShowS
TreeFromLabelsError a -> String
(Int -> TreeFromLabelsError a -> ShowS)
-> (TreeFromLabelsError a -> String)
-> ([TreeFromLabelsError a] -> ShowS)
-> Show (TreeFromLabelsError a)
forall a. Show a => Int -> TreeFromLabelsError a -> ShowS
forall a. Show a => [TreeFromLabelsError a] -> ShowS
forall a. Show a => TreeFromLabelsError a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeFromLabelsError a] -> ShowS
$cshowList :: forall a. Show a => [TreeFromLabelsError a] -> ShowS
show :: TreeFromLabelsError a -> String
$cshow :: forall a. Show a => TreeFromLabelsError a -> String
showsPrec :: Int -> TreeFromLabelsError a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TreeFromLabelsError a -> ShowS
Show, (forall x. TreeFromLabelsError a -> Rep (TreeFromLabelsError a) x)
-> (forall x.
    Rep (TreeFromLabelsError a) x -> TreeFromLabelsError a)
-> Generic (TreeFromLabelsError a)
forall x. Rep (TreeFromLabelsError a) x -> TreeFromLabelsError a
forall x. TreeFromLabelsError a -> Rep (TreeFromLabelsError a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TreeFromLabelsError a) x -> TreeFromLabelsError a
forall a x. TreeFromLabelsError a -> Rep (TreeFromLabelsError a) x
$cto :: forall a x. Rep (TreeFromLabelsError a) x -> TreeFromLabelsError a
$cfrom :: forall a x. TreeFromLabelsError a -> Rep (TreeFromLabelsError a) x
Generic)
  deriving anyclass (Show (TreeFromLabelsError a)
Typeable (TreeFromLabelsError a)
Typeable (TreeFromLabelsError a)
-> Show (TreeFromLabelsError a)
-> (TreeFromLabelsError a -> SomeException)
-> (SomeException -> Maybe (TreeFromLabelsError a))
-> (TreeFromLabelsError a -> String)
-> Exception (TreeFromLabelsError a)
SomeException -> Maybe (TreeFromLabelsError a)
TreeFromLabelsError a -> String
TreeFromLabelsError a -> SomeException
forall a. (Typeable a, Show a) => Show (TreeFromLabelsError a)
forall a. (Typeable a, Show a) => Typeable (TreeFromLabelsError a)
forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (TreeFromLabelsError a)
forall a. (Typeable a, Show a) => TreeFromLabelsError a -> String
forall a.
(Typeable a, Show a) =>
TreeFromLabelsError a -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: TreeFromLabelsError a -> String
$cdisplayException :: forall a. (Typeable a, Show a) => TreeFromLabelsError a -> String
fromException :: SomeException -> Maybe (TreeFromLabelsError a)
$cfromException :: forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (TreeFromLabelsError a)
toException :: TreeFromLabelsError a -> SomeException
$ctoException :: forall a.
(Typeable a, Show a) =>
TreeFromLabelsError a -> SomeException
$cp2Exception :: forall a. (Typeable a, Show a) => Show (TreeFromLabelsError a)
$cp1Exception :: forall a. (Typeable a, Show a) => Typeable (TreeFromLabelsError 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 flat input list of labels.
--
-- @since 0.1.0.0
eitherTreeFromLabels
  :: (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 (TreeFromLabelsError a) (Tree a)
eitherTreeFromLabels :: (a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (TreeFromLabelsError a) (Tree a)
eitherTreeFromLabels a -> Bool
isRoot a -> a -> Bool
isImmediateChildOf NonEmpty a
labels = do
  case (a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (NEForestFromLabelsError a) (NEForest a)
forall a.
(a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (NEForestFromLabelsError a) (NEForest a)
eitherNEForestFromLabels a -> Bool
isRoot a -> a -> Bool
isImmediateChildOf NonEmpty a
labels of
    Left NEForestFromLabelsError a
err -> TreeFromLabelsError a -> Either (TreeFromLabelsError a) (Tree a)
forall a b. a -> Either a b
Left (TreeFromLabelsError a -> Either (TreeFromLabelsError a) (Tree a))
-> TreeFromLabelsError a -> Either (TreeFromLabelsError a) (Tree a)
forall a b. (a -> b) -> a -> b
$ NEForestFromLabelsError a -> TreeFromLabelsError a
forall a. NEForestFromLabelsError a -> TreeFromLabelsError a
ForestFromLabelsError NEForestFromLabelsError a
err
    Right NEForest a
forest ->
      case NEForest a
forest of
        Tree a
tree :| [] -> Tree a -> Either (TreeFromLabelsError a) (Tree a)
forall a b. b -> Either a b
Right Tree a
tree
        Tree a
_tree :| [Tree a]
_trees -> TreeFromLabelsError a -> Either (TreeFromLabelsError a) (Tree a)
forall a b. a -> Either a b
Left (TreeFromLabelsError a -> Either (TreeFromLabelsError a) (Tree a))
-> TreeFromLabelsError a -> Either (TreeFromLabelsError a) (Tree a)
forall a b. (a -> b) -> a -> b
$ NEForest a -> TreeFromLabelsError a
forall a. NEForest a -> TreeFromLabelsError a
TooManyTreesError NEForest a
forest

-- | Build a 'Tree' from a flat input list of labels.
--
-- Throws 'TreeFromLabelsError' if anything goes wrong when building the 'Tree'.
--
-- @since 0.1.0.0
unsafeTreeFromLabels
  :: (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
  -> Tree a
unsafeTreeFromLabels :: (a -> Bool) -> (a -> a -> Bool) -> NonEmpty a -> Tree a
unsafeTreeFromLabels a -> Bool
isRoot a -> a -> Bool
isImmediateChildOf NonEmpty a
labels = do
  case (a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (TreeFromLabelsError a) (Tree a)
forall a.
(a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (TreeFromLabelsError a) (Tree a)
eitherTreeFromLabels a -> Bool
isRoot a -> a -> Bool
isImmediateChildOf NonEmpty a
labels of
    Left TreeFromLabelsError a
ex -> TreeFromLabelsError a -> Tree a
forall a e. Exception e => e -> a
Ex.throw TreeFromLabelsError a
ex
    Right Tree a
tree -> Tree a
tree

-- | 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 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 (NEForestFromLabelsError a) (NEForest a)
eitherNEForestFromLabels :: (a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (NEForestFromLabelsError 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) -> NEForestFromLabelsError a
-> Either (NEForestFromLabelsError a) (NEForest a)
forall a b. a -> Either a b
Left (NEForestFromLabelsError a
 -> Either (NEForestFromLabelsError a) (NEForest a))
-> NEForestFromLabelsError a
-> Either (NEForestFromLabelsError a) (NEForest a)
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> NEForestFromLabelsError a
forall a. NonEmpty a -> NEForestFromLabelsError a
NoRootsFoundError NonEmpty a
labels
    ([a]
rootLabels, [a]
childLabels) -> Either (NEForestFromLabelsError a) (NEForest a)
result where
      result :: Either (NEForestFromLabelsError a) (NEForest a)
result =
        case (Forest a, [a])
forestWithOrphans of
          (Forest a
forest, (a
orphan : [a]
orphans)) ->
            NEForestFromLabelsError a
-> Either (NEForestFromLabelsError a) (NEForest a)
forall a b. a -> Either a b
Left (NEForestFromLabelsError a
 -> Either (NEForestFromLabelsError a) (NEForest a))
-> NEForestFromLabelsError a
-> Either (NEForestFromLabelsError a) (NEForest a)
forall a b. (a -> b) -> a -> b
$ Forest a -> NonEmpty a -> NEForestFromLabelsError a
forall a. Forest a -> NonEmpty a -> NEForestFromLabelsError a
OrphansFoundError Forest a
forest (NonEmpty a -> NEForestFromLabelsError a)
-> NonEmpty a -> NEForestFromLabelsError a
forall a b. (a -> b) -> a -> b
$ a
orphan a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
orphans
          (Forest a
forest, []) ->
            -- This NonEmpty conversion is righteous due to the input NonEmpty.
            NEForest a -> Either (NEForestFromLabelsError a) (NEForest a)
forall a b. b -> Either a b
Right (NEForest a -> Either (NEForestFromLabelsError a) (NEForest a))
-> NEForest a -> Either (NEForestFromLabelsError a) (NEForest a)
forall a b. (a -> b) -> a -> b
$ Forest a -> NEForest a
forall a. Forest a -> NEForest a
unsafeNEForest Forest a
forest

      forestWithOrphans :: (Forest a, [a])
      forestWithOrphans :: (Forest a, [a])
forestWithOrphans = do
        (State [a] (Forest a) -> [a] -> (Forest a, [a]))
-> [a] -> State [a] (Forest a) -> (Forest a, [a])
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [a] (Forest a) -> [a] -> (Forest a, [a])
forall s a. State s a -> s -> (a, s)
State.runState [a]
childLabels do
          (a -> StateT [a] Identity (Tree a)) -> [a] -> State [a] (Forest a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((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]
rootLabels

      parentChildrenPair :: a -> State [a] (a, [a])
      parentChildrenPair :: a -> StateT [a] Identity (a, [a])
parentChildrenPair a
parent = do
        ([a]
children, [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]
children)
        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 a flat input list of labels.
--
-- Throws 'NEForestFromLabelsError' 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 = do
  case (a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (NEForestFromLabelsError a) (NEForest a)
forall a.
(a -> Bool)
-> (a -> a -> Bool)
-> NonEmpty a
-> Either (NEForestFromLabelsError a) (NEForest a)
eitherNEForestFromLabels a -> Bool
isRoot a -> a -> Bool
isImmediateChildOf NonEmpty a
labels of
    Left NEForestFromLabelsError a
ex -> NEForestFromLabelsError a -> NEForest a
forall a e. Exception e => e -> a
Ex.throw NEForestFromLabelsError a
ex
    Right NEForest a
forest -> NEForest a
forest

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