module BrownPLT.Html.PrettyPrint
( html
, renderHtml
) where
import qualified Data.List as List
import qualified Data.Char as Char
import Text.PrettyPrint.HughesPJ
import BrownPLT.Html.Syntax
renderHtml :: Script s => Html a s -> String
renderHtml = render.html
vert [] = empty
vert [doc] = doc
vert (doc:docs) = doc <> text "<!--" $+$
text "-->" <> vert docs
attr :: Script s => Attribute a s -> Doc
attr a = case a of
Attribute name value _ ->
text name <> equals <> doubleQuotes (text value)
AttributeExpr _ n v "" ->
text n <> equals <> text "{!" <+> prettyPrintScript v <+> text "!}"
AttributeExpr _ n v d ->
text n <> equals <> text "{!" <+> prettyPrintScript v <+> text "|||" <+>
text d <+> text "!}"
html :: Script s => Html a s -> Doc
html x = case x of
Element name attrs children _ ->
text "<" <> text name <+> hsep (map attr attrs) <> text ">"
$$ (nest 2 (vcat (map html children)))
$$ text "</" <> text name <> text ">"
HtmlSeq xs -> vert (map html xs)
Text str _ -> text (skipWs str) where
skipWs str = List.dropWhile Char.isSpace str
Comment str _ -> text "<!--" <+> text str <+> text "-->"
ProcessingInstruction str _ -> text "<?" <> text str <> text ">"
Script s _ -> prettyPrintScript s
InlineScript script _ "" ->
text "{!" <+> prettyPrintScript script <+> text "!}"
InlineScript script _ init ->
text "{!" <+> prettyPrintScript script <+> text "|||" <+>
text init <+> text "!}"