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 (file)
--- a/src/SBP.hs
+++ b/src/SBP.hs
@@ -20,6 +20,7 @@ module SBP
   import JavaTypes;
   import Data.Int;
   import Invocation;
   import JavaTypes;
   import Data.Int;
   import Invocation;

+  import Text.PrettyPrint.HughesPJ

 
   -- Why do I need this?
   instance SubJavaClassMarker
 
   -- Why do I need this?
   instance SubJavaClassMarker

@@ -32,9 +33,23 @@ module SBP
   data Tree     = Tree String [Tree] Region
   instance Show Tree
    where
   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))
 
 
   nullRegion = (Region (Location 0 0) (Location 0 0))