HTML writer: export tagWithAttributes.

This is a helper allowing other writers to create single
HTML tags.
This commit is contained in:
John MacFarlane 2017-12-03 12:09:40 -08:00
parent 0a091f1463
commit 5d0863d198

View file

@ -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