X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FTree.hs;h=2ba7b1ab0618e04a7eaf7db0d9f81ece1b147617;hb=78e47c07f1587f736ef2484101451555183a039a;hp=ac046d9aecb915c8cf33f0defeeaab02ab86fd3d;hpb=ff7467962f4da6ffbe5fe94d464d38b7ce862910;p=ghc-base.git

diff --git a/Data/Tree.hs b/Data/Tree.hs
index ac046d9..2ba7b1a 100644
--- a/Data/Tree.hs
+++ b/Data/Tree.hs
@@ -10,17 +10,27 @@
 --
 -- Multi-way trees (/aka/ rose trees) and forests.
 --
--- Also included are neat presentations for trees and forests.
---
 -----------------------------------------------------------------------------
 
 module Data.Tree(
 	Tree(..), Forest,
+	drawTree, drawForest,
 	flatten, levels,
     ) where
 
+#ifdef __HADDOCK__
+import Prelude
+#endif
+
 -- | Multi-way trees, also known as /rose trees/.
 data Tree a   = Node a (Forest a) -- ^ a value and zero or more child trees.
+#ifndef __HADDOCK__
+  deriving (Eq, Read, Show)
+#else /* __HADDOCK__ (which can't figure these out by itself) */
+instance Eq a => Eq (Tree a)
+instance Read a => Read (Tree a)
+instance Show a => Show (Tree a)
+#endif
 type Forest a = [Tree a]
 
 instance Functor Tree where
@@ -29,22 +39,13 @@ instance Functor Tree where
 mapTree              :: (a -> b) -> (Tree a -> Tree b)
 mapTree f (Node x ts) = Node (f x) (map (mapTree f) ts)
 
--- explicit instance for Haddock's benefit
-instance Eq a => Eq (Tree a) where
-  Node x ts == Node x' ts'  =  x == x' && ts == ts'
-
-instance Show a => Show (Tree a) where
-  show = showTree
-  showList ts s = showForest ts ++ s
-
-showTree :: Show a => Tree a -> String
-showTree  = drawTree . mapTree show
-
-showForest :: Show a => Forest a -> String
-showForest  = unlines . map showTree
+-- | Neat 2-dimensional drawing of a tree.
+drawTree :: Show a => Tree a -> String
+drawTree  = unlines . draw . mapTree show
 
-drawTree :: Tree String -> String
-drawTree  = unlines . draw
+-- | Neat 2-dimensional drawing of a forest.
+drawForest :: Show a => Forest a -> String
+drawForest  = unlines . map drawTree
 
 draw :: Tree String -> [String]
 draw (Node x ts0) = grp this (space (length this)) (stLoop ts0)