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/.
29 rootLabel :: a, -- ^ label value
30 subForest :: Forest a -- ^ zero or more child trees
33 deriving (Eq, Read, Show)
34 #else /* __HADDOCK__ (which can't figure these out by itself) */
35 instance Eq a => Eq (Tree a)
36 instance Read a => Read (Tree a)
37 instance Show a => Show (Tree a)
39 type Forest a = [Tree a]
41 instance Functor Tree where
44 mapTree :: (a -> b) -> (Tree a -> Tree b)
45 mapTree f (Node x ts) = Node (f x) (map (mapTree f) ts)
47 -- | Neat 2-dimensional drawing of a tree.
48 drawTree :: Tree String -> String
49 drawTree = unlines . draw
51 -- | Neat 2-dimensional drawing of a forest.
52 drawForest :: Forest String -> String
53 drawForest = unlines . map drawTree
55 draw :: Tree String -> [String]
56 draw (Node x ts0) = x : drawSubTrees ts0
57 where drawSubTrees [] = []
59 "|" : shift "`- " " " (draw t)
61 "|" : shift "+- " "| " (draw t) ++ drawSubTrees ts
63 shift first other = zipWith (++) (first : repeat other)
65 -- | The elements of a tree in pre-order.
66 flatten :: Tree a -> [a]
67 flatten t = squish t []
68 where squish (Node x ts) xs = x:foldr squish xs ts
70 -- | Lists of nodes at each level of the tree.
71 levels :: Tree a -> [[a]]
72 levels t = map (map rootLabel) $
73 takeWhile (not . null) $
74 iterate (concatMap subForest) [t]