{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | By providing a 'TreeLike' instance, a functor can be traversed in several
-- orders:
--
-- ['inorder' / 'InOrder']
--    Viewing a 'TreeLike' functor as a sequence of values and subtrees, an
--    /__inorder__/ traversal iterates through this sequence visiting values and
--    traversing subtrees in the order they are given.
--
--        >>> printTree (label inorder exampleBinaryTree)
--              ┌──────6───┐
--              │          │
--          ┌──2┴───┐   ┌7─┴──┐
--          │       │   │     │
--        ┌0┴┐    ┌─┴5┐ ╵  ┌─9┴─┐
--        │  │    │   │    │    │
--        ╵ ┌1┐ ┌3┴┐  ╵   ┌8┐ ┌10┐
--          │ │ │  │      │ │ │  │
--          ╵ ╵ ╵ ┌4┐     ╵ ╵ ╵  ╵
--                │ │
--                ╵ ╵
--
-- ['preorder' / 'PreOrder']
--  Viewing a 'TreeLike' functor as a sequence of values and subtrees, a
--  /__preorder__/ traversal visits all the values in the sequence before
--  traversing the subtrees.
--
--        >>> printTree (label preorder exampleBinaryTree)
--              ┌──────0───┐
--              │          │
--          ┌──1┴───┐   ┌7─┴──┐
--          │       │   │     │
--        ┌2┴┐    ┌─┴4┐ ╵  ┌─8┴─┐
--        │  │    │   │    │    │
--        ╵ ┌3┐ ┌5┴┐  ╵   ┌9┐ ┌10┐
--          │ │ │  │      │ │ │  │
--          ╵ ╵ ╵ ┌6┐     ╵ ╵ ╵  ╵
--                │ │
--                ╵ ╵
--
-- ['postorder' / 'PostOrder']
--  Viewing a 'TreeLike' functor as a sequence of values and subtrees, a
--  /__postorder__/ traversal traverses all the subtrees in the sequence
--  before visiting the values in the sequence before
--  traversing the subtrees.
--
--        >>> printTree (label postorder exampleBinaryTree)
--              ┌──────10───┐
--              │           │
--          ┌──5┴───┐    ┌9─┴─┐
--          │       │    │    │
--        ┌1┴┐    ┌─┴4┐  ╵  ┌─8─┐
--        │  │    │   │     │   │
--        ╵ ┌0┐ ┌3┴┐  ╵    ┌6┐ ┌7┐
--          │ │ │  │       │ │ │ │
--          ╵ ╵ ╵ ┌2┐      ╵ ╵ ╵ ╵
--                │ │
--                ╵ ╵
--
-- ['levelorder' / 'LevelOrder']
--  Similar to a preorder traversal, a /__levelorder__/ traversal first visits
--  all the values at the root level before traversing any of the subtrees.
--  Instead of traversing the subtrees one by one, though, a levelorder
--  traversal interweaves their traversals, next visiting all the values at the
--  root of each subtree, then visiting all the values at the roots of each
--  subtree's subtrees, and so on. This is also known as a breadth-first
--  traversal.
--
--        >>> printTree (label levelorder exampleBinaryTree)
--               ┌──────0───┐
--               │          │
--          ┌──1─┴───┐   ┌2─┴─┐
--          │        │   │    │
--        ┌3┴┐    ┌──┴4┐ ╵  ┌─5─┐
--        │  │    │    │    │   │
--        ╵ ┌6┐ ┌7┴─┐  ╵   ┌8┐ ┌9┐
--          │ │ │   │      │ │ │ │
--          ╵ ╵ ╵ ┌10┐     ╵ ╵ ╵ ╵
--                │  │
--                ╵  ╵
--
-- ['rlevelorder' / 'RLevelOrder']
--  Similar to a postlevel traversal, a /__reversed levelorder__/ traversal
--  only visits all the values at the root level after traversing all of the
--  subtrees.  Instead of traversing the subtrees one by one, though, a
--  reversed levelorder traversal interweaves their traversals, working
--  from the deepest level up, though still in left-to-right order.
--
--        >>> printTree (label rlevelorder exampleBinaryTree)
--              ┌──────10───┐
--              │           │
--          ┌──8┴───┐    ┌9─┴─┐
--          │       │    │    │
--        ┌5┴┐    ┌─┴6┐  ╵  ┌─7─┐
--        │  │    │   │     │   │
--        ╵ ┌1┐ ┌2┴┐  ╵    ┌3┐ ┌4┐
--          │ │ │  │       │ │ │ │
--          ╵ ╵ ╵ ┌0┐      ╵ ╵ ╵ ╵
--                │ │
--                ╵ ╵
--
module Data.Traversable.TreeLike 
  ( TreeLike(..), treeFoldMap
  -- | = TreeLike wrappers
  -- These @newtype@s define 'TreeLike' instances for 'Traversable' types.
  , Forest(..), Flat(..), List(..)
  -- | = Traversals
  -- Each 'TreeLike' type admits multiple traversal orders:
  --
  -- > inorder, preorder, postorder, levelorder, rlevelorder
  -- >   :: TreeLike tree => Traversal (tree a) (tree b) a b
  --
  -- Using the definition of 'Control.Lens.Traversal.Traversal' from
  -- "Control.Lens.Traversal":
  --
  -- > type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t 
  --
  , inorder, preorder, postorder, levelorder, rlevelorder
  -- | = Traversable wrappers
  -- These @newtype@s define 'Traversable' instances for 'TreeLike' types.
  , InOrder(..), PreOrder(..), PostOrder(..), LevelOrder(..), RLevelOrder(..)
  -- | = Convenience functions
  , showTree, printTree
  ) where

import Data.Functor.Compose (Compose(..))
import Data.Functor.Const (Const(..))
import Data.Functor.Product (Product(..))
import Data.Functor.Sum (Sum(..))
import Data.Traversable (foldMapDefault)
import Data.Tree hiding (Forest)

import Control.Applicative.Phases
import Data.BinaryTree
import Data.Monoid.TreeDiagram

-- | Render the tree as a string, using the 'TreeDiagram' monoid.
showTree :: (TreeLike tree, Show a) => tree a -> ShowS
showTree :: forall (tree :: * -> *) a.
(TreeLike tree, Show a) =>
tree a -> ShowS
showTree = TreeDiagram -> ShowS
showTreeDiagram forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m (tree :: * -> *) a.
(Monoid m, TreeLike tree) =>
(a -> m) -> (m -> m) -> tree a -> m
treeFoldMap forall a. Show a => a -> TreeDiagram
singleton TreeDiagram -> TreeDiagram
subtree

-- | Print the tree, using the 'TreeDiagram' monoid.
printTree :: (TreeLike tree, Show a) => tree a -> IO ()
printTree :: forall (tree :: * -> *) a.
(TreeLike tree, Show a) =>
tree a -> IO ()
printTree = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tree :: * -> *) a.
(TreeLike tree, Show a) =>
tree a -> ShowS
showTree

