{-# 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
(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
/= :: 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
           , 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
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
[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
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
           , 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 -> DataType
Tree a -> Constr
(forall b. Data b => b -> b) -> Tree a -> Tree a
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 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))
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 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
$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. 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
$cto1 :: forall a. Rep1 Tree a -> Tree a
$cfrom1 :: forall a. Tree a -> Rep1 Tree a
Generic1 -- ^ @since 0.5.8
           )
#else
  deriving (Eq, 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
&& (Tree a -> Tree b -> Bool) -> [Tree a] -> [Tree 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 (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 (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 (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 (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)
#endif

INSTANCE_TYPEABLE1(Tree)

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 (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)
#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 = 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 (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 (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 (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 (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 (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 (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 (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. [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 (Node a
x [Tree a]
ts) = (b -> [Tree b] -> Tree b) -> f b -> f [Tree b] -> f (Tree b)
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)
traverse ((a -> f b) -> Tree a -> f (Tree b)
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 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (Tree a -> m) -> [Tree a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Tree a -> m
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 = Tree a -> [a]
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) = a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
`seq` [Tree a] -> ()
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)
    = 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 (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 (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 (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 (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
t = Tree a -> [a] -> [a]
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
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(Tree a -> [a] -> [a]) -> [a] -> [Tree 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 =
    ([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 (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 (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)
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 (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 (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 (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 (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"