-- | Provides xhtml constructors for 'Text.XML.Light'.
module Text.HTML.Light (module L
                       ,renderXHTML
                       ,renderHTML5,renderHTML5_pp,showHTML5) where

import Text.XML.Light
import Text.HTML.Light.Attribute as L
import Text.HTML.Light.Constant as L
import Text.HTML.Light.Element as L

-- | Set of @HTML5@ elements that do not allow content.
html5_empty_elem :: [String]
html5_empty_elem =
    ["area","base","br","col","command","embed","hr"
    ,"img","input","keygen","link"
    ,"meta","param","source","track","wbr"]

pp_reconf :: ConfigPP -> ConfigPP
pp_reconf =
    let f nm = qName nm `elem` html5_empty_elem
    in useShortEmptyTags f

pp_el :: ConfigPP -> Element -> String
pp_el c = ppcElement (pp_reconf c)

-- | Render an xhtml element with the given document type.
renderXHTML :: DocType -> Element -> String
renderXHTML t e = concat [xml_1_0,t,pp_el defaultConfigPP e]

-- | Render an HTML5 element with the given document type.
renderHTML5 :: Element -> String
renderHTML5 e = html5_dt ++ pp_el defaultConfigPP e

-- | Pretty-printing variant (inserts whitespace).
renderHTML5_pp :: Element -> String
renderHTML5_pp e = unlines [html5_dt,pp_el prettyConfigPP e]

-- | Show HTML content (importantly an 'iframe' element must not be
-- abbreviated).
showHTML5 :: Content -> String
showHTML5 = ppcContent (pp_reconf defaultConfigPP)