summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/HTML.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers/HTML.hs')
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs21
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