-- |Pretty-printer for HTML. This modules exports no names. It only defines
-- instances of 'PrettyPrintable' for HTML.
module WebBits.Html.PrettyPrint
( -- this module exports no names
) where
import qualified Data.List as List
import qualified Data.Char as Char
import Text.PrettyPrint.HughesPJ
import WebBits.Common (PrettyPrintable(..))
import WebBits.Html.Syntax
vert [] = empty
vert [doc] = doc
vert (doc:docs) = doc <> text "" <> vert docs
instance PrettyPrintable s => PrettyPrintable (Attribute a s) where
pp (Attribute name value _) =
text name <> equals <> doubleQuotes (text value)
pp (AttributeExpr _ n v "") =
text n <> equals <> text "{!" <+> pp v <+> text "!}"
pp (AttributeExpr _ n v d) =
text n <> equals <> text "{!" <+> pp v <+> text "|||" <+> text d
<+> text "!}"
instance PrettyPrintable s => PrettyPrintable (Html a s) where
-- The .
-- doesn't work.
-- pp (Element name attrs [] _) =
-- text "<" <> text name <+> hsep (map pp attrs) <+> text "/>"
pp (Element name attrs children _) =
-- WARNING: Spacing is very sensitive
text "<" <> text name <+> hsep (map pp attrs) <> text ">" -- opening
$$ (nest 2 (vcat (map pp children))) -- body
$$ text "" <> text name <> text ">" -- closing
-- Horizontally aligned material that is vertically represented in source.
pp (HtmlSeq xs) = vert (map pp xs)
pp (Text str _) =
text (skipWs str) where
skipWs str = List.dropWhile Char.isSpace str
pp (Comment str _) =
text ""
pp (ProcessingInstruction str _) =
text "" <> text str <> text ">"
pp (Script script _) =
pp script
pp (InlineScript script _ "") =
text "{!" <+> pp script <+> text "!}"
pp (InlineScript script _ init) =
text "{!" <+> pp script <+> text "|||" <+> text init <+> text "!}"