module PrettyGraph ( prettyGraph ) where
import ReifyHs
( Graph (..)
, GraphKind (..)
, graphKind
, graphIsList
, graphIsTuple )
import Data.Char (showLitChar)
prettyGraph :: Graph -> String
prettyGraph g = prettyGraphS False g ""
prettyGraphS :: Bool -> Graph -> ShowS
prettyGraphS parens graph@(AppNode _unique desc tag numKids kids)
| graphIsList graph = prettyList graph
| graphIsTuple graph = prettyTuple graph
| otherwise = prettyGraphApp parens desc tag numKids kids
where
prettyGraphApp :: Bool -> String -> Int -> Int -> [Graph] -> ShowS
prettyGraphApp parens desc tag numKids kids
= case graphKind graph of
GNode -> if numKids <= 0
then showString desc
else showParen parens ( showString desc . space . prettyKids True kids)
GCycle -> showString "<CYCLE>"
GThunk -> showString "?"
GApUpd -> showString "!"
GException -> prettyKids False kids
GFun -> showString "<Function>"
prettyKids :: Bool -> [Graph] -> ShowS
prettyKids parens [] = id
prettyKids parens [k] = prettyGraphS parens k
prettyKids parens (k1:k2:ks) = prettyGraphS parens k1 . space . prettyKids parens (k2:ks)
prettyGraphS parens (CharNode c) = shows c
prettyGraphS parens (IntNode i) = shows i
prettyGraphS parens (IntegerNode i) = shows i
prettyGraphS parens (FloatNode f) = shows f
prettyGraphS parens (DoubleNode d) = shows d
prettyGraphS parens NullNode = showString "<Null>"
space :: ShowS
space = showChar ' '
prettyList :: Graph -> ShowS
prettyList graph
| isGraphString graph = prettyString True graph
| otherwise = prettyListNormal graph
prettyListNormal :: Graph -> ShowS
prettyListNormal (AppNode _unique "[]" _tag _numKids _kids) = showString "[]"
prettyListNormal (AppNode _unique ":" _tag _numKids [x,xs])
= showChar '[' . prettyGraphS False x . prettyl xs
where prettyl (AppNode _unique "[]" _tag _numKids _kids) = showChar ']'
prettyl (AppNode _unique ":" _tag _numKids [x,xs])
= showString "," . prettyGraphS False x . prettyl xs
prettyl other = showString " .. " . prettyGraphS False other
prettyString :: Bool -> Graph -> ShowS
prettyString quotes (AppNode _unique "[]" _tag _numKids _kids)
| quotes = showString "\"\""
| otherwise = id
prettyString quotes (AppNode _unique ":" _tag _numKids [x,xs])
| quotes = showChar '\"' . prettyLitChar x . prettyl quotes xs
| otherwise = prettyLitChar x . prettyl quotes xs
where prettyl quotes (AppNode _unique "[]" _tag _numKids _kids)
| quotes = showChar '\"'
| otherwise = id
prettyl quotes (AppNode _unique ":" _tag _numKids [x,xs])
= prettyLitChar x . prettyl quotes xs
prettyl quotes other = showString " .. " . prettyGraphS False other
prettyLitChar :: Graph -> ShowS
prettyLitChar (CharNode c) = showLitChar c
prettyLitChar other = prettyGraphS True other
prettyTuple :: Graph -> ShowS
prettyTuple (AppNode _unique _desc _tag _numKids kids@(x:xs))
= showChar '(' . prettyGraphS False x . prettyl xs
where prettyl [] = showChar ')'
prettyl (x:xs) = showString "," . prettyGraphS False x . prettyl xs
isGraphString :: Graph -> Bool
isGraphString (AppNode _unique ":" _tag _numKids [first,_])
= graphKind first == GChar
isGraphString other = False