HTML writer: export tagWithAttributes.

This is a helper allowing other writers to create single
HTML tags.

1 files changed, 19 insertions, 2 deletions

diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 2dc8b7a61..7fdfa567e 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -41,7 +41,8 @@ module Text.Pandoc.Writers.HTML (
   writeSlidy,
   writeSlideous,
   writeDZSlides,
-  writeRevealJs
+  writeRevealJs,
+  tagWithAttributes
   ) where
 import Control.Monad.State.Strict
 import Data.Char (ord, toLower)
@@ -55,6 +56,7 @@ import qualified Data.Text.Lazy as TL
 import Network.HTTP (urlEncode)
 import Network.URI (URI (..), parseURIReference, unEscapeString)
 import Numeric (showHex)
+import Text.Blaze.Internal (customLeaf, textTag)
 import Text.Blaze.Html hiding (contents)
 import Text.Pandoc.Definition
 import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight,
@@ -83,7 +85,7 @@ import System.FilePath (takeBaseName, takeExtension)
 import Text.Blaze.Html.Renderer.Text (renderHtml)
 import qualified Text.Blaze.XHtml1.Transitional as H
 import qualified Text.Blaze.XHtml1.Transitional.Attributes as A
-import Text.Pandoc.Class (PandocMonad, report)
+import Text.Pandoc.Class (PandocMonad, report, runPure)
 import Text.Pandoc.Error
 import Text.Pandoc.Logging
 import Text.TeXMath
@@ -542,6 +544,21 @@ obfuscateChar char =
 obfuscateString :: String -> String
 obfuscateString = concatMap obfuscateChar . fromEntities
 
+-- | Create HTML tag with attributes.
+tagWithAttributes :: WriterOptions
+                  -> Bool -- ^ True for HTML5
+                  -> Bool -- ^ True if self-closing tag
+                  -> Text -- ^ Tag text
+                  -> Attr -- ^ Pandoc style tag attributes
+                  -> Text
+tagWithAttributes opts html5 selfClosing tagname attr =
+  let mktag = (TL.toStrict . renderHtml <$> evalStateT
+               (addAttrs opts attr (customLeaf (textTag tagname) selfClosing))
+               defaultWriterState{ stHtml5 = html5 })
+  in  case runPure mktag of
+           Left _  -> mempty
+           Right t -> t
+
 addAttrs :: PandocMonad m
          => WriterOptions -> Attr -> Html -> StateT WriterState m Html
 addAttrs opts attr h = foldl (!) h <$> attrsToHtml opts attr