From: adam <adam@megacz.com>
Date: Sat, 7 Oct 2006 09:40:55 +0000 (-0400)
Subject: added pretty-printing and coalescing to SBP.hs
X-Git-Tag: tag_for_25-Mar~66
X-Git-Url: http://git.megacz.com/?p=sbp.git;a=commitdiff_plain;h=71a45bdaed968109d15c2be9657bb83c35d7e810

added pretty-printing and coalescing to SBP.hs

darcs-hash:20061007094055-5007d-e48902a607944fc80c4a181ec488798dd6af9068.gz
---

diff --git a/src/SBP.hs b/src/SBP.hs
index 2fec793..89fd9ca 100644
--- a/src/SBP.hs
+++ b/src/SBP.hs
@@ -20,6 +20,7 @@ module SBP
   import JavaTypes;
   import Data.Int;
   import Invocation;
+  import Text.PrettyPrint.HughesPJ
 
   -- Why do I need this?
   instance SubJavaClassMarker
@@ -32,9 +33,23 @@ module SBP
   data Tree     = Tree String [Tree] Region
   instance Show Tree
    where
-    show (Tree ""  []       region) = ""
-    show (Tree tag []       region) = tag
-    show (Tree tag children region) = tag ++ ":" ++ "{" ++ (unwords $ map show children) ++ "}"
+    show t@(Tree _ _ _) = show $ prettyPrintTree $ t
+
+  coalesceFlatHeadlessNodes t@(Tree s children r)
+    | s==[], flat t = Tree (concat $ map (\(Tree s _ _) -> s) children) [] r
+    | otherwise     = Tree s (map coalesceFlatHeadlessNodes children) r
+   where
+    flat (Tree _ children _) = not (any id $ map notFlatComponent children)
+    notFlatComponent (Tree _ [] _) = False
+    notFlatComponent (Tree _ _  _) = True
+
+  prettyPrintTree (Tree "" []       _) = empty
+  prettyPrintTree (Tree s  []       _) = text s
+  prettyPrintTree t@(Tree s children _)
+    | s==[]     = (text "{") <+> ((prettyPrintTreeList children) <+> (text "}"))
+    | otherwise = ((text s) <> (text ":")) <+> prettyPrintTreeList children
+     where
+      prettyPrintTreeList children = (vcat $ map prettyPrintTree children)
 
   nullRegion = (Region (Location 0 0) (Location 0 0))