{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Trustworthy #-}
#endif

#include "containers.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Tree
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
-- = Multi-way Trees and Forests
--
-- The @'Tree' a@ type represents a lazy, possibly infinite, multi-way tree
-- (also known as a /rose tree/).
--
-- The @'Forest' a@ type represents a forest of @'Tree' a@s.
--
-----------------------------------------------------------------------------

module Data.Tree(

    -- * Trees and Forests
      Tree(..)
    , Forest

    -- * Construction
    , unfoldTree
    , unfoldForest
    , unfoldTreeM
    , unfoldForestM
    , unfoldTreeM_BF
    , unfoldForestM_BF

    -- * Elimination
    , foldTree
    , flatten
    , levels

    -- * Ascii Drawings
    , drawTree
    , drawForest

    ) where

#if MIN_VERSION_base(4,8,0)
import Data.Foldable (toList)
import Control.Applicative (Applicative(..), liftA2)
#else
import Control.Applicative (Applicative(..), liftA2, (<$>))
import Data.Foldable (Foldable(foldMap), toList)
import Data.Monoid (Monoid(..))
import Data.Traversable (Traversable(traverse))
#endif

import Control.Monad (liftM)
import Control.Monad.Fix (MonadFix (..), fix)
import Data.Sequence (Seq, empty, singleton, (<|), (|>), fromList,
            ViewL(..), ViewR(..), viewl, viewr)
import Data.Typeable
import Control.DeepSeq (NFData(rnf))

#ifdef __GLASGOW_HASKELL__
import Data.Data (Data)
import GHC.Generics (Generic, Generic1)
#endif

import Control.Monad.Zip (MonadZip (..))

#if MIN_VERSION_base(4,8,0)
import Data.Coerce
#endif

#if MIN_VERSION_base(4,9,0)
import Data.Functor.Classes
#endif
#if (!MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup (..))
#endif

#if !MIN_VERSION_base(4,8,0)
import Data.Functor ((<$))
#endif

-- | Non-empty, possibly infinite, multi-way trees; also known as /rose trees/.
data Tree a = Node {
        forall a. Tree a -> a
rootLabel :: a,         -- ^ label value
        forall a. Tree a -> [Tree a]
subForest :: [Tree a]   -- ^ zero or more child trees
    }
#ifdef __GLASGOW_HASKELL__
  deriving ( Tree a -> Tree a -> Bool
forall a. Eq a => Tree a -> Tree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree a -> Tree a -> Bool
$c/= :: forall a. Eq a => Tree a -> Tree a -> Bool
== :: Tree a -> Tree a -> Bool
$c== :: forall a. Eq a => Tree a -> Tree a -> Bool
Eq
           , Tree a -> Tree a -> Bool
Tree a -> Tree a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Tree a)
forall a. Ord a => Tree a -> Tree a -> Bool
forall a. Ord a => Tree a -> Tree a -> Ordering
forall a. Ord a => Tree a -> Tree a -> Tree a
min :: Tree a -> Tree a -> Tree a
$cmin :: forall a. Ord a => Tree a -> Tree a -> Tree a
max :: Tree a -> Tree a -> Tree a
$cmax :: forall a. Ord a => Tree a -> Tree a -> Tree a
>= :: Tree a -> Tree a -> Bool
$c>= :: forall a. Ord a => Tree a -> Tree a -> Bool
> :: Tree a -> Tree a -> Bool
$c> :: forall a. Ord a => Tree a -> Tree a -> Bool
<= :: Tree a -> Tree a -> Bool
$c<= :: forall a. Ord a => Tree a -> Tree a -> Bool
< :: Tree a -> Tree a -> Bool
$c< :: forall a. Ord a => Tree a -> Tree a -> Bool
compare :: Tree a -> Tree a -> Ordering
$ccompare :: forall a. Ord a => Tree a -> Tree a -> Ordering
Ord -- ^ @since 0.6.5
           , ReadPrec [Tree a]
ReadPrec (Tree a)
ReadS [Tree a]
forall a. Read a => ReadPrec [Tree a]
forall a. Read a => ReadPrec (Tree a)
forall a. Read a => Int -> ReadS (Tree a)
forall a. Read a => ReadS [Tree a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tree a]
$creadListPrec :: forall a. Read a => ReadPrec [Tree a]
readPrec :: ReadPrec (Tree a)
$creadPrec :: forall a. Read a => ReadPrec (Tree a)
readList :: ReadS [Tree a]
$creadList :: forall a. Read a => ReadS [Tree a]
readsPrec :: Int -> ReadS (Tree a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Tree a)
Read
           , Int -> Tree a -> ShowS
forall a. Show a => Int -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree a] -> ShowS
$cshowList :: forall a. Show a => [Tree a] -> ShowS
show :: Tree a -> String
$cshow :: forall a. Show a => Tree a -> String
showsPrec :: Int -> Tree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
Show
           , Tree a -> DataType
