1 -- | Renderer that supports rendering to xmlhtml forests.  This is a port of
    2 -- the Hexpat renderer.
    3 --
    4 -- Warning: because this renderer doesn't directly create the output, but
    5 -- rather an XML tree representation, it is impossible to render pre-escaped
    6 -- text. This means that @preEscapedString@ will produce the same output as
    7 -- @string@. This also applies to the functions @preEscapedText@,
    8 -- @preEscapedTextValue@...
    9 --
   10 module Text.Blaze.Renderer.XmlHtml (renderHtml, renderHtmlNodes) where
   11 
   12 import           Data.Text (Text)
   13 import qualified Data.Text as T
   14 import qualified Data.Text.Encoding as T
   15 import           Text.Blaze.Internal
   16 import           Text.XmlHtml
   17 
   18 
   19 -- | Render a 'ChoiceString' to Text. This is only meant to be used for
   20 -- shorter strings, since it is inefficient for large strings.
   21 --
   22 fromChoiceStringText :: ChoiceString -> Text
   23 fromChoiceStringText (Static s)               = getText s
   24 fromChoiceStringText (String s)               = T.pack s
   25 fromChoiceStringText (Text s)                 = s
   26 fromChoiceStringText (ByteString s)           = T.decodeUtf8 s
   27 fromChoiceStringText (PreEscaped s)           = fromChoiceStringText s
   28 fromChoiceStringText (External s)             = fromChoiceStringText s
   29 fromChoiceStringText (AppendChoiceString x y) =
   30     fromChoiceStringText x `T.append` fromChoiceStringText y
   31 fromChoiceStringText EmptyChoiceString        = T.empty
   32 {-# INLINE fromChoiceStringText #-}
   33 
   34 
   35 -- | Render a 'ChoiceString' to an appending list of nodes
   36 --
   37 fromChoiceString :: ChoiceString -> [Node] -> [Node]
   38 fromChoiceString s@(Static _)     = (TextNode (fromChoiceStringText s) :)
   39 fromChoiceString s@(String _)     = (TextNode (fromChoiceStringText s) :)
   40 fromChoiceString s@(Text _)       = (TextNode (fromChoiceStringText s) :)
   41 fromChoiceString s@(ByteString _) = (TextNode (fromChoiceStringText s) :)
   42 fromChoiceString (PreEscaped s)   = fromChoiceString s
   43 fromChoiceString (External s)     = fromChoiceString s
   44 fromChoiceString (AppendChoiceString x y) =
   45     fromChoiceString x . fromChoiceString y
   46 fromChoiceString EmptyChoiceString = id
   47 {-# INLINE fromChoiceString #-}
   48 
   49 
   50 -- | Render some 'Html' to an appending list of nodes
   51 --
   52 renderNodes :: Html -> [Node] -> [Node]
   53 renderNodes = go []
   54   where
   55     go :: [(Text, Text)] -> HtmlM b -> [Node] -> [Node]
   56     go attrs (Parent tag _ _ content) =
   57         (Element (getText tag) attrs (go [] content []) :)
   58     go attrs (Leaf tag _ _) =
   59         (Element (getText tag) attrs [] :)
   60     go attrs (AddAttribute key _ value content) =
   61         go ((getText key, fromChoiceStringText value) : attrs) content
   62     go attrs (AddCustomAttribute key _ value content) =
   63         go ((fromChoiceStringText key, fromChoiceStringText value) : attrs)
   64            content
   65     go _ (Content content) = fromChoiceString content
   66     go attrs (Append h1 h2) = go attrs h1 . go attrs h2
   67     go _ Empty = id
   68     {-# NOINLINE go #-}
   69 {-# INLINE renderNodes #-}
   70 
   71 -- | Render HTML to an xmlhtml 'Document'
   72 --
   73 renderHtml :: Html -> Document
   74 renderHtml html = HtmlDocument UTF8 Nothing (renderNodes html [])
   75 {-# INLINE renderHtml #-}
   76 
   77 -- | Render HTML to a list of xmlhtml nodes
   78 --
   79 renderHtmlNodes :: Html -> [Node]
   80 renderHtmlNodes = flip renderNodes []