-- | Notionally, functors are 'TreeLike' if any values and 'TreeLike'
-- substructure they contain can be traversed distinctly.
--
-- For example, given the 'TreeDiagram' monoid, one can use 'treeTraverse' with
-- the  'Const' applicative to recursively create a drawing of any tree,
-- rendering values inline with 'singleton' and dropping a line to drawings of
-- subtrees with 'subtree':
--
-- >>> :{
-- printTree :: (Show a, TreeLike tree) => tree a -> IO ()
-- printTree = printTreeDiagram . drawTree where
--   drawTree :: (Show a, TreeLike tree) => tree a -> TreeDiagram
--   drawTree = getConst . treeTraverse (Const . singleton) (Const . subtree . drawTree)
-- :}
--
-- This common pattern of mapping each element to a monoid and then modifying
-- each monoidal value generated from a subtree is captured by 'treeFoldMap', which
-- gives a slightly less verbose implementation of @printTree@.
--
-- >>> printTree = printTreeDiagram . treeFoldMap singleton subtree
--
-- Instances of 'TreeLike' are encouraged to avoid recursively defining
-- 'treeTraverse' in terms of itself, and to instead traverse subtrees
-- using the provided argument.
--
-- For example, given this definition for balanced binary trees:
--
-- >>> :{
-- data BBT a = Nil | a `Cons` BBT (a,a)
--   deriving Functor
-- infixr 4 `Cons`
-- :}
--
-- Its 'TreeLike' instance can be defined as:
--
-- >>> :{
-- instance TreeLike BBT where
--   treeTraverse = \f g t -> case t of
--      Nil          -> pure Nil
--      a `Cons` at  -> branch <$> g (fst <$> at) <*> f a <*> g (snd <$> at)
--    where
--      branch :: BBT b -> b -> BBT b -> BBT b
--      branch Nil b ~Nil = b `Cons` Nil
--      branch (x `Cons` xt) b ~(y `Cons` yt) = b `Cons` branch xt (x,y) yt
-- :}
--
-- This definition exposes the substructure in a way that can be used
-- by functions implemented in terms of 'treeTraverse', such as @printTree@:
--
-- >>> printTree $ 1 `Cons` (2,3) `Cons` ((4,5),(6,7)) `Cons` Nil
--    ┌───1───┐
--    │       │
--  ┌─2─┐   ┌─3─┐
--  │   │   │   │
-- ┌4┐ ┌6┐ ┌5┐ ┌7┐
-- │ │ │ │ │ │ │ │
-- ╵ ╵ ╵ ╵ ╵ ╵ ╵ ╵
class Functor tree => TreeLike tree where
  treeTraverse :: Applicative f 
               => (a -> f b)
               -> (forall subtree. TreeLike subtree => subtree a -> f (subtree b))
               -> tree a -> f (tree b)

-- | Recursively fold a tree into a monoid, using the given functions to
-- transform values and folded subtrees.
--
-- For example, one can find the maximum depth of a tree:
--
-- >>> printTree exampleTree
-- []─┬─────┬───────────┬─────────────────────────────┐
--    │     │           │                             │
--   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
--            │       │       │            │       │                 │
--          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
--                                │                    │           │          │
--                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
--                                                                                 │
--                                                                             [3,2,1,0]
-- >>> :set -XGeneralizedNewtypeDeriving
-- >>> import GHC.Natural
-- >>> import Data.Semigroup
-- >>> :{
-- newtype Max = Max { getMax :: Natural } deriving (Num, Enum)
-- instance Semigroup Max where
--   (<>) = mappend
-- instance Monoid Max where
--   mempty = Max 0
--   Max a `mappend` Max b = Max $ a `max` b
-- :}
--
-- >>> getMax $ treeFoldMap (const 0) succ exampleTree
-- 4
treeFoldMap :: (Monoid m, TreeLike tree) => (a -> m) -> (m -> m) -> tree a -> m
treeFoldMap :: forall m (tree :: * -> *) a.
(Monoid m, TreeLike tree) =>
(a -> m) -> (m -> m) -> tree a -> m
treeFoldMap a -> m
f m -> m
g = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tree :: * -> *) (f :: * -> *) a b.
(TreeLike tree, Applicative f) =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> tree a
-> f (tree b)
treeTraverse (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> m
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m (tree :: * -> *) a.
(Monoid m, TreeLike tree) =>
(a -> m) -> (m -> m) -> tree a -> m
treeFoldMap a -> m
f m -> m
g)

instance TreeLike Tree where
  treeTraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> Tree a
-> f (Tree b)
treeTraverse a -> f b
f forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g (Node a
a [Tree a]
as) = forall a. a -> [Tree a] -> Tree a
Node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g [Tree a]
as

instance TreeLike BinaryTree where
  treeTraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> BinaryTree a
-> f (BinaryTree b)
treeTraverse a -> f b
_ forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
_ BinaryTree a
Leaf = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. BinaryTree a
Leaf
  treeTraverse a -> f b
f forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g (Branch BinaryTree a
l a
a BinaryTree a
r) = forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g BinaryTree a
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g BinaryTree a
r