Tree a -> Constr
forall {a}. Data a => Typeable (Tree a)
forall a. Data a => Tree a -> DataType
forall a. Data a => Tree a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Tree a -> Tree a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Tree a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Tree a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree a -> c (Tree a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree a -> c (Tree a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Tree a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Tree a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Tree a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Tree a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
gmapT :: (forall b. Data b => b -> b) -> Tree a -> Tree a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Tree a -> Tree a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree a))
dataTypeOf :: Tree a -> DataType
$cdataTypeOf :: forall a. Data a => Tree a -> DataType
toConstr :: Tree a -> Constr
$ctoConstr :: forall a. Data a => Tree a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree a -> c (Tree a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree a -> c (Tree a)
Data
           , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Tree a) x -> Tree a
forall a x. Tree a -> Rep (Tree a) x
$cto :: forall a x. Rep (Tree a) x -> Tree a
$cfrom :: forall a x. Tree a -> Rep (Tree a) x
Generic  -- ^ @since 0.5.8
           , forall a. Rep1 Tree a -> Tree a
forall a. Tree a -> Rep1 Tree a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Tree a -> Tree a
$cfrom1 :: forall a. Tree a -> Rep1 Tree a
Generic1 -- ^ @since 0.5.8
           )
#else
  deriving (Eq, Ord, Read, Show)
#endif

-- | This type synonym exists primarily for historical
-- reasons.
type Forest a = [Tree a]

#if MIN_VERSION_base(4,9,0)
-- | @since 0.5.9
instance Eq1 Tree where
  liftEq :: forall a b. (a -> b -> Bool) -> Tree a -> Tree b -> Bool
liftEq a -> b -> Bool
eq = Tree a -> Tree b -> Bool
leq
    where
      leq :: Tree a -> Tree b -> Bool
