module Text.Blaze.Renderer.XmlHtml (renderHtml, renderHtmlNodes) where
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Text.Blaze.Html
import Text.Blaze.Internal as TBI
import Text.XmlHtml as X
fromChoiceStringText :: ChoiceString -> Text
fromChoiceStringText (Static s) = getText s
fromChoiceStringText (String s) = T.pack s
fromChoiceStringText (Text s) = s
fromChoiceStringText (ByteString s) = T.decodeUtf8 s
fromChoiceStringText (PreEscaped s) = fromChoiceStringText s
fromChoiceStringText (External s) = fromChoiceStringText s
fromChoiceStringText (AppendChoiceString x y) =
fromChoiceStringText x `T.append` fromChoiceStringText y
fromChoiceStringText EmptyChoiceString = T.empty
fromChoiceString :: ChoiceString -> [Node] -> [Node]
fromChoiceString s@(Static _) = (TextNode (fromChoiceStringText s) :)
fromChoiceString s@(String _) = (TextNode (fromChoiceStringText s) :)
fromChoiceString s@(Text _) = (TextNode (fromChoiceStringText s) :)
fromChoiceString s@(ByteString _) = (TextNode (fromChoiceStringText s) :)
fromChoiceString (PreEscaped s) = fromChoiceString s
fromChoiceString (External s) = fromChoiceString s
fromChoiceString (AppendChoiceString x y) =
fromChoiceString x . fromChoiceString y
fromChoiceString EmptyChoiceString = id
renderNodes :: Html -> [Node] -> [Node]
renderNodes = go []
where
go :: [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go attrs (Parent tag _ _ content) =
(Element (getText tag) attrs (go [] content []) :)
go attrs (CustomParent tag content) =
(Element (fromChoiceStringText tag) attrs (go [] content []) :)
go attrs (Leaf tag _ _) =
(Element (getText tag) attrs [] :)
go attrs (CustomLeaf tag _) =
(Element (fromChoiceStringText tag) attrs [] :)
go attrs (AddAttribute key _ value content) =
go ((getText key, fromChoiceStringText value) : attrs) content
go attrs (AddCustomAttribute key value content) =
go ((fromChoiceStringText key, fromChoiceStringText value) : attrs)
content
go _ (Content content) = fromChoiceString content
#if MIN_VERSION_blaze_markup(0,6,3)
go _ (TBI.Comment comment) =
(X.Comment (fromChoiceStringText comment) :)
#endif
go attrs (Append h1 h2) = go attrs h1 . go attrs h2
go _ Empty = id
renderHtml :: Html -> Document
renderHtml html = HtmlDocument UTF8 Nothing (renderNodes html [])
renderHtmlNodes :: Html -> [Node]
renderHtmlNodes = flip renderNodes []