{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# 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

import Utils.Containers.Internal.Prelude as Prelude
import Prelude ()
import Data.Foldable (fold, foldl', toList)
import Data.Traversable (foldMapDefault)
import Control.Monad (liftM)
import Control.Monad.Fix (MonadFix (..), fix)
import Data.Sequence (Seq, empty, singleton, (<|), (|>), fromList,
            ViewL(..), ViewR(..), viewl, viewr)
import Control.DeepSeq (NFData(rnf))

#ifdef __GLASGOW_HASKELL__
import Data.Data (Data)
import GHC.Generics (Generic, Generic1)
import Language.Haskell.TH.Syntax (Lift)
-- See Note [ Template Haskell Dependencies ]
import Language.Haskell.TH ()
#endif

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

import Data.Coerce

import Data.Functor.Classes

#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif

#if MIN_VERSION_base(4,18,0)
import qualified Data.Foldable1 as Foldable1
import Data.List.NonEmpty (NonEmpty(..))
#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
(Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool) -> Eq (Tree a)
forall a. Eq a => Tree a -> Tree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Tree a -> Tree a -> Bool
Eq
           , Eq (Tree a)
Eq (Tree a) =>
(Tree a -> Tree a -> Ordering)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Tree a)
-> (Tree a -> Tree a -> Tree a)
-> Ord (Tree a)
Tree a -> Tree a -> Bool
Tree a -> Tree a -> Ordering
Tree a -> Tree a -> Tree a
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
$ccompare :: forall a. Ord a => Tree a -> Tree a -> Ordering
compare :: Tree a -> Tree a -> Ordering
$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
>= :: Tree a -> Tree a -> Bool
$cmax :: forall a. Ord a => Tree a -> Tree a -> Tree a
max :: Tree a -> Tree a -> Tree a
$cmin :: forall a. Ord a => Tree a -> Tree a -> Tree a
min :: Tree a -> Tree a -> Tree a
Ord -- ^ @since 0.6.5
           , ReadPrec [Tree a]
ReadPrec (Tree a)
Int -> ReadS (Tree a)
ReadS [Tree a]
(Int -> ReadS (Tree a))
-> ReadS [Tree a]
-> ReadPrec (Tree a)
-> ReadPrec [Tree a]
-> Read (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
$creadsPrec :: forall a. Read a => Int -> ReadS (Tree a)
readsPrec :: Int -> ReadS (Tree a)
$creadList :: forall a. Read a => ReadS [Tree a]
readList :: ReadS [Tree a]
$creadPrec :: forall a. Read a => ReadPrec (Tree a)
readPrec :: ReadPrec (Tree a)
$creadListPrec :: forall a. Read a => ReadPrec [Tree a]
readListPrec :: ReadPrec [Tree a]
Read
           , Int -> Tree a -> ShowS
[Tree a] -> ShowS
Tree a -> String
(Int -> Tree a -> ShowS)
-> (Tree a -> String) -> ([Tree a] -> ShowS) -> Show (Tree a)
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
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
showsPrec :: Int -> Tree a -> ShowS
$cshow :: forall a. Show a => Tree a -> String
show :: Tree a -> String
$cshowList :: forall a. Show a => [Tree a] -> ShowS
showList :: [Tree a] -> ShowS
Show
           , Typeable (Tree a)
Typeable (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 (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Tree a))
-> (Tree a -> Constr)
-> (Tree a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Tree a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a)))
-> ((forall b. Data b => b -> b) -> Tree a -> Tree a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Tree a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Tree a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Tree a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Tree a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Tree a -> m (Tree a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree a -> m (Tree a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree a -> m (Tree a))
-> Data (Tree a)
Tree a -> Constr
Tree a -> DataType
(forall b. Data b => b -> b) -> Tree a -> Tree a
forall a. Data a => Typeable (Tree a)
forall a. Data a => Tree a -> Constr
forall a. Data a => Tree a -> DataType
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 u. Int -> (forall d. Data d => d -> u) -> Tree a -> u
forall u. (forall d. Data d => d -> u) -> Tree a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree 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))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree a -> 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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree a)
$ctoConstr :: forall a. Data a => Tree a -> Constr
toConstr :: Tree a -> Constr
$cdataTypeOf :: forall a. Data a => Tree a -> DataType
dataTypeOf :: Tree a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Tree a -> Tree a
gmapT :: (forall b. Data b => b -> b) -> Tree a -> Tree a
$cgmapQl :: 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
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Tree a -> [u]
gmapQ :: forall u. (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
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Tree a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad 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)
$cgmapMp :: 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)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
Data
           , (forall x. Tree a -> Rep (Tree a) x)