leq (Node a
a [Tree a]
fr) (Node b
a' [Tree b]
fr') = a -> b -> Bool
eq a
a b
a' Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq Tree a -> Tree b -> Bool
leq [Tree a]
fr [Tree b]
fr'

-- | @since 0.5.9
instance Ord1 Tree where
  liftCompare :: forall a b. (a -> b -> Ordering) -> Tree a -> Tree b -> Ordering
liftCompare a -> b -> Ordering
cmp = Tree a -> Tree b -> Ordering
lcomp
    where
      lcomp :: Tree a -> Tree b -> Ordering
lcomp (Node a
a [Tree a]
fr) (Node b
a' [Tree b]
fr') = a -> b -> Ordering
cmp a
a b
a' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare Tree a -> Tree b -> Ordering
lcomp [Tree a]
fr [Tree b]
fr'

-- | @since 0.5.9
instance Show1 Tree where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Tree a -> ShowS
liftShowsPrec Int -> a -> ShowS
shw [a] -> ShowS
shwl Int
p (Node a
a [Tree a]
fr) = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"Node {rootLabel = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
shw Int
0 a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          String -> ShowS
showString String
"subForest = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
shw [a] -> ShowS
shwl [Tree a]
fr forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          String -> ShowS
showString String
"}"

-- | @since 0.5.9
instance Read1 Tree where
  liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Tree a)
liftReadsPrec Int -> ReadS a
rd ReadS [a]
rdl Int
p = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
    \String
s -> do
      (String
"Node", String
s1) <- ReadS String
lex String
s
      (String
"{", String
s2) <- ReadS String
lex String
s1
      (String
"rootLabel", String
s3) <- ReadS String
lex String
s2
      (String
"=", String
s4) <- ReadS String
lex String
s3
      (a
a, String
s5) <- Int -> ReadS a
rd Int
0 String
s4
      (String
",", String
s6) <- ReadS String
lex String
s5
      (String
"subForest", String
s7) <- ReadS String
lex String
s6
      (String
"=", String
s8) <- ReadS String
lex String
s7
      ([Tree a]
fr, String
s9) <- forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rd ReadS [a]
rdl String
s8
      (String
"}", String
s10) <- ReadS String
lex String
s9
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> [Tree a] -> Tree a
Node a
a [Tree a]
fr, String
s10)
#endif

INSTANCE_TYPEABLE1(Tree)

instance Functor Tree where
    fmap :: forall a b. (a -> b) -> Tree a -> Tree b
fmap = forall a b. (a -> b) -> Tree a -> Tree b
fmapTree
    a
x <$ :: forall a b. a -> Tree b -> Tree a
<$ Node b
_ [Tree b]
ts = forall a. a -> [Tree a] -> Tree a
Node a
x (forall a b. (a -> b) -> [a] -> [b]
map (a
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) [Tree b]
ts)

fmapTree :: (a -> b) -> Tree a -> Tree b
fmapTree :: forall a b. (a -> b) -> Tree a -> Tree b
fmapTree a -> b
f (Node a
x [Tree a]
ts) = forall a. a -> [Tree a] -> Tree a
Node (a -> b
f a
x) (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> Tree a -> Tree b
fmapTree a -> b
f) [Tree a]
ts)
#if MIN_VERSION_base(4,8,0)
-- Safe coercions were introduced in 4.7.0, but I am not sure if they played
-- well enough with RULES to do what we want.
{-# NOINLINE [1] fmapTree #-}
{-# RULES
"fmapTree/coerce" fmapTree coerce = coerce
 #-}
#endif

instance Applicative Tree where
    pure :: forall a. a -> Tree a
pure a
x = forall a. a -> [Tree a] -> Tree a
Node a
x []
    Node a -> b
f [Tree (a -> b)]
tfs <*> :: forall a b. Tree (a -> b) -> Tree a -> Tree b
<*> tx :: Tree a
tx@(Node a
x [Tree a]
txs) =
        forall a. a -> [Tree a] -> Tree a
Node (a -> b
f a
x) (forall a b. (a -> b) -> [a] -> [b]
map (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) [Tree a]
txs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tree a
tx) [Tree (a -> b)]
tfs)
#if MIN_VERSION_base(4,10,0)
    liftA2 :: forall a b c. (a -> b -> c) -> Tree a -> Tree b -> Tree c
liftA2 a -> b -> c
f (Node a
x [Tree a]
txs) ty :: Tree b
ty@(Node b
y [Tree b]
tys) =
        forall a. a -> [Tree a] -> Tree a
Node (a -> b -> c
f a
x b
y) (forall a b. (a -> b) -> [a] -> [b]
map (a -> b -> c
f a
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) [Tree b]
tys forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\Tree a
tx -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Tree a
tx Tree b
ty) [Tree a]
txs)
#endif
    Node a
