1 -----------------------------------------------------------------------------
4 -- Copyright : (c) The University of Glasgow 2002
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : portable
11 -- Multi-way trees (/aka/ rose trees) and forests.
13 -----------------------------------------------------------------------------
17 -- * Two-dimensional drawing
27 -- | Multi-way trees, also known as /rose trees/.
28 data Tree a = Node a (Forest a) -- ^ a value and zero or more child trees.
30 deriving (Eq, Read, Show)
31 #else /* __HADDOCK__ (which can't figure these out by itself) */
32 instance Eq a => Eq (Tree a)
33 instance Read a => Read (Tree a)
34 instance Show a => Show (Tree a)
36 type Forest a = [Tree a]
38 instance Functor Tree where
41 mapTree :: (a -> b) -> (Tree a -> Tree b)
42 mapTree f (Node x ts) = Node (f x) (map (mapTree f) ts)
44 -- | Neat 2-dimensional drawing of a tree.
45 drawTree :: Tree String -> String
46 drawTree = unlines . draw
48 -- | Neat 2-dimensional drawing of a forest.
49 drawForest :: Forest String -> String
50 drawForest = unlines . map drawTree
52 draw :: Tree String -> [String]
53 draw (Node x ts0) = x : drawSubTrees ts0
54 where drawSubTrees [] = []
56 "|" : shift "`- " " " (draw t)
58 "|" : shift "+- " "| " (draw t) ++ drawSubTrees ts
60 shift first other = zipWith (++) (first : repeat other)
62 -- | The elements of a tree in pre-order.
63 flatten :: Tree a -> [a]
64 flatten t = squish t []
65 where squish (Node x ts) xs = x:foldr squish xs ts
67 -- | Lists of nodes at each level of the tree.
68 levels :: Tree a -> [[a]]
69 levels t = map (map root) $ takeWhile (not . null) $ iterate subforest [t]
70 where root (Node x _) = x
71 subforest f = [t | Node _ ts <- f, t <- ts]