{-# LANGUAGE CPP #-}
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 :: ChoiceString -> Text
fromChoiceStringText (Static s :: StaticString
s) = StaticString -> Text
getText StaticString
s
fromChoiceStringText (String s :: String
s) = String -> Text
T.pack String
s
fromChoiceStringText (Text s :: Text
s) = Text
s
fromChoiceStringText (ByteString s :: ByteString
s) = ByteString -> Text
T.decodeUtf8 ByteString
s
fromChoiceStringText (PreEscaped s :: ChoiceString
s) = ChoiceString -> Text
fromChoiceStringText ChoiceString
s
fromChoiceStringText (External s :: ChoiceString
s) = ChoiceString -> Text
fromChoiceStringText ChoiceString
s
fromChoiceStringText (AppendChoiceString x :: ChoiceString
x y :: ChoiceString
y) =
ChoiceString -> Text
fromChoiceStringText ChoiceString
x Text -> Text -> Text
`T.append` ChoiceString -> Text
fromChoiceStringText ChoiceString
y
fromChoiceStringText EmptyChoiceString = Text
T.empty
{-# INLINE fromChoiceStringText #-}
fromChoiceString :: ChoiceString -> [Node] -> [Node]
fromChoiceString :: ChoiceString -> [Node] -> [Node]
fromChoiceString s :: ChoiceString
s@(Static _) = (Text -> Node
TextNode (ChoiceString -> Text
fromChoiceStringText ChoiceString
s) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
fromChoiceString s :: ChoiceString
s@(String _) = (Text -> Node
TextNode (ChoiceString -> Text
fromChoiceStringText ChoiceString
s) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
fromChoiceString s :: ChoiceString
s@(Text _) = (Text -> Node
TextNode (ChoiceString -> Text
fromChoiceStringText ChoiceString
s) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
fromChoiceString s :: ChoiceString
s@(ByteString _) = (Text -> Node
TextNode (ChoiceString -> Text
fromChoiceStringText ChoiceString
s) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
fromChoiceString (PreEscaped s :: ChoiceString
s) = ChoiceString -> [Node] -> [Node]
fromChoiceString ChoiceString
s
fromChoiceString (External s :: ChoiceString
s) = ChoiceString -> [Node] -> [Node]
fromChoiceString ChoiceString
s
fromChoiceString (AppendChoiceString x :: ChoiceString
x y :: ChoiceString
y) =
ChoiceString -> [Node] -> [Node]
fromChoiceString ChoiceString
x ([Node] -> [Node]) -> ([Node] -> [Node]) -> [Node] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> [Node] -> [Node]
fromChoiceString ChoiceString
y
fromChoiceString EmptyChoiceString = [Node] -> [Node]
forall a. a -> a
id
{-# INLINE fromChoiceString #-}
renderNodes :: Html -> [Node] -> [Node]
renderNodes :: Html -> [Node] -> [Node]
renderNodes = [(Text, Text)] -> Html -> [Node] -> [Node]
forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go []
where
go :: [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go :: [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go attrs :: [(Text, Text)]
attrs (Parent tag :: StaticString
tag _ _ content :: MarkupM a
content) =
(Text -> [(Text, Text)] -> [Node] -> Node
Element (StaticString -> Text
getText StaticString
tag) [(Text, Text)]
attrs ([(Text, Text)] -> MarkupM a -> [Node] -> [Node]
forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go [] MarkupM a
content []) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
go attrs :: [(Text, Text)]
attrs (CustomParent tag :: ChoiceString
tag content :: MarkupM a
content) =
(Text -> [(Text, Text)] -> [Node] -> Node
Element (ChoiceString -> Text
fromChoiceStringText ChoiceString
tag) [(Text, Text)]
attrs ([(Text, Text)] -> MarkupM a -> [Node] -> [Node]
forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go [] MarkupM a
content []) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
go attrs :: [(Text, Text)]
attrs (Leaf tag :: StaticString
tag _ _ _) =
(Text -> [(Text, Text)] -> [Node] -> Node
Element (StaticString -> Text
getText StaticString
tag) [(Text, Text)]
attrs [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
go attrs :: [(Text, Text)]
attrs (CustomLeaf tag :: ChoiceString
tag _ _) =
(Text -> [(Text, Text)] -> [Node] -> Node
Element (ChoiceString -> Text
fromChoiceStringText ChoiceString
tag) [(Text, Text)]
attrs [] Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
go attrs :: [(Text, Text)]
attrs (AddAttribute key :: StaticString
key _ value :: ChoiceString
value content :: MarkupM a
content) =
[(Text, Text)] -> MarkupM a -> [Node] -> [Node]
forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go ((StaticString -> Text
getText StaticString
key, ChoiceString -> Text
fromChoiceStringText ChoiceString
value) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs) MarkupM a
content
go attrs :: [(Text, Text)]
attrs (AddCustomAttribute key :: ChoiceString
key value :: ChoiceString
value content :: MarkupM a
content) =
[(Text, Text)] -> MarkupM a -> [Node] -> [Node]
forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go ((ChoiceString -> Text
fromChoiceStringText ChoiceString
key, ChoiceString -> Text
fromChoiceStringText ChoiceString
value) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs)
MarkupM a
content
go _ (Content content :: ChoiceString
content _) = ChoiceString -> [Node] -> [Node]
fromChoiceString ChoiceString
content
#if MIN_VERSION_blaze_markup(0,6,3)
go _ (TBI.Comment comment :: ChoiceString
comment _) =
(Text -> Node
X.Comment (ChoiceString -> Text
fromChoiceStringText ChoiceString
comment) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)
#endif
go attrs :: [(Text, Text)]
attrs (Append h1 :: MarkupM b
h1 h2 :: MarkupM a
h2) = [(Text, Text)] -> MarkupM b -> [Node] -> [Node]
forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go [(Text, Text)]
attrs MarkupM b
h1 ([Node] -> [Node]) -> ([Node] -> [Node]) -> [Node] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go [(Text, Text)]
attrs MarkupM a
h2
go _ (Empty _) = [Node] -> [Node]
forall a. a -> a
id
{-# NOINLINE go #-}
{-# INLINE renderNodes #-}
renderHtml :: Html -> Document
renderHtml :: Html -> Document
renderHtml html :: Html
html = Encoding -> Maybe DocType -> [Node] -> Document
HtmlDocument Encoding
UTF8 Maybe DocType
forall a. Maybe a
Nothing (Html -> [Node] -> [Node]
renderNodes Html
html [])
{-# INLINE renderHtml #-}
renderHtmlNodes :: Html -> [Node]
renderHtmlNodes :: Html -> [Node]
renderHtmlNodes = (Html -> [Node] -> [Node]) -> [Node] -> Html -> [Node]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Html -> [Node] -> [Node]
renderNodes []