X-Git-Url: http://git.megacz.com/?p=sbp.git;a=blobdiff_plain;f=src%2FSBP.hs;h=89fd9ca98e85558bd30ca7d42e5912235070a4dc;hp=510a2d41fac5bab7f0d267c4aec0dde39e0fcbdc;hb=1d6f5a5f585a993cb780ea454fa1bd26d440c4ce;hpb=a09bae7235677c1b3b77f827bdd6722a9e88a122

diff --git a/src/SBP.hs b/src/SBP.hs
index 510a2d4..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))
 
@@ -58,8 +73,8 @@ module SBP
     ((do class_JHaskellHelper
          class_JTree
          head <- getHead_JTree t ()
-         strx <- toString_JObject ((castTLRef head) :: Jjava_lang_Object) ()
-         str  <- getStringUTF strx
+         isNull <- getIsNothing head
+         str  <- if isNull then (return "") else (toString_JObject ((castTLRef head) :: Jjava_lang_Object) () >>= getStringUTF >>= \x -> return (showUTF8 x))
          numChildren <- size_JTree t()
          children    <- if numChildren == 0
                         then do return []
@@ -68,7 +83,7 @@ module SBP
                                                 $ iterate (+1) 0
                                 h        <- mapM (\c -> haskifyTree (castTLRef c)) children
                                 return h
-         return $ Tree (showUTF8 str) children nullRegion
+         return $ Tree str children nullRegion
       ) :: JVM Tree)