module Text.XML.Xml2Html () where
#if MIN_VERSION_blaze_html(0, 5, 0)
import qualified Text.XML as X
import qualified Text.Blaze as B
import qualified Text.Blaze.Html as B
import qualified Text.Blaze.Html5 as B5
import qualified Text.Blaze.Internal as BI
#define ToHtml ToMarkup
#define toHtml toMarkup
#else
import qualified Text.XML as X
import qualified Text.Blaze as B
import qualified Text.Blaze.Html5 as B5
import qualified Text.Blaze.Internal as BI
#endif
import qualified Data.Text as T
import Data.String (fromString)
import Data.Monoid (mempty, mappend)
import Data.List (foldl')
import qualified Data.Set as Set
import qualified Data.Map as Map
import Control.Arrow (first)
preEscapedText :: T.Text -> B.Html
preEscapedText =
#if MIN_VERSION_blaze_html(0, 5, 0)
B.preEscapedToMarkup
#else
B.preEscapedText
#endif
instance B.ToHtml X.Document where
toHtml (X.Document _ root _) = B5.docType >> B.toHtml root
instance B.ToHtml X.Element where
toHtml (X.Element
"{http://www.snoyman.com/xml2html}ie-cond"
[("cond", cond)]
children) =
preEscapedText "<!--[if "
`mappend` preEscapedText cond
`mappend` preEscapedText "]>"
`mappend` mapM_ B.toHtml children
`mappend` preEscapedText "<![endif]-->"
toHtml (X.Element name' attrs children) =
if isVoid
then foldl' (B.!) leaf attrs'
else foldl' (B.!) parent attrs' childrenHtml
where
childrenHtml :: B.Html
childrenHtml =
case (name `elem` ["style", "script"], children) of
(True, [X.NodeContent t]) -> preEscapedText t
_ -> mapM_ B.toHtml children
isVoid = X.nameLocalName name' `Set.member` voidElems
parent :: B.Html -> B.Html
parent = BI.Parent tag open close
leaf :: B.Html
leaf = BI.Leaf tag open (fromString " />")
name = T.unpack $ X.nameLocalName name'
tag = fromString name
open = fromString $ '<' : name
close = fromString $ concat ["</", name, ">"]
attrs' :: [B.Attribute]
attrs' = map goAttr $ Map.toList $ Map.fromList $ map (first X.nameLocalName) attrs
goAttr (key, value) = B.customAttribute (B.textTag key) $ B.toValue value
instance B.ToHtml X.Node where
toHtml (X.NodeElement e) = B.toHtml e
toHtml (X.NodeContent t) = B.toHtml t
toHtml _ = mempty
voidElems :: Set.Set T.Text
voidElems = Set.fromAscList $ T.words $ T.pack "area base br col command embed hr img input keygen link meta param source track wbr"