x [Tree a]
txs <* :: forall a b. Tree a -> Tree b -> Tree a
<* ty :: Tree b
ty@(Node b
_ [Tree b]
tys) =
        forall a. a -> [Tree a] -> Tree a
Node a
x (forall a b. (a -> b) -> [a] -> [b]
map (a
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) [Tree b]
tys forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tree b
ty) [Tree a]
txs)
    Node a
_ [Tree a]
txs *> :: forall a b. Tree a -> Tree b -> Tree b
*> ty :: Tree b
ty@(Node b
y [Tree b]
tys) =
        forall a. a -> [Tree a] -> Tree a
Node b
y ([Tree b]
tys forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tree b
ty) [Tree a]
txs)

instance Monad Tree where
    return :: forall a. a -> Tree a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Node a
x [Tree a]
ts >>= :: forall a b. Tree a -> (a -> Tree b) -> Tree b
>>= a -> Tree b
f = case a -> Tree b
f a
x of
        Node b
x' [Tree b]
ts' -> forall a. a -> [Tree a] -> Tree a
Node b
x' ([Tree b]
ts' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Tree b
f) [Tree a]
ts)

-- | @since 0.5.11
instance MonadFix Tree where
  mfix :: forall a. (a -> Tree a) -> Tree a
mfix = forall a. (a -> Tree a) -> Tree a
mfixTree

mfixTree :: (a -> Tree a) -> Tree a
mfixTree :: forall a. (a -> Tree a) -> Tree a
mfixTree a -> Tree a
f
  | Node a
a [Tree a]
children <- forall a. (a -> a) -> a
fix (a -> Tree a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel)
  = forall a. a -> [Tree a] -> Tree a
Node a
a (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Tree a
_ -> forall a. (a -> Tree a) -> Tree a
mfixTree ((forall a. [a] -> Int -> a
!! Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> [Tree a]
subForest forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Tree a
f))
                    [Int
0..] [Tree a]
children)

instance Traversable Tree where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree a -> f (Tree b)
traverse a -> f b
f (Node a
x [Tree a]
ts) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> [Tree a] -> Tree a
Node (a -> f b
f a
x) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) [Tree a]
ts)

instance Foldable Tree where
    foldMap :: forall m a. Monoid m => (a -> m) -> Tree a -> m
foldMap a -> m
f (Node a
x [Tree a]
ts) = a -> m
f a
x forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [Tree a]
ts

#if MIN_VERSION_base(4,8,0)
    null :: forall a. Tree a -> Bool
null Tree a
_ = Bool
False
    {-# INLINE null #-}
    toList :: forall a. Tree a -> [a]
toList = forall a. Tree a -> [a]
flatten
    {-# INLINE toList #-}
#endif

instance NFData a => NFData (Tree a) where
    rnf :: Tree a -> ()
rnf (Node a
x [Tree a]
ts) = forall a. NFData a => a -> ()
rnf a
x seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Tree a]
ts

instance MonadZip Tree where
  mzipWith :: forall a b c. (a -> b -> c) -> Tree a -> Tree b -> Tree c
mzipWith a -> b -> c
f (Node a
a [Tree a]
as) (Node b
b [Tree b]
bs)
    = forall a. a -> [Tree a] -> Tree a
Node (a -> b -> c
f a
a b
b) (forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith (forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> b -> c
f) [Tree a]
as [Tree b]
bs)

  munzip :: forall a b. Tree (a, b) -> (Tree a, Tree b)
munzip (Node (a
a, b
b) [Tree (a, b)]
ts) = (forall a. a -> [Tree a] -> Tree a
Node a
a [Tree a]
as, forall a. a -> [Tree a] -> Tree a
Node b
b [Tree b]
bs)
    where ([Tree a]
as, [Tree b]
bs) = forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b)
munzip (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b)
munzip [Tree (a, b)]
ts)