-> (forall x. Rep (Tree a) x -> Tree a) -> Generic (Tree a)
forall x. Rep (Tree a) x -> Tree a
forall x. Tree a -> Rep (Tree a) x
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
$cfrom :: forall a x. Tree a -> Rep (Tree a) x
from :: forall x. Tree a -> Rep (Tree a) x
$cto :: forall a x. Rep (Tree a) x -> Tree a
to :: forall x. Rep (Tree a) x -> Tree a
Generic  -- ^ @since 0.5.8
           , (forall a. Tree a -> Rep1 Tree a)
-> (forall a. Rep1 Tree a -> Tree a) -> Generic1 Tree
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
$cfrom1 :: forall a. Tree a -> Rep1 Tree a
from1 :: forall a. Tree a -> Rep1 Tree a
$cto1 :: forall a. Rep1 Tree a -> Tree a
to1 :: forall a. Rep1 Tree a -> Tree a
Generic1 -- ^ @since 0.5.8
           , (forall (m :: * -> *). Quote m => Tree a -> m Exp)
-> (forall (m :: * -> *). Quote m => Tree a -> Code m (Tree a))
-> Lift (Tree a)
forall a (m :: * -> *). (Lift a, Quote m) => Tree a -> m Exp
forall a (m :: * -> *).
(Lift a, Quote m) =>
Tree a -> Code m (Tree a)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Tree a -> m Exp
forall (m :: * -> *). Quote m => Tree a -> Code m (Tree a)
$clift :: forall a (m :: * -> *). (Lift a, Quote m) => Tree a -> m Exp
lift :: forall (m :: * -> *). Quote m => Tree a -> m Exp
$cliftTyped :: forall a (m :: * -> *).
(Lift a, Quote m) =>
Tree a -> Code m (Tree a)
liftTyped :: forall (m :: * -> *). Quote m => Tree a -> Code m (Tree a)
Lift -- ^ @since 0.6.6
           )
#else
  deriving (Eq, Ord, Read, Show)
#endif

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

-- | @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
&& (Tree a -> Tree b -> Bool) -> [Tree a] -> [Tree b] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> 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' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (Tree a -> Tree b -> Ordering) -> [Tree a] -> [Tree b] -> Ordering
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"Node {rootLabel = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
shw Int
0 a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          String -> ShowS
showString String
"subForest = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Tree a] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [Tree a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
shw [a] -> ShowS
shwl [Tree a]
fr ShowS -> ShowS -> ShowS
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 = Bool -> ReadS (Tree a) -> ReadS (Tree a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Tree a) -> ReadS (Tree a))
-> ReadS (Tree a) -> ReadS (Tree a)
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) <- (Int -> ReadS a) -> ReadS [a] -> ReadS [Tree a]
forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Tree a]
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
      (Tree a, String) -> [(Tree a, String)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a [Tree a]
fr, String
s10)

instance Functor Tree where
    fmap :: forall a b. (a -> b) -> Tree a -> Tree b
fmap = (a -> b) -> Tree a -> Tree b
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 = a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
x ((Tree b -> Tree a) -> [Tree b] -> [Tree a]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> Tree b -> Tree a
forall a b. a -> Tree b -> Tree a
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) = b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node (a -> b
f a
x) ((Tree a -> Tree b) -> [Tree a] -> [Tree b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Tree a -> Tree b
forall a b. (a -> b) -> Tree a -> Tree b
fmapTree a -> b
f) [Tree a]
ts)