-- |
-- Use 'Product' to combine a pair of 'TreeLike' values into a single tree.
--
-- >>> smallBinaryTree = Branch (Branch Leaf [0,1] Leaf) [0] (Branch Leaf [0,2] Leaf)
-- >>> smallRoseTree = Node [1] [Node [1,0] [], Node [1,1] [], Node [1,2] [], Node [1,3] []]
-- >>> printTree $ Pair smallBinaryTree smallRoseTree
--         ┌────────────────────┐
--         │                    │
--    ┌───[0]───┐   [1]──┬─────┬┴────┬─────┐
--    │         │        │     │     │     │
-- ┌[0,1]┐   ┌[0,2]┐   [1,0] [1,1] [1,2] [1,3]
-- │     │   │     │
-- ╵     ╵   ╵     ╵
-- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
-- >>> traversed <- postorder visit (Pair smallBinaryTree smallRoseTree) `evalStateT` 0
-- [0,1]
-- [0,2]
-- [0]
-- [1,0]
-- [1,1]
-- [1,2]
-- [1,3]
-- [1]
-- >>> printTree traversed
--    ┌───────┐
--    │       │
--  ┌─2─┐ 7┬─┬┴┬─┐
--  │   │  │ │ │ │
-- ┌0┐ ┌1┐ 3 4 5 6
-- │ │ │ │
-- ╵ ╵ ╵ ╵
instance (TreeLike fst, TreeLike snd) => TreeLike (Product fst snd) where
  treeTraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> Product fst snd a