-- | 2-dimensional ASCII drawing of a tree.
--
-- ==== __Examples__
--
-- > putStr $ drawTree $ fmap show (Node 1 [Node 2 [], Node 3 []])
--
-- @
-- 1
-- |
-- +- 2
-- |
-- `- 3
-- @
--
drawTree :: Tree String -> String
drawTree :: Tree String -> String
drawTree  = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree String -> [String]
draw

-- | 2-dimensional ASCII drawing of a forest.
--
-- ==== __Examples__
--
-- > putStr $ drawForest $ map (fmap show) [(Node 1 [Node 2 [], Node 3 []]), (Node 10 [Node 20 []])]
--
-- @
-- 1
-- |
-- +- 2
-- |
-- `- 3
--
-- 10
-- |
-- `- 20
-- @
--
drawForest :: [Tree String] -> String
drawForest :: [Tree String] -> String
drawForest  = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Tree String -> String
drawTree

draw :: Tree String -> [String]
draw :: Tree String -> [String]
draw (Node String
x [Tree String]
ts0) = String -> [String]
lines String
x forall a. [a] -> [a] -> [a]
++ [Tree String] -> [String]
drawSubTrees [Tree String]
ts0
  where
    drawSubTrees :: [Tree String] -> [String]
drawSubTrees [] = []
    drawSubTrees [Tree String
t] =
        String
"|" forall a. a -> [a] -> [a]
: forall {a}. [a] -> [a] -> [[a]] -> [[a]]
shift String
"`- " String
"   " (Tree String -> [String]
draw Tree String
t)
    drawSubTrees (Tree String
t:[Tree String]
ts) =
        String
"|" forall a. a -> [a] -> [a]
: forall {a}. [a] -> [a] -> [[a]] -> [[a]]
shift String
"+- " String
"|  " (Tree String -> [String]
draw Tree String
t) forall a. [a] -> [a] -> [a]
++ [Tree String] -> [String]
drawSubTrees [Tree String]
ts

    shift :: [a] -> [a] -> [[a]] -> [[a]]
shift [a]
first [a]
other = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++) ([a]
first forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat [a]
other)

-- | Returns the elements of a tree in pre-order.
--
-- @
--
--   a
--  / \\    => [a,b,c]
-- b   c
-- @
--
-- ==== __Examples__
--
-- > flatten (Node 1 [Node 2 [], Node 3 []]) == [1,2,3]
flatten :: Tree a -> [a]
flatten :: forall a. Tree a -> [a]
flatten Tree a
t = forall {a}. Tree a -> [a] -> [a]
squish Tree a
t []
  where squish :: Tree a -> [a] -> [a]
squish (Node a
x [Tree a]
ts) [a]
xs = a
xforall a. a -> [a] -> [a]
:forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr Tree a -> [a] -> [a]
squish [a]
xs [Tree a]
ts

-- | Returns the list of nodes at each level of the tree.
--
-- @
--
--   a
--  / \\    => [[a], [b,c]]
-- b   c
-- @
--
-- ==== __Examples__
--
-- > levels (Node 1 [Node 2 [], Node 3 []]) == [[1],[2,3]]
--
levels :: Tree a -> [[a]]
levels :: forall a. Tree a -> [[a]]
levels Tree a
t =
    forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a. Tree a -> a
rootLabel) forall a b. (a -> b) -> a -> b
$
        forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$
        forall a. (a -> a) -> a -> [a]
iterate (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [Tree a]
subForest) [Tree a
t]