#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] fmapTree #-}
{-# RULES
"fmapTree/coerce" fmapTree coerce = coerce
 #-}
#endif

instance Applicative Tree where
    pure :: forall a. a -> Tree a
pure a
x = a -> [Tree a] -> Tree a
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) =
        b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node (a -> b
f a
x) ((Tree a -> Tree b) -> [Tree a] -> [Tree b]
forall a b. (a -> b) -> [a] -> [b]
map (a -> b
f (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) [Tree a]
txs [Tree b] -> [Tree b] -> [Tree b]
forall a. [a] -> [a] -> [a]
++ (Tree (a -> b) -> Tree b) -> [Tree (a -> b)] -> [Tree b]
forall a b. (a -> b) -> [a] -> [b]
map (Tree (a -> b) -> Tree a -> Tree b
forall a b. Tree (a -> b) -> Tree a -> Tree b
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) =
        c -> [Tree c] -> Tree c
forall a. a -> [Tree a] -> Tree a
Node (a -> b -> c
f a
x b
y) ((Tree b -> Tree c) -> [Tree b] -> [Tree c]
forall a b. (a -> b) -> [a] -> [b]
map (a -> b -> c
f a
x (b -> c) -> Tree b -> Tree c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) [Tree b]
tys [Tree c] -> [Tree c] -> [Tree c]
forall a. [a] -> [a] -> [a]
++ (Tree a -> Tree c) -> [Tree a] -> [Tree c]
forall a b. (a -> b) -> [a] -> [b]
map (\Tree a
tx -> (a -> b -> c) -> Tree a -> Tree b -> Tree c
forall a b c. (a -> b -> c) -> Tree a -> Tree b -> Tree c
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) =
        a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
x ((Tree b -> Tree a) -> [Tree b] -> [Tree a]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> Tree b -> Tree a
forall a b. a -> Tree b -> Tree a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) [Tree b]
tys [Tree a] -> [Tree a] -> [Tree a]
forall a. [a] -> [a] -> [a]
++ (Tree a -> Tree a) -> [Tree a] -> [Tree a]
forall a b. (a -> b) -> [a] -> [b]
map (Tree a -> Tree b -> Tree a
forall a b. Tree a -> Tree b -> Tree a
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) =
        b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node b
y ([Tree b]
tys [Tree b] -> [Tree b] -> [Tree b]
forall a. [a] -> [a] -> [a]
++ (Tree a -> Tree b) -> [Tree a] -> [Tree b]
forall a b. (a -> b) -> [a] -> [b]
map (Tree a -> Tree b -> Tree b
forall a b. Tree a -> Tree b -> Tree b
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 = a -> Tree a
forall a. a -> Tree a
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' -> b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node b
x' ([Tree b]
ts' [Tree b] -> [Tree b] -> [Tree b]
forall a. [a] -> [a] -> [a]
++ (Tree a -> Tree b) -> [Tree a] -> [Tree b]
forall a b. (a -> b) -> [a] -> [b]
map (Tree a -> (a -> Tree b) -> Tree b
forall a b. Tree a -> (a -> Tree b) -> Tree b
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 = (a -> Tree a) -> Tree a
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 <- (Tree a -> Tree a) -> Tree a
forall a. (a -> a) -> a
fix (a -> Tree a
f (a -> Tree a) -> (Tree a -> a) -> Tree a -> Tree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> a
forall a. Tree a -> a
rootLabel)
  = a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a ((Int -> Tree a -> Tree a) -> [Int] -> [Tree a] -> [Tree a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Tree a
_ -> (a -> Tree a) -> Tree a
forall a. (a -> Tree a) -> Tree a
mfixTree (([Tree a] -> Int -> Tree a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) ([Tree a] -> Tree a) -> (a -> [Tree a]) -> a -> Tree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [Tree a]
forall a. Tree a -> [Tree a]
subForest (Tree a -> [Tree a]) -> (a -> Tree a) -> a -> [Tree a]
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 = Tree a -> f (Tree b)
go
    where go :: Tree a -> f (Tree b)
go (Node a
x [Tree a]
ts) = (b -> [Tree b] -> Tree b) -> f b -> f [Tree b] -> f (Tree b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node (a -> f b
f a
x) ((Tree a -> f (Tree b)) -> [Tree a] -> f [Tree b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Tree a -> f (Tree b)
go [Tree a]
ts)
  {-# INLINE traverse #-}

-- | Folds in preorder

-- See Note [Implemented Foldable Tree functions]
instance Foldable Tree where
    fold :: forall m. Monoid m => Tree m -> m
fold = (m -> m) -> Tree m -> m
forall m a. Monoid m => (a -> m) -> Tree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap m -> m
forall a. a -> a
id
    {-# INLINABLE fold #-}

    foldMap :: forall m a. Monoid m => (a -> m) -> Tree a -> m
foldMap = (a -> m) -> Tree a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
    {-# INLINE foldMap #-}

    foldr :: forall a b. (a -> b -> b) -> b -> Tree a -> b
foldr a -> b -> b
f b
z = \Tree a
t -> Tree a -> b -> b
go Tree a
t b
z  -- Use a lambda to allow inlining with two arguments
      where
        go :: Tree a -> b -> b
go (Node a
x [Tree a]
ts) = a -> b -> b
f a
x (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> (b -> b) -> b -> b) -> (b -> b) -> [Tree a] -> b -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Tree a
t b -> b
k -> Tree a -> b -> b
go Tree a
t (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
k) b -> b
forall a. a -> a
id [Tree a]
ts
        -- This is equivalent to the following simpler definition, but has been found to optimize
        -- better in benchmarks:
        -- go (Node x ts) z' = f x (foldr go z' ts)
    {-# INLINE foldr #-}

    foldl' :: forall b a. (b -> a -> b) -> b -> Tree a -> b
foldl' b -> a -> b
f = b -> Tree a -> b
go
      where go :: b -> Tree a -> b
go !b
z (Node a
x [Tree a]
ts) = (b -> Tree a -> b) -> b -> [Tree a] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Tree a -> b
go (b -> a -> b
f b
z a
x) [Tree a]
ts
    {-# INLINE foldl' #-}

    foldr1 :: forall a. (a -> a -> a) -> Tree a -> a
foldr1 = (a -> a) -> (a -> a -> a) -> Tree a -> a
forall a b. (a -> b) -> (a -> b -> b) -> Tree a -> b
foldrMap1 a -> a
forall a. a -> a
id

    foldl1 :: forall a. (a -> a -> a) -> Tree a -> a
foldl1 = (a -> a) -> (a -> a -> a) -> Tree a -> a
forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1 a -> a
forall a. a -> a
id

    null :: forall a. Tree a -> Bool
null Tree a
_ = Bool
False
    {-# INLINE null #-}

    elem :: forall a. Eq a => a -> Tree a -> Bool
elem = (a -> Bool) -> Tree a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((a -> Bool) -> Tree a -> Bool)
-> (a -> a -> Bool) -> a -> Tree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
    {-# INLINABLE elem #-}

    maximum :: forall a. Ord a => Tree a -> a
maximum = (a -> a) -> (a -> a -> a) -> Tree a -> a
forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1' a -> a
forall a. a -> a
id a -> a -> a
forall a. Ord a => a -> a -> a
max
    {-# INLINABLE maximum #-}

    minimum :: forall a. Ord a => Tree a -> a
minimum = (a -> a) -> (a -> a -> a) -> Tree a -> a
forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1' a -> a
forall a. a -> a
id a -> a -> a
forall a. Ord a => a -> a -> a
min
    {-# INLINABLE minimum #-}

    sum :: forall a. Num a => Tree a -> a
sum = (a -> a) -> (a -> a -> a) -> Tree a -> a
forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1' a -> a
forall a. a -> a
id a -> a -> a
forall a. Num a => a -> a -> a
(+)
    {-# INLINABLE sum #-}

    product :: forall a. Num a => Tree a -> a
product = (a -> a) -> (a -> a -> a) -> Tree a -> a
forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1' a -> a
forall a. a -> a
id a -> a -> a
forall a. Num a => a -> a -> a
(*)
    {-# INLINABLE product #-}

#if MIN_VERSION_base(4,18,0)
-- | Folds in preorder
--
-- @since 0.6.7

-- See Note [Implemented Foldable1 Tree functions]
instance Foldable1.Foldable1 Tree where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMap1 a -> m
f = Tree a -> m
go
    where
      -- We'd like to write
      --
      -- go (Node x (t : ts)) = f x <> Foldable1.foldMap1 go (t :| ts)
      --
      -- but foldMap1 for NonEmpty isn't very good, so we don't. See
      -- https://github.com/haskell/containers/pull/921#issuecomment-1410398618
      go :: Tree a -> m
go (Node a
x []) = a -> m
f a
x
      go (Node a
x (Tree a
t : [Tree a]
ts)) =
        a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Tree a -> m) -> (Tree a -> m -> m) -> NonEmpty (Tree a) -> m
forall a b. (a -> b) -> (a -> b -> b) -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
Foldable1.foldrMap1 Tree a -> m
go (\Tree a
t' m
z -> Tree a -> m
go Tree a
t' m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
z) (Tree a
t Tree a -> [Tree a] -> NonEmpty (Tree a)
forall a. a -> [a] -> NonEmpty a
:| [Tree a]
ts)
  {-# INLINABLE foldMap1 #-}

  foldMap1' :: forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMap1' a -> m
f = (a -> m) -> (m -> a -> m) -> Tree a -> m
forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1' a -> m
f (\m
z a
x -> m
z m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
x)
  {-# INLINABLE foldMap1' #-}

  toNonEmpty :: forall a. Tree a -> NonEmpty a
toNonEmpty (Node a
x [Tree a]
ts) = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| (Tree a -> [a]) -> [Tree a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree a -> [a]
forall a. Tree a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Tree a]
ts

  maximum :: forall a. Ord a => Tree a -> a
maximum = Tree a -> a
forall a. Ord a => Tree a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
  {-# INLINABLE maximum #-}

  minimum :: forall a. Ord a => Tree a -> a
minimum = Tree a -> a
forall a. Ord a => Tree a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum
  {-# INLINABLE minimum #-}

  foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> Tree a -> b
foldrMap1 = (a -> b) -> (a -> b -> b) -> Tree a -> b
forall a b. (a -> b) -> (a -> b -> b) -> Tree a -> b
foldrMap1

  foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1' = (a -> b) -> (b -> a -> b) -> Tree a -> b
forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1'

  foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1 = (a -> b) -> (b -> a -> b) -> Tree a -> b
forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1
#endif

foldrMap1 :: (a -> b) -> (a -> b -> b) -> Tree a -> b
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> Tree a -> b
foldrMap1 a -> b
f a -> b -> b
g = Tree a -> b
go
  where
    go :: Tree a -> b
go (Node a
x [])     = a -> b
f a
x
    go (Node a
x (Tree a
t:[Tree a]
ts)) = a -> b -> b
g a
x ((Tree a -> b) -> (Tree a -> b -> b) -> Tree a -> [Tree a] -> b
forall a b. (a -> b) -> (a -> b -> b) -> a -> [a] -> b
foldrMap1NE Tree a -> b
go (\Tree a
t' b
z -> (a -> b -> b) -> b -> Tree a -> b
forall a b. (a -> b -> b) -> b -> Tree a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
g b
z Tree a
t') Tree a
t [Tree a]
ts)
{-# INLINE foldrMap1 #-}

-- This is foldrMap1 for Data.List.NonEmpty, but is not available before
-- base 4.18.
foldrMap1NE :: (a -> b) -> (a -> b -> b) -> a -> [a] -> b
foldrMap1NE :: forall a b. (a -> b) -> (a -> b -> b) -> a -> [a] -> b
foldrMap1NE a -> b
f a -> b -> b
g = a -> [a] -> b
go
  where
    go :: a -> [a] -> b
go a
x []      = a -> b
f a
x
    go a
x (a
x':[a]
xs) = a -> b -> b
g a
x (a -> [a] -> b
go a
x' [a]
xs)
{-# INLINE foldrMap1NE #-}

foldlMap1' :: (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1' a -> b
f b -> a -> b
g =  -- Use a lambda to allow inlining with two arguments
  \(Node a
x [Tree a]
ts) -> (b -> Tree a -> b) -> b -> [Tree a] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((b -> a -> b) -> b -> Tree a -> b
forall b a. (b -> a -> b) -> b -> Tree a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
g) (a -> b
f a
x) [Tree a]
ts
{-# INLINE foldlMap1' #-}

foldlMap1 :: (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1 a -> b
f b -> a -> b
g =  -- Use a lambda to allow inlining with two arguments
  \(Node a
x [Tree a]
ts) -> (b -> Tree a -> b) -> b -> [Tree a] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((b -> a -> b) -> b -> Tree a -> b
forall b a. (b -> a -> b) -> b -> Tree a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
g) (a -> b
f a
x) [Tree a]
ts
{-# INLINE foldlMap1 #-}

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

-- | @since 0.5.10.1
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)
    = c -> [Tree c] -> Tree c
forall a. a -> [Tree a] -> Tree a
Node (a -> b -> c
f a
a b
b) ((Tree a -> Tree b -> Tree c) -> [Tree a] -> [Tree b] -> [Tree c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith ((a -> b -> c) -> Tree a -> Tree b -> Tree c
forall a b c. (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
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) = (a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a [Tree a]
as, b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node b
b [Tree b]
bs)
    where ([Tree a]
as, [Tree b]
bs) = [(Tree a, Tree b)] -> ([Tree a], [Tree b])
forall a b. [(a, b)] -> ([a], [b])
forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b)
munzip ((Tree (a, b) -> (Tree a, Tree b))
-> [Tree (a, b)] -> [(Tree a, Tree b)]
forall a b. (a -> b) -> [a] -> [b]
map Tree (a, b) -> (Tree a, Tree b)
forall a b. Tree (a, b) -> (Tree a, Tree b)
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 ([String] -> String)
-> (Tree String -> [String]) -> Tree String -> String
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 ([String] -> String)
-> ([Tree String] -> [String]) -> [Tree String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree String -> String) -> [Tree String] -> [String]
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 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Tree String] -> [String]
drawSubTrees [Tree String]
ts0
  where
    drawSubTrees :: [Tree String] -> [String]
drawSubTrees [] = []
    drawSubTrees [Tree String
t] =
        String
"|" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> String -> [String] -> [String]
forall {a}. [a] -> [a] -> [[a]] -> [[a]]
shift String
"`- " String
"   " (Tree String -> [String]
draw Tree String
t)
    drawSubTrees (Tree String
t:[Tree String]
ts) =
        String
"|" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> String -> [String] -> [String]
forall {a}. [a] -> [a] -> [[a]] -> [[a]]
shift String
"+- " String
"|  " (Tree String -> [String]
draw Tree String
t) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Tree String] -> [String]
drawSubTrees [Tree String]
ts

    shift :: [a] -> [a] -> [[a]] -> [[a]]
shift [a]
first [a]
other = ([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a]
first [a] -> [[a]] -> [[a]]
forall a. a -> [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 -> [a]
forall a. Tree a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | 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 =
    ([Tree a] -> [a]) -> [[Tree a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ((Tree a -> a) -> [Tree a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> a
forall a. Tree a -> a
rootLabel) ([[Tree a]] -> [[a]]) -> [[Tree a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$
        ([Tree a] -> Bool) -> [[Tree a]] -> [[Tree a]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ([Tree a] -> Bool) -> [Tree a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Tree a]] -> [[Tree a]]) -> [[Tree a]] -> [[Tree a]]
forall a b. (a -> b) -> a -> b
$
        ([Tree a] -> [Tree a]) -> [Tree a] -> [[Tree a]]
forall a. (a -> a) -> a -> [a]
iterate ((Tree a -> [Tree a]) -> [Tree a] -> [Tree a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree a -> [Tree a]
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 ((Tree a -> b) -> [Tree a] -> [b]
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 a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a ((b -> (a, [b])) -> [b] -> [Tree 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 = (b -> Tree a) -> [b] -> [Tree a]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> (a, [b])) -> b -> Tree a
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 <- (b -> m (a, [b])) -> [b] -> m [Tree a]
forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> [b] -> m [Tree a]
unfoldForestM b -> m (a, [b])
f [b]
bs
    Tree a -> m (Tree a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> [Tree a] -> Tree a
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 = (b -> m (Tree a)) -> [b] -> m [Tree a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Prelude.mapM ((b -> m (a, [b])) -> b -> m (Tree a)
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 = (Seq (Tree a) -> Tree a) -> m (Seq (Tree a)) -> m (Tree a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Seq (Tree a) -> Tree a
forall {a}. Seq a -> a
getElement (m (Seq (Tree a)) -> m (Tree a)) -> m (Seq (Tree a)) -> m (Tree a)
forall a b. (a -> b) -> a -> b
$ (b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
unfoldForestQ b -> m (a, [b])
f (b -> Seq b
forall a. a -> Seq a
singleton b
b)
  where
    getElement :: Seq a -> a
getElement Seq a
xs = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs of
        a
x :< Seq a
_ -> a
x
        ViewL a
EmptyL -> String -> a
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 = (Seq (Tree a) -> [Tree a]) -> m (Seq (Tree a)) -> m [Tree a]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Seq (Tree a) -> [Tree a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (m (Seq (Tree a)) -> m [Tree a])
-> ([b] -> m (Seq (Tree a))) -> [b] -> m [Tree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
unfoldForestQ b -> m (a, [b])
f (Seq b -> m (Seq (Tree a)))
-> ([b] -> Seq b) -> [b] -> m (Seq (Tree a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Seq b
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 Seq b -> ViewL b
forall a. Seq a -> ViewL a
viewl Seq b
aQ of
    ViewL b
EmptyL -> Seq (Tree a) -> m (Seq (Tree a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Seq (Tree a)
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 <- (b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
unfoldForestQ b -> m (a, [b])
f ((Seq b -> b -> Seq b) -> Seq b -> [b] -> Seq b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl Seq b -> b -> Seq b
forall a. Seq a -> a -> Seq a
(|>) Seq b
aQ' [b]
as)
        let (Seq (Tree a)
tQ', [Tree a]
ts) = [Tree a] -> [b] -> Seq (Tree a) -> (Seq (Tree a), [Tree a])
forall a' b'. [a'] -> [b'] -> Seq a' -> (Seq a', [a'])
splitOnto [] [b]
as Seq (Tree a)
tQ
        Seq (Tree a) -> m (Seq (Tree a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
b [Tree a]
ts Tree a -> Seq (Tree a) -> Seq (Tree a)
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 Seq a' -> ViewR a'
forall a. Seq a -> ViewR a
viewr Seq a'
q of
        Seq a'
q' :> a'
a -> [a'] -> [b'] -> Seq a' -> (Seq a', [a'])
forall a' b'. [a'] -> [b'] -> Seq a' -> (Seq a', [a'])
splitOnto (a'
aa' -> [a'] -> [a']
forall a. a -> [a] -> [a]
:[a']
as) [b']
bs Seq a'
q'
        ViewR a'
EmptyR -> String -> (Seq a', [a'])
forall a. HasCallStack => String -> a
error String
"unfoldForestQ"

--------------------------------------------------------------------------------

-- Note [Implemented Foldable Tree functions]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- Implemented:
--
-- foldMap, foldr, foldl': Basic functions.
-- fold, elem: Implemented same as the default definition, but INLINABLE to
-- allow specialization.
-- foldr1, foldl1, null, maximum, minimum: Implemented more efficiently than
-- defaults since trees are non-empty.
-- sum, product: Implemented as strict left folds. Defaults use the lazy foldMap
-- before base 4.15.1.
--
-- Not implemented:
--
-- foldMap', toList, length: Defaults perform well.
-- foldr', foldl: Unlikely to be used.

-- Note [Implemented Foldable1 Tree functions]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- Implemented:
--
-- foldrMap1, foldlMap1': Basic functions
-- foldMap, foldMap1': Implemented same as the default definition, but
-- INLINABLE to allow specialization.
-- toNonEmpty, foldlMap1: Implemented more efficiently than default.
-- maximum, minimum: Uses Foldable's implementation.
--
-- Not implemented:
--
-- fold1, head: Defaults perform well.
-- foldrMap1': Unlikely to be used.

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.

Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy