{-# LANGUAGE CPP               #-}

-- | Renderer that supports rendering to xmlhtml forests.  This is a port of
-- the Hexpat renderer.
--
-- Warning: because this renderer doesn't directly create the output, but
-- rather an XML tree representation, it is impossible to render pre-escaped
-- text.
--
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


-- | Render a 'ChoiceString' to Text. This is only meant to be used for
-- shorter strings, since it is inefficient for large strings.
--
fromChoiceStringText :: ChoiceString -> Text
fromChoiceStringText :: ChoiceString -> Text
fromChoiceStringText (Static StaticString
s)               = StaticString -> Text
getText StaticString
s
fromChoiceStringText (String String
s)               = String -> Text
T.pack String
s
fromChoiceStringText (Text Text
s)                 = Text
s
fromChoiceStringText (ByteString ByteString
s)           = ByteString -> Text
T.decodeUtf8 ByteString
s
fromChoiceStringText (PreEscaped ChoiceString
s)           = ChoiceString -> Text
fromChoiceStringText ChoiceString
s
fromChoiceStringText (External ChoiceString
s)             = ChoiceString -> Text
fromChoiceStringText ChoiceString
s
fromChoiceStringText (AppendChoiceString ChoiceString
x ChoiceString
y) =
    ChoiceString -> Text
fromChoiceStringText ChoiceString
x Text -> Text -> Text
`T.append` ChoiceString -> Text
fromChoiceStringText ChoiceString
y
fromChoiceStringText ChoiceString
EmptyChoiceString        = Text
T.empty
{-# INLINE fromChoiceStringText #-}


-- | Render a 'ChoiceString' to an appending list of nodes
--
fromChoiceString :: ChoiceString -> [Node] -> [Node]
fromChoiceString :: ChoiceString -> [Node] -> [Node]
fromChoiceString s :: ChoiceString
s@(Static StaticString
_)     = (Text -> Node
TextNode (ChoiceString -> Text
fromChoiceStringText ChoiceString
s) forall a. a -> [a] -> [a]
:)
fromChoiceString s :: ChoiceString
s@(String String
_)     = (Text -> Node
TextNode (ChoiceString -> Text
fromChoiceStringText ChoiceString
s) forall a. a -> [a] -> [a]
:)
fromChoiceString s :: ChoiceString
s@(Text Text
_)       = (Text -> Node
TextNode (ChoiceString -> Text
fromChoiceStringText ChoiceString
s) forall a. a -> [a] -> [a]
:)
fromChoiceString s :: ChoiceString
s@(ByteString ByteString
_) = (Text -> Node
TextNode (ChoiceString -> Text
fromChoiceStringText ChoiceString
s) forall a. a -> [a] -> [a]
:)
fromChoiceString (PreEscaped ChoiceString
s)   = ChoiceString -> [Node] -> [Node]
fromChoiceString ChoiceString
s
fromChoiceString (External ChoiceString
s)     = ChoiceString -> [Node] -> [Node]
fromChoiceString ChoiceString
s
fromChoiceString (AppendChoiceString ChoiceString
x ChoiceString
y) =
    ChoiceString -> [Node] -> [Node]
fromChoiceString ChoiceString
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> [Node] -> [Node]
fromChoiceString ChoiceString
y
fromChoiceString ChoiceString
EmptyChoiceString = forall a. a -> a
id
{-# INLINE fromChoiceString #-}


-- | Render some 'Html' to an appending list of nodes
--
renderNodes :: Html -> [Node] -> [Node]
renderNodes :: Html -> [Node] -> [Node]
renderNodes = forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go []
  where
    go :: [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
    go :: forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go [(Text, Text)]
attrs (Parent StaticString
tag StaticString
_ StaticString
_ MarkupM a
content) =
        (Text -> [(Text, Text)] -> [Node] -> Node
Element (StaticString -> Text
getText StaticString
tag) [(Text, Text)]
attrs (forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go [] MarkupM a
content []) forall a. a -> [a] -> [a]
:)
    go [(Text, Text)]
attrs (CustomParent ChoiceString
tag MarkupM a
content) =
        (Text -> [(Text, Text)] -> [Node] -> Node
Element (ChoiceString -> Text
fromChoiceStringText ChoiceString
tag) [(Text, Text)]
attrs (forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go [] MarkupM a
content []) forall a. a -> [a] -> [a]
:)
    go [(Text, Text)]
attrs (Leaf StaticString
tag StaticString
_ StaticString
_ a
_) =
        (Text -> [(Text, Text)] -> [Node] -> Node
Element (StaticString -> Text
getText StaticString
tag) [(Text, Text)]
attrs [] forall a. a -> [a] -> [a]
:)
    go [(Text, Text)]
attrs (CustomLeaf ChoiceString
tag Bool
_ a
_) =
        (Text -> [(Text, Text)] -> [Node] -> Node
Element (ChoiceString -> Text
fromChoiceStringText ChoiceString
tag) [(Text, Text)]
attrs [] forall a. a -> [a] -> [a]
:)
    go [(Text, Text)]
attrs (AddAttribute StaticString
key StaticString
_ ChoiceString
value MarkupM a
content) =
        forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go ((StaticString -> Text
getText StaticString
key, ChoiceString -> Text
fromChoiceStringText ChoiceString
value) forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs) MarkupM a
content
    go [(Text, Text)]
attrs (AddCustomAttribute ChoiceString
key ChoiceString
value MarkupM a
content) =
        forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go ((ChoiceString -> Text
fromChoiceStringText ChoiceString
key, ChoiceString -> Text
fromChoiceStringText ChoiceString
value) forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs)
           MarkupM a
content
    go [(Text, Text)]
_ (Content ChoiceString
content a
_) = ChoiceString -> [Node] -> [Node]
fromChoiceString ChoiceString
content
#if MIN_VERSION_blaze_markup(0,6,3)
    go [(Text, Text)]
_ (TBI.Comment ChoiceString
comment a
_) =
        (Text -> Node
X.Comment (ChoiceString -> Text
fromChoiceStringText ChoiceString
comment) forall a. a -> [a] -> [a]
:)
#endif
    go [(Text, Text)]
attrs (Append MarkupM b
h1 MarkupM a
h2) = forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go [(Text, Text)]
attrs MarkupM b
h1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [(Text, Text)] -> MarkupM a -> [Node] -> [Node]
go [(Text, Text)]
attrs MarkupM a
h2
    go [(Text, Text)]
_ (Empty a
_) = forall a. a -> a
id
    {-# NOINLINE go #-}
{-# INLINE renderNodes #-}

-- | Render HTML to an xmlhtml 'Document'
--
renderHtml :: Html -> Document
renderHtml :: Html -> Document
renderHtml Html
html = Encoding -> Maybe DocType -> [Node] -> Document
HtmlDocument Encoding
UTF8 forall a. Maybe a
Nothing (Html -> [Node] -> [Node]
renderNodes Html
html [])
{-# INLINE renderHtml #-}

-- | Render HTML to a list of xmlhtml nodes
--
renderHtmlNodes :: Html -> [Node]
renderHtmlNodes :: Html -> [Node]
renderHtmlNodes = forall a b c. (a -> b -> c) -> b -> a -> c
flip Html -> [Node] -> [Node]
renderNodes []