{-# 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 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 #-}


-- | Render a 'ChoiceString' to an appending list of nodes
--
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 #-}


-- | Render some 'Html' to an appending list of nodes
--
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 #-}

-- | Render HTML to an xmlhtml 'Document'
--
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 #-}

-- | Render HTML to a list of xmlhtml nodes
--
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 []