-> f (Product fst snd b)
treeTraverse a -> f b
_ forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g (Pair fst a
x snd a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g fst a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g snd a
y

-- | Use 'Sum' to unify two different types of trees into a single type.
--
-- >>> smallBinaryTree = Branch (Branch Leaf [0,1] Leaf) [0] (Branch Leaf [0,2] Leaf)
-- >>> smallRoseTree = Node [1] [Node [1,0] [], Node [1,1] [], Node [1,2] [], Node [1,3] []]
-- >>> someTree b = if not b then InL smallBinaryTree else InR smallRoseTree
-- >>> :t someTree
-- someTree :: Num a => Bool -> Sum BinaryTree Tree [a]
-- >>> printTree (someTree False)
--         ╷
--         │
--    ┌───[0]───┐
--    │         │
-- ┌[0,1]┐   ┌[0,2]┐
-- │     │   │     │
-- ╵     ╵   ╵     ╵
-- >>> printTree (someTree True)
--             ╷
--             │
-- [1]──┬─────┬┴────┬─────┐
--      │     │     │     │
--    [1,0] [1,1] [1,2] [1,3]
instance (TreeLike left, TreeLike right) => TreeLike (Sum left right) where
  treeTraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> Sum left right a
-> f (Sum left right b)
treeTraverse a -> f b
_ forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g (InL left a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g left a
x
  treeTraverse a -> f b
_ forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g (InR right a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g right a
y

-- |
-- A newtype wrapper to allow traversing an entire traversable of trees
-- simultaneously.
--
-- >>> printTree $ Forest exampleTrees
--  ┌─────┬───────────┬─────────────────────────────┐
--  │     │           │                             │
-- [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
--          │       │       │            │       │                 │
--        [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
--                              │                    │           │          │
--                           [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
--                                                                               │
--                                                                           [3,2,1,0]
-- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
-- >>> traversed <- levelorder visit (Forest exampleTrees) `evalStateT` 0
-- [0]
-- [1]
-- [2]
-- [3]
-- [1,0]
-- [2,0]
-- [2,1]
-- [3,0]
-- [3,1]
-- [3,2]
-- [2,1,0]
-- [3,1,0]
-- [3,2,0]
-- [3,2,1]
-- [3,2,1,0]
-- >>> printTree traversed
-- ┌──┬───┬────────┐
-- │  │   │        │
-- 0 1┤ 2┬┴─┐ 3┬──┬┴────┐
--    │  │  │  │  │     │
--    4  5 6┴┐ 7 8┴┐ 9─┬┴──┐
--           │     │   │   │
--          10    11  12 13┴┐
--                          │
--                         14
--
-- This is more of a convenience than a necessity, as @'Forest' t tree ~
-- 'Compose' ('Flat' t) tree@
--
-- >>> printTree . Compose $ Flat exampleTrees
--  ┌─────┬───────────┬─────────────────────────────┐
--  │     │           │                             │
-- [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
--          │       │       │            │       │                 │
--        [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
--                              │                    │           │          │
--                           [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
--                                                                               │
--                                                                           [3,2,1,0]
newtype Forest t tree a = Forest { forall (t :: * -> *) (tree :: * -> *) a.
Forest t tree a -> t (tree a)
getForest :: t (tree a) }
  deriving forall a b. a -> Forest t tree b -> Forest t tree a
forall a b. (a -> b) -> Forest t tree a -> Forest t tree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (t :: * -> *) (tree :: * -> *) a b.
(Functor t, Functor tree) =>
a -> Forest t tree b -> Forest t tree a
forall (t :: * -> *) (tree :: * -> *) a b.
(Functor t, Functor tree) =>
(a -> b) -> Forest t tree a -> Forest t tree b
<$ :: forall a b. a -> Forest t tree b -> Forest t tree a
$c<$ :: forall (t :: * -> *) (tree :: * -> *) a b.
(Functor t, Functor tree) =>
a -> Forest t tree b -> Forest t tree a
fmap :: forall a b. (a -> b) -> Forest t tree a -> Forest t tree b
$cfmap :: forall (t :: * -> *) (tree :: * -> *) a b.
(Functor t, Functor tree) =>
(a -> b) -> Forest t tree a -> Forest t tree b
Functor

instance (Traversable t, TreeLike tree) => TreeLike (Forest t tree) where
  treeTraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> Forest t tree a
-> f (Forest t tree b)
treeTraverse a -> f b
_ forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) (tree :: * -> *) a.
t (tree a) -> Forest t tree a
Forest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (tree :: * -> *) a.
Forest t tree a -> t (tree a)
getForest

-- |
-- A newtype wrapper for @[a]@ whose `TreeLike` instance
-- treats each cons-cell as a tree containing one value and one subtree.
--
-- >>> printTree $ List [1..5]
-- 1─┐
--   │
--  2┴┐
--    │
--   3┴┐
--     │
--    4┴┐
--      │
--     5┤
--      │
--      ╵
-- >>> import Data.Foldable (toList)
-- >>> toList . PostOrder $ List [1..5]
-- [5,4,3,2,1]
-- 
-- Contrast with @'Flat' [] a@:
--
-- >>> printTree $ Flat [1..5]
-- 1─2─3─4─5
-- >>> toList . PostOrder $ Flat [1..5]
-- [1,2,3,4,5]
--
newtype List a = List { forall a. List a -> [a]
getList :: [a] }
  deriving forall a b. a -> List b -> List a
forall a b. (a -> b) -> List a -> List b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> List b -> List a
$c<$ :: forall a b. a -> List b -> List a
fmap :: forall a b. (a -> b) -> List a -> List b
$cfmap :: forall a b. (a -> b) -> List a -> List b
Functor

instance TreeLike List where
  treeTraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> List a
-> f (List b)
treeTraverse a -> f b
f forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g (List [a]
as) = forall a. [a] -> List a
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case [a]
as of
    []    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    a
a:[a]
as  -> (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. List a -> [a]
getList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. [a] -> List a
List) [a]
as


-- |
-- A newtype wraper for @t a@ whose `TreeLike` instance treats
-- the @t a@ as a flat structure with no subtrees.
--
-- >>> printTree $ Flat [1..5]
-- 1─2─3─4─5
-- >>> import Data.Foldable (toList)
-- >>> toList . PostOrder $ Flat [1..5]
-- [1,2,3,4,5]
newtype Flat t a = Flat { forall (t :: * -> *) a. Flat t a -> t a
getFlat :: t a }
  deriving forall a b. a -> Flat t b -> Flat t a
forall a b. (a -> b) -> Flat t a -> Flat t b
forall (t :: * -> *) a b. Functor t => a -> Flat t b -> Flat t a
forall (t :: * -> *) a b.
Functor t =>
(a -> b) -> Flat t a -> Flat t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Flat t b -> Flat t a
$c<$ :: forall (t :: * -> *) a b. Functor t => a -> Flat t b -> Flat t a
fmap :: forall a b. (a -> b) -> Flat t a -> Flat t b
$cfmap :: forall (t :: * -> *) a b.
Functor t =>
(a -> b) -> Flat t a -> Flat t b
Functor

instance Traversable t => TreeLike (Flat t) where
  treeTraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> Flat t a
-> f (Flat t b)
treeTraverse a -> f b
f forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
_ (Flat t a
ta) = forall (t :: * -> *) a. t a -> Flat t a
Flat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f t a
ta


-- |
-- Treat subtrees and values of @outer (inner a)@ as subtrees of
-- @'Compose' outer inner a@.
--
-- For example 
--
-- >>> :{
-- exampleCompose =  Compose $ 
--    Branch 
--      (Branch Leaf (Node 'a' [Node 'b' [], Node 'c' [], Node 'd' []]) Leaf)
--      (Node 'e' [Node 'f' [Node 'g' [], Node 'h' []]]) 
--      (Branch Leaf (Node 'i' [Node 'i' [Node 'j' [Node 'k' []]]]) Leaf)
-- :}
-- 
-- >>> printTree exampleCompose
--         ┌─────────────┬───────────────┐
--         │             │               │
-- ┌───────┼───────┐ 'e'─┴──┐     ┌────┬─┴──────┐
-- │       │       │        │     │    │        │
-- ╵ 'a'─┬─┴─┬───┐ ╵    'f'─┼───┐ ╵ 'i'┴──┐     ╵
--       │   │   │          │   │         │
--      'b' 'c' 'd'        'g' 'h'     'i'┴─┐
--                                          │
--                                        'j'─┐
--                                            │
--                                           'k'
-- >>> treeFoldMap (const ["value"]) (const ["subtree"]) exampleCompose
-- ["subtree","subtree","subtree"]
instance (TreeLike outer, TreeLike inner) => TreeLike (Compose outer inner) where
  treeTraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> Compose outer inner a
-> f (Compose outer inner b)
treeTraverse a -> f b
_ forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g (Compose outer (inner a)
trees) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (tree :: * -> *) (f :: * -> *) a b.
(TreeLike tree, Applicative f) =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> tree a
-> f (tree b)
treeTraverse forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (subtree :: * -> *).
TreeLike subtree =>
subtree a -> f (subtree b)
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose) outer (inner a)
trees
  
-- | Traverse all the values in a tree in left-to-right order.
--
-- >>> printTree exampleBinaryTree
--                     ┌──────────────────────[]────────┐
--                     │                                │
--      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
--      │                            │          │              │
-- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
-- │         │              │                │          │             │
-- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
--       │       │   │            │                 │       │     │       │
--       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
--                           │         │
--                           ╵         ╵
-- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
-- >>> traversed <- inorder visit exampleBinaryTree `evalStateT` 0
-- [L,L]
-- [L,L,R]
-- [L]
-- [L,R,L]
-- [L,R,L,R]
-- [L,R]
-- []
-- [R]
-- [R,R,L]
-- [R,R]
-- [R,R,R]
-- >>> printTree traversed
--       ┌──────6───┐
--       │          │
--   ┌──2┴───┐   ┌7─┴──┐
--   │       │   │     │
-- ┌0┴┐    ┌─┴5┐ ╵  ┌─9┴─┐
-- │  │    │   │    │    │
-- ╵ ┌1┐ ┌3┴┐  ╵   ┌8┐ ┌10┐
--   │ │ │  │      │ │ │  │
--   ╵ ╵ ╵ ┌4┐     ╵ ╵ ╵  ╵
--         │ │
--         ╵ ╵
-- >>> printTree exampleTree
-- []─┬─────┬───────────┬─────────────────────────────┐
--    │     │           │                             │
--   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
--            │       │       │            │       │                 │
--          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
--                                │                    │           │          │
--                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
--                                                                                 │
--                                                                             [3,2,1,0]
-- >>> traversed <- inorder visit exampleTree `evalStateT` 0
-- []
-- [0]
-- [1]
-- [1,0]
-- [2]
-- [2,0]
-- [2,1]
-- [2,1,0]
-- [3]
-- [3,0]
-- [3,1]
-- [3,1,0]
-- [3,2]
-- [3,2,0]
-- [3,2,1]
-- [3,2,1,0]
-- >>> printTree traversed
-- 0┬──┬───┬─────────┐
--  │  │   │         │
--  1 2┤ 4┬┴─┐ 8┬───┬┴─────┐
--     │  │  │  │   │      │
--     3  5 6┤  9 10┴┐ 12─┬┴──┐
--           │       │    │   │
--           7      11   13 14┴┐
--                             │
--                            15
inorder :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> f (tree b)
inorder :: forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
inorder a -> f b
f = forall (tree :: * -> *) (f :: * -> *) a b.
(TreeLike tree, Applicative f) =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> tree a
-> f (tree b)
treeTraverse a -> f b
f (forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
inorder a -> f b
f)

-- | Traverse all the values of a node, then recurse into each of its subtrees
-- in left-to-right order.
--
-- >>> printTree exampleBinaryTree
--                     ┌──────────────────────[]────────┐
--                     │                                │
--      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
--      │                            │          │              │
-- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
-- │         │              │                │          │             │
-- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
--       │       │   │            │                 │       │     │       │
--       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
--                           │         │
--                           ╵         ╵
-- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
-- >>> traversed <- preorder visit exampleBinaryTree `evalStateT` 0
-- []
-- [L]
-- [L,L]
-- [L,L,R]
-- [L,R]
-- [L,R,L]
-- [L,R,L,R]
-- [R]
-- [R,R]
-- [R,R,L]
-- [R,R,R]
-- >>> printTree traversed
--       ┌──────0───┐
--       │          │
--   ┌──1┴───┐   ┌7─┴──┐
--   │       │   │     │
-- ┌2┴┐    ┌─┴4┐ ╵  ┌─8┴─┐
-- │  │    │   │    │    │
-- ╵ ┌3┐ ┌5┴┐  ╵   ┌9┐ ┌10┐
--   │ │ │  │      │ │ │  │
--   ╵ ╵ ╵ ┌6┐     ╵ ╵ ╵  ╵
--         │ │
--         ╵ ╵
-- >>> printTree exampleTree
-- []─┬─────┬───────────┬─────────────────────────────┐
--    │     │           │                             │
--   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
--            │       │       │            │       │                 │
--          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
--                                │                    │           │          │
--                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
--                                                                                 │
--                                                                             [3,2,1,0]
-- >>> traversed <- inorder visit exampleTree `evalStateT` 0
-- []
-- [0]
-- [1]
-- [1,0]
-- [2]
-- [2,0]
-- [2,1]
-- [2,1,0]
-- [3]
-- [3,0]
-- [3,1]
-- [3,1,0]
-- [3,2]
-- [3,2,0]
-- [3,2,1]
-- [3,2,1,0]
-- >>> printTree traversed
-- 0┬──┬───┬─────────┐
--  │  │   │         │
--  1 2┤ 4┬┴─┐ 8┬───┬┴─────┐
--     │  │  │  │   │      │
--     3  5 6┤  9 10┴┐ 12─┬┴──┐
--           │       │    │   │
--           7      11   13 14┴┐
--                             │
--                            15
preorder :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> f (tree b)
preorder :: forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
preorder a -> f b
f = forall (f :: * -> *) a. Applicative f => Phases f a -> f a
runPhasesForwards forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tree :: * -> *) (f :: * -> *) a b.
(TreeLike tree, Applicative f) =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> tree a
-> f (tree b)
treeTraverse (forall (f :: * -> *) a. f a -> Phases f a
now forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) (forall (f :: * -> *) a. Applicative f => f a -> Phases f a
later forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
preorder a -> f b
f)

-- | Traverse all the values of a node after recursing into each of its
-- subtrees in left-to-right order.
--
-- >>> printTree exampleBinaryTree
--                     ┌──────────────────────[]────────┐
--                     │                                │
--      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
--      │                            │          │              │
-- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
-- │         │              │                │          │             │
-- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
--       │       │   │            │                 │       │     │       │
--       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
--                           │         │
--                           ╵         ╵
-- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
-- >>> traversed <- postorder visit exampleBinaryTree `evalStateT` 0
-- [L,L,R]
-- [L,L]
-- [L,R,L,R]
-- [L,R,L]
-- [L,R]
-- [L]
-- [R,R,L]
-- [R,R,R]
-- [R,R]
-- [R]
-- []
-- >>> printTree traversed
--       ┌──────10───┐
--       │           │
--   ┌──5┴───┐    ┌9─┴─┐
--   │       │    │    │
-- ┌1┴┐    ┌─┴4┐  ╵  ┌─8─┐
-- │  │    │   │     │   │
-- ╵ ┌0┐ ┌3┴┐  ╵    ┌6┐ ┌7┐
--   │ │ │  │       │ │ │ │
--   ╵ ╵ ╵ ┌2┐      ╵ ╵ ╵ ╵
--         │ │
--         ╵ ╵
-- >>> printTree exampleTree
-- []─┬─────┬───────────┬─────────────────────────────┐
--    │     │           │                             │
--   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
--            │       │       │            │       │                 │
--          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
--                                │                    │           │          │
--                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
--                                                                                 │
--                                                                             [3,2,1,0]
-- >>> traversed <- postorder visit exampleTree `evalStateT` 0
-- [0]
-- [1,0]
-- [1]
-- [2,0]
-- [2,1,0]
-- [2,1]
-- [2]
-- [3,0]
-- [3,1,0]
-- [3,1]
-- [3,2,0]
-- [3,2,1,0]
-- [3,2,1]
-- [3,2]
-- [3]
-- []
-- >>> printTree traversed
-- 15┬──┬───┬─────────┐
--   │  │   │         │
--   0 2┤ 6┬┴─┐ 14┬──┬┴────┐
--      │  │  │   │  │     │
--      1  3 5┤   7 9┤ 13─┬┴──┐
--            │      │    │   │
--            4      8   10 12┴┐
--                             │
--                            11
postorder :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> f (tree b)
postorder :: forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
postorder a -> f b
f = forall (f :: * -> *) a. Applicative f => Phases f a -> f a
runPhasesBackwards forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tree :: * -> *) (f :: * -> *) a b.
(TreeLike tree, Applicative f) =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> tree a
-> f (tree b)
treeTraverse (forall (f :: * -> *) a. f a -> Phases f a
now forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) (forall (f :: * -> *) a. Applicative f => f a -> Phases f a
later forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
postorder a -> f b
f)

-- | Traverse all the values of a tree in left-to-right breadth-first order.
-- (i.e. all nodes of depth @0@, then all nodes of depth @1@, then all nodes of
-- depth @2@, etc.)
--
-- >>> printTree exampleBinaryTree
--                     ┌──────────────────────[]────────┐
--                     │                                │
--      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
--      │                            │          │              │
-- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
-- │         │              │                │          │             │
-- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
--       │       │   │            │                 │       │     │       │
--       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
--                           │         │
--                           ╵         ╵
-- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
-- >>> traversed <- levelorder visit exampleBinaryTree `evalStateT` 0
-- []
-- [L]
-- [R]
-- [L,L]
-- [L,R]
-- [R,R]
-- [L,L,R]
-- [L,R,L]
-- [R,R,L]
-- [R,R,R]
-- [L,R,L,R]
-- >>> printTree traversed
--        ┌──────0───┐
--        │          │
--   ┌──1─┴───┐   ┌2─┴─┐
--   │        │   │    │
-- ┌3┴┐    ┌──┴4┐ ╵  ┌─5─┐
-- │  │    │    │    │   │
-- ╵ ┌6┐ ┌7┴─┐  ╵   ┌8┐ ┌9┐
--   │ │ │   │      │ │ │ │
--   ╵ ╵ ╵ ┌10┐     ╵ ╵ ╵ ╵
--         │  │
--         ╵  ╵
-- >>> printTree exampleTree
-- []─┬─────┬───────────┬─────────────────────────────┐
--    │     │           │                             │
--   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
--            │       │       │            │       │                 │
--          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
--                                │                    │           │          │
--                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
--                                                                                 │
--                                                                             [3,2,1,0]
-- >>> traversed <- levelorder visit exampleTree `evalStateT` 0
-- []
-- [0]
-- [1]
-- [2]
-- [3]
-- [1,0]
-- [2,0]
-- [2,1]
-- [3,0]
-- [3,1]
-- [3,2]
-- [2,1,0]
-- [3,1,0]
-- [3,2,0]
-- [3,2,1]
-- [3,2,1,0]
-- >>> printTree traversed
-- 0┬──┬───┬─────────┐
--  │  │   │         │
--  1 2┤ 3┬┴─┐ 4┬──┬─┴────┐
--     │  │  │  │  │      │
--     5  6 7┴┐ 8 9┴┐ 10─┬┴──┐
--            │     │    │   │
--           11    12   13 14┴┐
--                            │
--                           15
levelorder :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> f (tree b)
levelorder :: forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
levelorder = \a -> f b
f -> forall (f :: * -> *) a. Applicative f => Phases f a -> f a
runPhasesForwards forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> Phases f (tree b)
schedule a -> f b
f where
  schedule :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> Phases f (tree b)
  schedule :: forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> Phases f (tree b)
schedule a -> f b
f = forall (tree :: * -> *) (f :: * -> *) a b.
(TreeLike tree, Applicative f) =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> tree a
-> f (tree b)
treeTraverse (forall (f :: * -> *) a. f a -> Phases f a
now forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) (forall (f :: * -> *) a. Applicative f => Phases f a -> Phases f a
delay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> Phases f (tree b)
schedule a -> f b
f)

-- | Traverse all the values of a tree in left-to-right inverse breadth-first order.
-- (i.e. all nodes of @n@, then all nodes of depth @n-1@, then all nodes of
-- depth @n-2@, etc.)
--
-- >>> printTree exampleBinaryTree
--                     ┌──────────────────────[]────────┐
--                     │                                │
--      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
--      │                            │          │              │
-- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
-- │         │              │                │          │             │
-- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
--       │       │   │            │                 │       │     │       │
--       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
--                           │         │
--                           ╵         ╵
-- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
-- >>> traversed <- rlevelorder visit exampleBinaryTree `evalStateT` 0
-- [L,R,L,R]
-- [L,L,R]
-- [L,R,L]
-- [R,R,L]
-- [R,R,R]
-- [L,L]
-- [L,R]
-- [R,R]
-- [L]
-- [R]
-- []
-- >>> printTree traversed
--       ┌──────10───┐
--       │           │
--   ┌──8┴───┐    ┌9─┴─┐
--   │       │    │    │
-- ┌5┴┐    ┌─┴6┐  ╵  ┌─7─┐
-- │  │    │   │     │   │
-- ╵ ┌1┐ ┌2┴┐  ╵    ┌3┐ ┌4┐
--   │ │ │  │       │ │ │ │
--   ╵ ╵ ╵ ┌0┐      ╵ ╵ ╵ ╵
--         │ │
--         ╵ ╵
-- >>> printTree exampleTree
-- []─┬─────┬───────────┬─────────────────────────────┐
--    │     │           │                             │
--   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
--            │       │       │            │       │                 │
--          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
--                                │                    │           │          │
--                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
--                                                                                 │
--                                                                             [3,2,1,0]
-- >>> traversed <- rlevelorder visit exampleTree `evalStateT` 0
-- [3,2,1,0]
-- [2,1,0]
-- [3,1,0]
-- [3,2,0]
-- [3,2,1]
-- [1,0]
-- [2,0]
-- [2,1]
-- [3,0]
-- [3,1]
-- [3,2]
-- [0]
-- [1]
-- [2]
-- [3]
-- []
-- >>> printTree traversed
-- 15─┬──┬─────┬────────┐
--    │  │     │        │
--   11 12┐ 13┬┴─┐ 14┬──┼────┐
--        │   │  │   │  │    │
--        5   6 7┤   8 9┤ 10┬┴─┐
--               │      │   │  │
--               1      2   3 4┤
--                             │
--                             0
rlevelorder :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> f (tree b)
rlevelorder :: forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
rlevelorder = \a -> f b
f -> forall (f :: * -> *) a. Applicative f => Phases f a -> f a
runPhasesBackwards forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> Phases f (tree b)
schedule a -> f b
f where
  schedule :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> Phases f (tree b)
  schedule :: forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> Phases f (tree b)
schedule a -> f b
f = forall (tree :: * -> *) (f :: * -> *) a b.
(TreeLike tree, Applicative f) =>
(a -> f b)
-> (forall (subtree :: * -> *).
    TreeLike subtree =>
    subtree a -> f (subtree b))
-> tree a
-> f (tree b)
treeTraverse (forall (f :: * -> *) a. f a -> Phases f a
now forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) (forall (f :: * -> *) a. Applicative f => Phases f a -> Phases f a
delay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> Phases f (tree b)
schedule a -> f b
f)

-- | 'Tree' wrapper to use 'inorder' traversal
--
-- >>> printTree exampleBinaryTree
--                     ┌──────────────────────[]────────┐
--                     │                                │
--      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
--      │                            │          │              │
-- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
-- │         │              │                │          │             │
-- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
--       │       │   │            │                 │       │     │       │
--       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
--                           │         │
--                           ╵         ╵
-- >>> _ <- traverse print $ InOrder exampleBinaryTree
-- [L,L]
-- [L,L,R]
-- [L]
-- [L,R,L]
-- [L,R,L,R]
-- [L,R]
-- []
-- [R]
-- [R,R,L]
-- [R,R]
-- [R,R,R]
newtype InOrder tree a = InOrder { forall (tree :: * -> *) a. InOrder tree a -> tree a
getInOrder :: tree a }
  deriving forall a b. a -> InOrder tree b -> InOrder tree a
forall a b. (a -> b) -> InOrder tree a -> InOrder tree b
forall (tree :: * -> *) a b.
Functor tree =>
a -> InOrder tree b -> InOrder tree a
forall (tree :: * -> *) a b.
Functor tree =>
(a -> b) -> InOrder tree a -> InOrder tree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> InOrder tree b -> InOrder tree a
$c<$ :: forall (tree :: * -> *) a b.
Functor tree =>
a -> InOrder tree b -> InOrder tree a
fmap :: forall a b. (a -> b) -> InOrder tree a -> InOrder tree b
$cfmap :: forall (tree :: * -> *) a b.
Functor tree =>
(a -> b) -> InOrder tree a -> InOrder tree b
Functor
instance TreeLike tree => Foldable (InOrder tree) where
  foldMap :: forall m a. Monoid m => (a -> m) -> InOrder tree a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance TreeLike tree => Traversable (InOrder tree) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> InOrder tree a -> f (InOrder tree b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (tree :: * -> *) a. tree a -> InOrder tree a
InOrder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
inorder a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tree :: * -> *) a. InOrder tree a -> tree a
getInOrder

-- | 'Tree' wrapper to use 'preorder' traversal
--
-- >>> printTree exampleBinaryTree
--                     ┌──────────────────────[]────────┐
--                     │                                │
--      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
--      │                            │          │              │
-- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
-- │         │              │                │          │             │
-- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
--       │       │   │            │                 │       │     │       │
--       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
--                           │         │
--                           ╵         ╵
-- >>> _ <- traverse print $ PreOrder exampleBinaryTree
-- []
-- [L]
-- [L,L]
-- [L,L,R]
-- [L,R]
-- [L,R,L]
-- [L,R,L,R]
-- [R]
-- [R,R]
-- [R,R,L]
-- [R,R,R]
newtype PreOrder tree a = PreOrder { forall (tree :: * -> *) a. PreOrder tree a -> tree a
getPreOrder :: tree a }
  deriving forall a b. a -> PreOrder tree b -> PreOrder tree a
forall a b. (a -> b) -> PreOrder tree a -> PreOrder tree b
forall (tree :: * -> *) a b.
Functor tree =>
a -> PreOrder tree b -> PreOrder tree a
forall (tree :: * -> *) a b.
Functor tree =>
(a -> b) -> PreOrder tree a -> PreOrder tree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PreOrder tree b -> PreOrder tree a
$c<$ :: forall (tree :: * -> *) a b.
Functor tree =>
a -> PreOrder tree b -> PreOrder tree a
fmap :: forall a b. (a -> b) -> PreOrder tree a -> PreOrder tree b
$cfmap :: forall (tree :: * -> *) a b.
Functor tree =>
(a -> b) -> PreOrder tree a -> PreOrder tree b
Functor
instance TreeLike tree => Foldable (PreOrder tree) where
  foldMap :: forall m a. Monoid m => (a -> m) -> PreOrder tree a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance TreeLike tree => Traversable (PreOrder tree) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PreOrder tree a -> f (PreOrder tree b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (tree :: * -> *) a. tree a -> PreOrder tree a
PreOrder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
preorder a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tree :: * -> *) a. PreOrder tree a -> tree a
getPreOrder

-- | 'Tree' wrapper to use 'postorder' traversal
--
-- >>> printTree exampleBinaryTree
--                     ┌──────────────────────[]────────┐
--                     │                                │
--      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
--      │                            │          │              │
-- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
-- │         │              │                │          │             │
-- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
--       │       │   │            │                 │       │     │       │
--       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
--                           │         │
--                           ╵         ╵
-- >>> _ <- traverse print $ PostOrder exampleBinaryTree
-- [L,L,R]
-- [L,L]
-- [L,R,L,R]
-- [L,R,L]
-- [L,R]
-- [L]
-- [R,R,L]
-- [R,R,R]
-- [R,R]
-- [R]
-- []
newtype PostOrder tree a = PostOrder { forall (tree :: * -> *) a. PostOrder tree a -> tree a
getPostOrder :: tree a }
  deriving forall a b. a -> PostOrder tree b -> PostOrder tree a
forall a b. (a -> b) -> PostOrder tree a -> PostOrder tree b
forall (tree :: * -> *) a b.
Functor tree =>
a -> PostOrder tree b -> PostOrder tree a
forall (tree :: * -> *) a b.
Functor tree =>
(a -> b) -> PostOrder tree a -> PostOrder tree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PostOrder tree b -> PostOrder tree a
$c<$ :: forall (tree :: * -> *) a b.
Functor tree =>
a -> PostOrder tree b -> PostOrder tree a
fmap :: forall a b. (a -> b) -> PostOrder tree a -> PostOrder tree b
$cfmap :: forall (tree :: * -> *) a b.
Functor tree =>
(a -> b) -> PostOrder tree a -> PostOrder tree b
Functor
instance TreeLike tree => Foldable (PostOrder tree) where
  foldMap :: forall m a. Monoid m => (a -> m) -> PostOrder tree a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance TreeLike tree => Traversable (PostOrder tree) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PostOrder tree a -> f (PostOrder tree b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (tree :: * -> *) a. tree a -> PostOrder tree a
PostOrder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
postorder a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tree :: * -> *) a. PostOrder tree a -> tree a
getPostOrder

-- | 'Tree' wrapper to use 'levelorder' traversal
--
-- >>> printTree exampleBinaryTree
--                     ┌──────────────────────[]────────┐
--                     │                                │
--      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
--      │                            │          │              │
-- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
-- │         │              │                │          │             │
-- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
--       │       │   │            │                 │       │     │       │
--       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
--                           │         │
--                           ╵         ╵
-- >>> _ <- traverse print $ LevelOrder exampleBinaryTree
-- []
-- [L]
-- [R]
-- [L,L]
-- [L,R]
-- [R,R]
-- [L,L,R]
-- [L,R,L]
-- [R,R,L]
-- [R,R,R]
-- [L,R,L,R]
newtype LevelOrder tree a = LevelOrder { forall (tree :: * -> *) a. LevelOrder tree a -> tree a
getLevelOrder :: tree a }
  deriving forall a b. a -> LevelOrder tree b -> LevelOrder tree a
forall a b. (a -> b) -> LevelOrder tree a -> LevelOrder tree b
forall (tree :: * -> *) a b.
Functor tree =>
a -> LevelOrder tree b -> LevelOrder tree a
forall (tree :: * -> *) a b.
Functor tree =>
(a -> b) -> LevelOrder tree a -> LevelOrder tree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> LevelOrder tree b -> LevelOrder tree a
$c<$ :: forall (tree :: * -> *) a b.
Functor tree =>
a -> LevelOrder tree b -> LevelOrder tree a
fmap :: forall a b. (a -> b) -> LevelOrder tree a -> LevelOrder tree b
$cfmap :: forall (tree :: * -> *) a b.
Functor tree =>
(a -> b) -> LevelOrder tree a -> LevelOrder tree b
Functor
instance TreeLike tree => Foldable (LevelOrder tree) where
  foldMap :: forall m a. Monoid m => (a -> m) -> LevelOrder tree a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance TreeLike tree => Traversable (LevelOrder tree) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LevelOrder tree a -> f (LevelOrder tree b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (tree :: * -> *) a. tree a -> LevelOrder tree a
LevelOrder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
levelorder a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tree :: * -> *) a. LevelOrder tree a -> tree a
getLevelOrder

-- | 'Tree' wrapper to use 'rlevelorder' traversal
--
-- >>> printTree exampleBinaryTree
--                     ┌──────────────────────[]────────┐
--                     │                                │
--      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
--      │                            │          │              │
-- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
-- │         │              │                │          │             │
-- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
--       │       │   │            │                 │       │     │       │
--       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
--                           │         │
--                           ╵         ╵
-- >>> _ <- traverse print $ RLevelOrder exampleBinaryTree
-- [L,R,L,R]
-- [L,L,R]
-- [L,R,L]
-- [R,R,L]
-- [R,R,R]
-- [L,L]
-- [L,R]
-- [R,R]
-- [L]
-- [R]
-- []
newtype RLevelOrder tree a = RLevelOrder { forall (tree :: * -> *) a. RLevelOrder tree a -> tree a
getRLevelOrder :: tree a }
  deriving forall a b. a -> RLevelOrder tree b -> RLevelOrder tree a
forall a b. (a -> b) -> RLevelOrder tree a -> RLevelOrder tree b
forall (tree :: * -> *) a b.
Functor tree =>
a -> RLevelOrder tree b -> RLevelOrder tree a
forall (tree :: * -> *) a b.
Functor tree =>
(a -> b) -> RLevelOrder tree a -> RLevelOrder tree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RLevelOrder tree b -> RLevelOrder tree a
$c<$ :: forall (tree :: * -> *) a b.
Functor tree =>
a -> RLevelOrder tree b -> RLevelOrder tree a
fmap :: forall a b. (a -> b) -> RLevelOrder tree a -> RLevelOrder tree b
$cfmap :: forall (tree :: * -> *) a b.
Functor tree =>
(a -> b) -> RLevelOrder tree a -> RLevelOrder tree b
Functor
instance TreeLike tree => Foldable (RLevelOrder tree) where
  foldMap :: forall m a. Monoid m => (a -> m) -> RLevelOrder tree a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance TreeLike tree => Traversable (RLevelOrder tree) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RLevelOrder tree a -> f (RLevelOrder tree b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (tree :: * -> *) a. tree a -> RLevelOrder tree a
RLevelOrder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (tree :: * -> *) a b.
(Applicative f, TreeLike tree) =>
(a -> f b) -> tree a -> f (tree b)
rlevelorder a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tree :: * -> *) a. RLevelOrder tree a -> tree a
getRLevelOrder

-- $setup
-- >>> :set -XDeriveFunctor
-- >>> import Control.Monad.State
-- >>> data Direction = L | R deriving Show
-- >>> :{
-- next :: a -> State Int Int
-- next = const . state $ \n -> (n, n+1)
-- label :: ((a -> State Int Int) -> tree a -> State Int (tree Int)) -> tree a -> tree Int
-- label traversal tree = traversal next tree `evalState` (0 :: Int)
-- :}
--
-- >>> :{
-- exampleTrees :: [Tree [Int]]
-- exampleTrees =
--   [ Node [0] []
--   , Node [1] [Node [1,0] []]
--   , Node [2] [Node [2,0] [], Node [2,1] [Node [2,1,0] []]]
--   , Node [3]
--     [ Node [3,0] []
--     , Node [3,1] [Node [3,1,0] []]
--     , Node [3,2] [Node [3,2,0] [], Node [3,2,1] [Node [3,2,1,0] []]]
--     ]
--   ]
-- exampleTree :: Tree [Int]
-- exampleTree = Node [] exampleTrees
-- exampleBinaryTree :: BinaryTree [Direction]
-- exampleBinaryTree = 
--   Branch
--   ( Branch
--       ( Branch
--           Leaf
--           [L,L]
--           (Branch Leaf [L,L,R] Leaf)
--       )
--       [L]
--       ( Branch
--           ( Branch 
--               Leaf
--               [L,R,L]
--               (Branch Leaf [L,R,L,R] Leaf)
--           )
--           [L,R]
--           Leaf
--       )
--   )
--   []
--   ( Branch
--       Leaf
--       [R]
--       ( Branch
--           (Branch Leaf [R,R,L] Leaf)
--           [R,R]
--           (Branch Leaf [R,R,R] Leaf)
--       )
--   )
-- :}