-- | Fold a tree into a "summary" value in depth-first order.
--
-- For each node in the tree, apply @f@ to the @rootLabel@ and the result
-- of applying @f@ to each @subForest@.
--
-- This is also known as the catamorphism on trees.
--
-- ==== __Examples__
--
-- Sum the values in a tree:
--
-- > foldTree (\x xs -> sum (x:xs)) (Node 1 [Node 2 [], Node 3 []]) == 6
--
-- Find the maximum value in the tree:
--
-- > foldTree (\x xs -> maximum (x:xs)) (Node 1 [Node 2 [], Node 3 []]) == 3
--
-- Count the number of leaves in the tree:
--
-- > foldTree (\_ xs -> if null xs then 1 else sum xs) (Node 1 [Node 2 [], Node 3 []]) == 2
--
-- Find depth of the tree; i.e. the number of branches from the root of the tree to the furthest leaf:
--
-- > foldTree (\_ xs -> if null xs then 0 else 1 + maximum xs) (Node 1 [Node 2 [], Node 3 []]) == 1
--
-- You can even implement traverse using foldTree:
--
-- > traverse' f = foldTree (\x xs -> liftA2 Node (f x) (sequenceA xs))
--
--
-- @since 0.5.8
foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree :: forall a b. (a -> [b] -> b) -> Tree a -> b
foldTree a -> [b] -> b
f = Tree a -> b
go where
    go :: Tree a -> b
go (Node a
x [Tree a]
ts) = a -> [b] -> b
f a
x (forall a b. (a -> b) -> [a] -> [b]
map Tree a -> b
go [Tree a]
ts)

