import JavaTypes;
import Data.Int;
import Invocation;
+ import Text.PrettyPrint.HughesPJ
-- Why do I need this?
instance SubJavaClassMarker
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))
((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 []
$ 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)