## Breadth-First Rose Tree Traversals

These use implicit queues to efficiently perform breadth-first operations on rose trees.

```
module BreadthFirst where
import Data.Tree
```

The most basic is simply converting to a list breadth-first:

```
breadthFirst :: Tree a -> [a]
breadthFirst (Node x xs) = x : breadthFirstForest xs
breadthFirstForest :: Forest a -> [a]
breadthFirstForest ts = foldr f b ts []
where
f (Node x xs) fw bw = x : fw (xs : bw)
b [] = []
b qs = foldl (foldr f) b qs []
```

Then, we can delimit between levels of the tree:

```
levels :: Tree a -> [[a]]
levels (Node x xs) = [x] : levelsForest xs
levelsForest :: Forest a -> [[a]]
levelsForest ts = foldl f b ts [] []
where
f k (Node x xs) ls qs = k (x : ls) (xs : qs)
b _ [] = []
b k qs = k : foldl (foldl f) b qs [] []
```

Finally, we can build a tree back up again, monadically.

```
unfoldForestM_BF :: Monad m => (b -> m (a, [b])) -> [b] -> m (Forest a)
unfoldForestM_BF = unfoldForestMWith_BF concat
unfoldTreeM_BF :: Monad m => (b -> m (a, [b])) -> b -> m (Tree a)
unfoldTreeM_BF f b = unfoldForestMWith_BF (head . head) f [b]
unfoldForestMWith_BF :: Monad m => ([Forest a] -> c) -> (b -> m (a, [b])) -> [b] -> m c
unfoldForestMWith_BF r f ts = b [ts] (\ls -> r . ls)
where
b [] k = pure (k id [])
b qs k = foldl g b qs [] (\ls -> k id . ls)
g a xs qs k = foldr t (\ls ys -> a ys (k . run ls)) xs [] qs
t a fw xs bw = f a >>= \(x,cs) -> fw (x:xs) (cs:bw)
run x xs = uncurry (:) . foldl go ((,) [] . xs) x
where
go ys y (z:zs) = (Node y z : ys', zs')
where
(ys',zs') = ys zs
```