-- | Build a (possibly infinite) tree from a seed value in breadth-first order.
--
-- @unfoldTree f b@ constructs a tree by starting with the tree
-- @Node { rootLabel=b, subForest=[] }@ and repeatedly applying @f@ to each
-- 'rootLabel' value in the tree's leaves to generate its 'subForest'.
--
-- For a monadic version see 'unfoldTreeM_BF'.
--
-- ==== __Examples__
--
-- Construct the tree of @Integer@s where each node has two children:
-- @left = 2*x@ and @right = 2*x + 1@, where @x@ is the 'rootLabel' of the node.
-- Stop when the values exceed 7.
--
-- > let buildNode x = if 2*x + 1 > 7 then (x, []) else (x, [2*x, 2*x+1])
-- > putStr $ drawTree $ fmap show $ unfoldTree buildNode 1
--
-- @
--
-- 1
-- |
-- +- 2
-- |  |
-- |  +- 4
-- |  |
-- |  `- 5
-- |
-- `- 3
--    |
--    +- 6
--    |
--    `- 7
-- @
--
unfoldTree :: (b -> (a, [b])) -> b -> Tree a
unfoldTree :: forall b a. (b -> (a, [b])) -> b -> Tree a
unfoldTree b -> (a, [b])
f b
b = let (a
a, [b]
bs) = b -> (a, [b])
f b
b in forall a. a -> [Tree a] -> Tree a
Node a
a (forall b a. (b -> (a, [b])) -> [b] -> [Tree a]
unfoldForest b -> (a, [b])
f [b]
bs)

-- | Build a (possibly infinite) forest from a list of seed values in
-- breadth-first order.
--
-- @unfoldForest f seeds@ invokes 'unfoldTree' on each seed value.
--
-- For a monadic version see 'unfoldForestM_BF'.
--
unfoldForest :: (b -> (a, [b])) -> [b] -> [Tree a]
unfoldForest :: forall b a. (b -> (a, [b])) -> [b] -> [Tree a]
unfoldForest b -> (a, [b])
f = forall a b. (a -> b) -> [a] -> [b]
map (forall b a. (b -> (a, [b])) -> b -> Tree a
unfoldTree b -> (a, [b])
f)

-- | Monadic tree builder, in depth-first order.
unfoldTreeM :: Monad m => (b -> m (a, [b])) -> b -> m (Tree a)
unfoldTreeM :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> b -> m (Tree a)
unfoldTreeM b -> m (a, [b])
f b
b = do
    (a
a, [b]
bs) <- b -> m (a, [b])
f b
b
    [Tree a]
ts <- forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> [b] -> m [Tree a]
unfoldForestM b -> m (a, [b])
f [b]
bs
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> [Tree a] -> Tree a
Node a
a [Tree a]
ts)

-- | Monadic forest builder, in depth-first order
unfoldForestM :: Monad m => (b -> m (a, [b])) -> [b] -> m ([Tree a])
unfoldForestM :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> [b] -> m [Tree a]
unfoldForestM b -> m (a, [b])
f = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM (forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> b -> m (Tree a)
unfoldTreeM b -> m (a, [b])
f)

-- | Monadic tree builder, in breadth-first order.
--
-- See 'unfoldTree' for more info.
--
-- Implemented using an algorithm adapted from /Breadth-First Numbering: Lessons
-- from a Small Exercise in Algorithm Design/, by Chris Okasaki, /ICFP'00/.
unfoldTreeM_BF :: Monad m => (b -> m (a, [b])) -> b -> m (Tree a)
unfoldTreeM_BF :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> b -> m (Tree a)
unfoldTreeM_BF b -> m (a, [b])
f b
b = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall {a}. Seq a -> a
getElement forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
unfoldForestQ b -> m (a, [b])
f (forall a. a -> Seq a
singleton b
b)
  where
    getElement :: Seq a -> a
getElement Seq a
xs = case forall a. Seq a -> ViewL a
viewl Seq a
xs of
        a
x :< Seq a
_ -> a
x
        ViewL a
EmptyL -> forall a. HasCallStack => String -> a
error String
"unfoldTreeM_BF"

-- | Monadic forest builder, in breadth-first order
--
-- See 'unfoldForest' for more info.
--
-- Implemented using an algorithm adapted from /Breadth-First Numbering: Lessons
-- from a Small Exercise in Algorithm Design/, by Chris Okasaki, /ICFP'00/.
unfoldForestM_BF :: Monad m => (b -> m (a, [b])) -> [b] -> m ([Tree a])
unfoldForestM_BF :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> [b] -> m [Tree a]
unfoldForestM_BF b -> m (a, [b])
f = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
unfoldForestQ b -> m (a, [b])
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Seq a
fromList

-- Takes a sequence (queue) of seeds and produces a sequence (reversed queue) of
-- trees of the same length.
unfoldForestQ :: Monad m => (b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
unfoldForestQ :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
unfoldForestQ b -> m (a, [b])
f Seq b
aQ = case forall a. Seq a -> ViewL a
viewl Seq b
aQ of
    ViewL b
EmptyL -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Seq a
empty
    b
a :< Seq b
aQ' -> do
        (a
b, [b]
as) <- b -> m (a, [b])
f b
a
        Seq (Tree a)
tQ <- forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
unfoldForestQ b -> m (a, [b])
f (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl forall a. Seq a -> a -> Seq a
(|>) Seq b
aQ' [b]
as)
        let (Seq (Tree a)
tQ', [Tree a]
ts) = forall a' b'. [a'] -> [b'] -> Seq a' -> (Seq a', [a'])
splitOnto [] [b]
as Seq (Tree a)
tQ
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> [Tree a] -> Tree a
Node a
b [Tree a]
ts forall a. a -> Seq a -> Seq a
<| Seq (Tree a)
tQ')
  where
    splitOnto :: [a'] -> [b'] -> Seq a' -> (Seq a', [a'])
    splitOnto :: forall a' b'. [a'] -> [b'] -> Seq a' -> (Seq a', [a'])
splitOnto [a']
as [] Seq a'
q = (Seq a'
q, [a']
as)
    splitOnto [a']
as (b'
_:[b']
bs) Seq a'
q = case forall a. Seq a -> ViewR a
viewr Seq a'
q of
        Seq a'
q' :> a'
a -> forall a' b'. [a'] -> [b'] -> Seq a' -> (Seq a', [a'])
splitOnto (a'
aforall a. a -> [a] -> [a]
:[a']
as) [b']
bs Seq a'
q'
        ViewR a'
EmptyR -> forall a. HasCallStack => String -> a
error String
"unfoldForestQ"