Use blaze-html instead of xhtml for HTML generation.

* This is a breaking API change for `writeHtml`.
* It introduces a new dependency on blaze-html.
* Pandoc now depends on highlighting-kate >= 0.4, which
  also uses blaze-html.
* The --ascii option has been removed, because of differences
  in blaze-html's and xhtml's escaping.
* Pandoc will no longer transform leading newlines in code
  blocks to `<br/>` tags.

3 files changed, 220 insertions, 211 deletions

diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs
index 5ddaf1379..f80ebeac7 100644
--- a/src/Text/Pandoc/Highlighting.hs
+++ b/src/Text/Pandoc/Highlighting.hs
@@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 {- |
    Module      : Text.Pandoc.Highlighting
    Copyright   : Copyright (C) 2008 John MacFarlane
-   License     : GNU GPL, version 2 or above 
+   License     : GNU GPL, version 2 or above
 
    Maintainer  : John MacFarlane <jgm@berkeley.edu>
    Stability   : alpha
@@ -29,10 +29,10 @@ Exports functions for syntax highlighting.
 -}
 
 module Text.Pandoc.Highlighting ( languages, highlightHtml, defaultHighlightingCss, languagesByExtension ) where
-import Text.XHtml
+import Text.Blaze
 import Text.Pandoc.Definition
 #ifdef _HIGHLIGHTING
-import Text.Highlighting.Kate ( languages, highlightAs, formatAsXHtml, FormatOption (..), defaultHighlightingCss, languagesByExtension )
+import Text.Highlighting.Kate ( languages, highlightAs, formatAsHtml, FormatOption (..), defaultHighlightingCss, languagesByExtension )
 import Data.List (find)
 import Data.Maybe (fromMaybe)
 import Data.Char (toLower)
@@ -54,9 +54,9 @@ highlightHtml inline (_, classes, keyvals) rawCode =
             Nothing        -> Left "Unknown or unsupported language"
             Just language  -> case highlightAs language rawCode of
                                    Left err -> Left err
-                                   Right hl -> Right $ formatAsXHtml fmtOpts language $
+                                   Right hl -> Right $ formatAsHtml fmtOpts language $
                                                        if addBirdTracks
-                                                          then map ((["Special"],"> "):) hl
+                                                          then map (("ot","> "):) hl
                                                           else hl
 
 #else
diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs
index 4a850fc6f..a7e836126 100644
--- a/src/Text/Pandoc/Templates.hs
+++ b/src/Text/Pandoc/Templates.hs
@@ -72,7 +72,7 @@ import Text.ParserCombinators.Parsec
 import Control.Monad (liftM, when, forM)
 import System.FilePath
 import Data.List (intercalate, intersperse)
-import Text.XHtml (primHtml, Html)
+import Text.Blaze (preEscapedString, Html)
 import Data.ByteString.Lazy.UTF8 (ByteString, fromString)
 import Text.Pandoc.Shared (readDataFile)
 import qualified Control.Exception.Extensible as E (try, IOException)
@@ -111,7 +111,7 @@ instance TemplateTarget ByteString where
   toTarget = fromString
 
 instance TemplateTarget Html where
-  toTarget = primHtml
+  toTarget = preEscapedString
 
 -- | Renders a template 
 renderTemplate :: TemplateTarget a
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 75ad81d42..f045a429c 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 {-
 Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@@ -35,43 +36,44 @@ import Text.Pandoc.Shared
 import Text.Pandoc.Templates
 import Text.Pandoc.Readers.TeXMath
 import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss )
-import Text.Pandoc.XML (stripTags, escapeStringForXML)
+import Text.Pandoc.XML (stripTags)
 import Network.HTTP ( urlEncode )
 import Numeric ( showHex )
 import Data.Char ( ord, toLower )
 import Data.List ( isPrefixOf, intersperse )
+import Data.String ( fromString )
 import Data.Maybe ( catMaybes )
 import Control.Monad.State
-import Text.XHtml.Transitional hiding ( stringToHtml, unordList, ordList )
-import qualified Text.XHtml.Transitional as XHtml
+import Text.Blaze
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as A
+import qualified Text.Blaze.Html4.Transitional.Attributes as A4
+import Text.Blaze.Renderer.String (renderHtml)
 import Text.TeXMath
 import Text.XML.Light.Output
 import System.FilePath (takeExtension)
+import Data.Monoid (mempty, mconcat)
 
 data WriterState = WriterState
     { stNotes            :: [Html]  -- ^ List of notes
     , stMath             :: Bool    -- ^ Math is used in document
     , stHighlighting     :: Bool    -- ^ Syntax highlighting is used
     , stSecNum           :: [Int]   -- ^ Number of current section
-    } deriving Show
+    }
 
 defaultWriterState :: WriterState
 defaultWriterState = WriterState {stNotes= [], stMath = False, stHighlighting = False, stSecNum = []}
 
 -- Helpers to render HTML with the appropriate function.
 
--- | Modified version of Text.XHtml's stringToHtml.
--- Use unicode characters wherever possible.
-stringToHtml :: WriterOptions -> String -> Html
-stringToHtml opts = if writerAscii opts
-                       then XHtml.stringToHtml
-                       else primHtml . escapeStringForXML
+strToHtml :: String -> Html
+strToHtml = toHtml
 
 -- | Hard linebreak.
 nl :: WriterOptions -> Html
 nl opts = if writerWrapText opts
-             then primHtml "\n"
-             else noHtml
+             then preEscapedString "\n"
+             else mempty
 
 -- | Convert Pandoc document to Html string.
 writeHtmlString :: WriterOptions -> Pandoc -> String
@@ -80,7 +82,7 @@ writeHtmlString opts d =
                                                  defaultWriterState
   in  if writerStandalone opts
          then inTemplate opts tit auths date toc body' newvars
-         else dropWhile (=='\n') $ showHtmlFragment body'
+         else renderHtml body'
 
 -- | Convert Pandoc document to Html structure.
 writeHtml :: WriterOptions -> Pandoc -> Html
@@ -99,13 +101,13 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
   let standalone = writerStandalone opts
   tit <- if standalone
             then inlineListToHtml opts title'
-            else return noHtml
+            else return mempty
   auths <- if standalone
               then mapM (inlineListToHtml opts) authors'
               else return []
   date <- if standalone
              then inlineListToHtml opts date'
-             else return noHtml
+             else return mempty
   let splitHrule (HorizontalRule : Header 1 xs : ys)
                                        = Header 1 xs : splitHrule ys
       splitHrule (HorizontalRule : xs) = Header 1 [] : splitHrule xs
@@ -120,34 +122,39 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
   toc <- if writerTableOfContents opts
             then tableOfContents opts sects
             else return Nothing
-  blocks' <- liftM (toHtmlFromList . intersperse (nl opts)) $
+  blocks' <- liftM (mconcat . intersperse (nl opts)) $
                  mapM (elementToHtml opts) sects
   st <- get
   let notes = reverse (stNotes st)
-  let thebody = blocks' +++ footnoteSection opts notes
+  let thebody = blocks' >> footnoteSection opts notes
   let  math = if stMath st
                 then case writerHTMLMathMethod opts of
                            LaTeXMathML (Just url) ->
-                              script !
-                              [src url, thetype "text/javascript"] $ noHtml
+                              H.script ! A.src (toValue url)
+                                       ! A.type_ "text/javascript"
+                                       $ mempty
                            MathML (Just url) ->
-                              script !
-                              [src url, thetype "text/javascript"] $ noHtml
+                              H.script ! A.src (toValue url)
+                                       ! A.type_ "text/javascript"
+                                       $ mempty
                            MathJax url ->
-                              script ! [src url, thetype "text/javascript"] $ noHtml
+                              H.script ! A.src (toValue url)
+                                       ! A.type_ "text/javascript"
+                                       $ mempty
                            JsMath (Just url) ->
-                              script !
-                              [src url, thetype "text/javascript"] $ noHtml
+                              H.script ! A.src (toValue url)
+                                       ! A.type_ "text/javascript"
+                                       $ mempty
                            _ -> case lookup "mathml-script" (writerVariables opts) of
                                       Just s ->
-                                        script ! [thetype "text/javascript"] <<
-                                           primHtml ("/*<![CDATA[*/\n" ++ s ++
-                                                     "/*]]>*/\n")
-                                      Nothing -> noHtml
-                else noHtml
+                                        H.script ! A.type_ "text/javascript"
+                                           $ preEscapedString
+                                            ("/*<![CDATA[*/\n" ++ s ++ "/*]]>*/\n")
+                                      Nothing -> mempty
+                else mempty
   let newvars = [("highlighting-css", defaultHighlightingCss) |
                    stHighlighting st] ++
-                [("math", showHtmlFragment math) | stMath st]
+                [("math", renderHtml math) | stMath st]
   return (tit, auths, date, toc, thebody, newvars)
 
 inTemplate :: TemplateTarget a
@@ -160,12 +167,12 @@ inTemplate :: TemplateTarget a
            -> [(String,String)]
            -> a
 inTemplate opts tit auths date toc body' newvars =
-  let title'      = dropWhile (=='\n') $ showHtmlFragment tit
-      authors     = map showHtmlFragment auths
-      date'       = showHtmlFragment date
+  let title'      = renderHtml tit
+      authors     = map renderHtml auths
+      date'       = renderHtml date
       variables   = writerVariables opts ++ newvars
       context     = variables ++
-                    [ ("body", dropWhile (=='\n') $ showHtmlFragment body')
+                    [ ("body", dropWhile (=='\n') $ renderHtml body')
                     , ("pagetitle", stripTags title')
                     , ("title", title')
                     , ("date", date')
@@ -175,23 +182,23 @@ inTemplate opts tit auths date toc body' newvars =
                     , ("s5-url", "s5/default") ] ++
                     [ ("html5","true") | writerHtml5 opts ] ++
                     (case toc of
-                         Just t  -> [ ("toc", showHtmlFragment t)]
+                         Just t  -> [ ("toc", renderHtml t)]
                          Nothing -> [])  ++
                     [ ("author", a) | a <- authors ] ++
                     [ ("author-meta", stripTags a) | a <- authors ]
   in  renderTemplate context $ writerTemplate opts
 
 -- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
-prefixedId :: WriterOptions -> String -> HtmlAttr
-prefixedId opts s = identifier $ writerIdentifierPrefix opts ++ s
+prefixedId :: WriterOptions -> String -> Attribute
+prefixedId opts s = A.id $ toValue $ writerIdentifierPrefix opts ++ s
 
 -- | Replacement for Text.XHtml's unordList.
 unordList :: WriterOptions -> ([Html] -> Html)
-unordList opts items = ulist << toListItems opts items
+unordList opts items = H.ul $ mconcat $ toListItems opts items
 
 -- | Replacement for Text.XHtml's ordList.
 ordList :: WriterOptions -> ([Html] -> Html)
-ordList opts items = olist << toListItems opts items
+ordList opts items = H.ol $ mconcat $ toListItems opts items
 
 -- | Construct table of contents from list of elements.
 tableOfContents :: WriterOptions -> [Element] -> State WriterState (Maybe Html)
@@ -214,15 +221,16 @@ elementToListItem :: WriterOptions -> Element -> State WriterState (Maybe Html)
 elementToListItem _ (Blk _) = return Nothing
 elementToListItem opts (Sec _ num id' headerText subsecs) = do
   let sectnum = if writerNumberSections opts
-                   then (thespan ! [theclass "toc-section-number"] << showSecNum num) +++
-                         stringToHtml opts" "
-                   else noHtml
-  txt <- liftM (sectnum +++) $ inlineListToHtml opts headerText
+                   then (H.span ! A.class_ "toc-section-number" $ toHtml $ showSecNum num) >>
+                     preEscapedString " "
+                   else mempty
+  txt <- liftM (sectnum >>) $ inlineListToHtml opts headerText
   subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes
   let subList = if null subHeads
-                   then noHtml
+                   then mempty
                    else unordList opts subHeads
-  return $ Just $ (anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ id')] $ txt) +++ subList
+  return $ Just $ (H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ id')
+                       $ toHtml txt) >> subList
 
 -- | Convert an Element to Html.
 elementToHtml :: WriterOptions -> Element -> State WriterState Html
@@ -231,37 +239,38 @@ elementToHtml opts (Sec level num id' title' elements) = do
   modify $ \st -> st{stSecNum = num}  -- update section number
   header' <- blockToHtml opts (Header level title')
   innerContents <- mapM (elementToHtml opts) elements
-  let header'' = header' !  [prefixedId opts id' |
-                             not (writerStrictMarkdown opts ||
-                                  writerSectionDivs opts ||
-                                  writerSlideVariant opts == S5Slides)]
+  let header'' = if (writerStrictMarkdown opts ||
+                     writerSectionDivs opts ||
+                     writerSlideVariant opts == S5Slides)
+                    then header'
+                    else header' ! prefixedId opts id'
   let stuff = header'' : innerContents
   let slide = writerSlideVariant opts /= NoSlides && level == 1
   let titleSlide = slide && null elements
   let attrs = [prefixedId opts id' | writerSectionDivs opts] ++
-              [theclass "titleslide" | titleSlide] ++
-              [theclass "slide" | slide]
-  let inNl x = nl opts : intersperse (nl opts) x ++ [nl opts]
+              [A.class_ "titleslide" | titleSlide] ++
+              [A.class_ "slide" | slide]
+  let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts]
   return $ if writerSectionDivs opts || slide
               then if writerHtml5 opts
-                      then tag "section" ! attrs << inNl stuff
-                      else thediv ! attrs << inNl stuff
-              else toHtmlFromList $ intersperse (nl opts) stuff
+                      then foldl (!) (H.section $ inNl stuff) attrs
+                      else foldl (!) (H.div $ inNl stuff) attrs
+              else mconcat $ intersperse (nl opts) stuff
 
 -- | Convert list of Note blocks to a footnote <div>.
 -- Assumes notes are sorted.
 footnoteSection :: WriterOptions -> [Html] -> Html
 footnoteSection opts notes =
   if null notes
-     then noHtml
-     else nl opts +++ (container
-          $ nl opts +++ hr +++ nl opts +++
-            (olist << (notes ++ [nl opts])) +++ nl opts)
-   where container = if writerHtml5 opts
-                        then tag "section" ! [theclass "footnotes"]
-                        else if writerSlideVariant opts /= NoSlides
-                             then thediv ! [theclass "footnotes slide"]
-                             else thediv ! [theclass "footnotes"]
+     then mempty
+     else nl opts >> (container
+          $ nl opts >> H.hr >> nl opts >>
+            H.ol (mconcat notes >> nl opts))
+   where container x = if writerHtml5 opts
+                          then H.section ! A.class_ "footnotes" $ x
+                          else if writerSlideVariant opts /= NoSlides
+                               then H.div ! A.class_ "footnotes slide" $ x
+                               else H.div ! A.class_ "footnotes" $ x
 
 -- | Parse a mailto link; return Just (name, domain) or Nothing.
 parseMailto :: String -> Maybe (String, String)
@@ -274,7 +283,7 @@ parseMailto _ = Nothing
 -- | Obfuscate a "mailto:" link.
 obfuscateLink :: WriterOptions -> String -> String -> Html
 obfuscateLink opts txt s | writerEmailObfuscation opts == NoObfuscation =
-  anchor ! [href s] << txt
+  H.a ! A.href (toValue s) $ toHtml txt
 obfuscateLink opts txt s =
   let meth = writerEmailObfuscation opts
       s' = map toLower s
@@ -289,19 +298,19 @@ obfuscateLink opts txt s =
                           domain' ++ ")")
           in  case meth of
                 ReferenceObfuscation ->
-                     -- need to use primHtml or &'s are escaped to &amp; in URL
-                     primHtml $ "<a href=\"" ++ (obfuscateString s')
+                     -- need to use preEscapedString or &'s are escaped to &amp; in URL
+                     preEscapedString $ "<a href=\"" ++ (obfuscateString s')
                      ++ "\">" ++ (obfuscateString txt) ++ "</a>"
                 JavascriptObfuscation ->
-                     (script ! [thetype "text/javascript"] $
-                     primHtml ("\n<!--\nh='" ++
+                     (H.script ! A.type_ "text/javascript" $
+                     preEscapedString ("\n<!--\nh='" ++
                      obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++
                      obfuscateString name' ++ "';e=n+a+h;\n" ++
                      "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++
-                     linkText  ++ "+'<\\/'+'a'+'>');\n// -->\n")) +++
-                     noscript (primHtml $ obfuscateString altText)
+                     linkText  ++ "+'<\\/'+'a'+'>');\n// -->\n")) >>
+                     H.noscript (preEscapedString $ obfuscateString altText)
                 _ -> error $ "Unknown obfuscation method: " ++ show meth
-        _ -> anchor ! [href s] $ stringToHtml opts txt  -- malformed email
+        _ -> H.a ! A.href (toValue s) $ toHtml txt  -- malformed email
 
 -- | Obfuscate character as entity.
 obfuscateChar :: Char -> String
@@ -314,11 +323,11 @@ obfuscateChar char =
 obfuscateString :: String -> String
 obfuscateString = concatMap obfuscateChar . decodeCharacterReferences
 
-attrsToHtml :: WriterOptions -> Attr -> [HtmlAttr]
+attrsToHtml :: WriterOptions -> Attr -> [Attribute]
 attrsToHtml opts (id',classes',keyvals) =
-  [theclass (unwords classes') | not (null classes')] ++
+  [A.class_ (toValue $ unwords classes') | not (null classes')] ++
   [prefixedId opts id' | not (null id')] ++
-  map (\(x,y) -> strAttr x y) keyvals
+  map (\(x,y) -> customAttribute (fromString x) (toValue y)) keyvals
 
 imageExts :: [String]
 imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf",
@@ -333,38 +342,34 @@ treatAsImage fp =
 
 -- | Convert Pandoc block element to HTML.
 blockToHtml :: WriterOptions -> Block -> State WriterState Html
-blockToHtml _ Null = return noHtml
+blockToHtml _ Null = return mempty
 blockToHtml opts (Plain lst) = inlineListToHtml opts lst
 blockToHtml opts (Para [Image txt (s,tit)]) = do
   img <- inlineToHtml opts (Image txt (s,tit))
   capt <- inlineListToHtml opts txt
   return $ if writerHtml5 opts
-              then tag "figure" <<
-                    [nl opts, img, tag "figcaption" << capt, nl opts]
-              else thediv ! [theclass "figure"] <<
-                    [nl opts, img, paragraph ! [theclass "caption"] << capt,
+              then H.figure $ mconcat
+                    [nl opts, img, H.figcaption capt, nl opts]
+              else H.div ! A.class_ "figure" $ mconcat
+                    [nl opts, img, H.p ! A.class_ "caption" $ capt,
                     nl opts]
 blockToHtml opts (Para lst) = do
   contents <- inlineListToHtml opts lst
-  return $ paragraph contents
-blockToHtml _ (RawBlock "html" str) = return $ primHtml str
-blockToHtml _ (RawBlock _ _) = return noHtml
-blockToHtml _ (HorizontalRule) = return hr
+  return $ H.p contents
+blockToHtml _ (RawBlock "html" str) = return $ preEscapedString str
+blockToHtml _ (RawBlock _ _) = return mempty
+blockToHtml _ (HorizontalRule) = return H.hr
 blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
   let classes' = if writerLiterateHaskell opts
                     then classes
                     else filter (/= "literate") classes
   case highlightHtml False (id',classes',keyvals) rawCode of
-         Left _  -> -- change leading newlines into <br /> tags, because some
-                    -- browsers ignore leading newlines in pre blocks
-                    let (leadingBreaks, rawCode') = span (=='\n') rawCode
-                        attrs = attrsToHtml opts (id', classes', keyvals)
+         Left _  -> let attrs = attrsToHtml opts (id', classes', keyvals)
                         addBird = if "literate" `elem` classes'
                                      then unlines . map ("> " ++) . lines
                                      else unlines . lines
-                    in  return $ pre ! attrs $ thecode <<
-                                 (replicate (length leadingBreaks) br +++
-                                 [stringToHtml opts $ addBird rawCode'])
+                    in  return $ foldl (!) H.pre attrs $ H.code
+                                         $ toHtml $ addBird rawCode
          Right h -> modify (\st -> st{ stHighlighting = True }) >>
                     return h
 blockToHtml opts (BlockQuote blocks) =
@@ -380,47 +385,48 @@ blockToHtml opts (BlockQuote blocks) =
                                   blockToHtml (opts {writerIncremental = inc})
                                   (OrderedList attribs lst)
              _                 -> do contents <- blockListToHtml opts blocks
-                                     return $ blockquote (nl opts +++
-                                               contents +++ nl opts)
+                                     return $ H.blockquote
+                                            $ nl opts >> contents >> nl opts
      else do
        contents <- blockListToHtml opts blocks
-       return $ blockquote (nl opts +++ contents +++ nl opts)
+       return $ H.blockquote $ nl opts >> contents >> nl opts
 blockToHtml opts (Header level lst) = do
   contents <- inlineListToHtml opts lst
   secnum <- liftM stSecNum get
   let contents' = if writerNumberSections opts
-                     then (thespan ! [theclass "header-section-number"] << showSecNum secnum) +++
-                            stringToHtml opts " " +++ contents
+                     then (H.span ! A.class_ "header-section-number" $ toHtml $ showSecNum secnum) >>
+                            strToHtml " " >> contents
                      else contents
   let contents''  = if writerTableOfContents opts
-                       then anchor ! [href $ "#" ++ writerIdentifierPrefix opts ++ "TOC"] $ contents'
+                       then H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ "TOC") $ contents'
                        else contents'
   return $ (case level of
-              1 -> h1 contents''
-              2 -> h2 contents''
-              3 -> h3 contents''
-              4 -> h4 contents''
-              5 -> h5 contents''
-              6 -> h6 contents''
-              _ -> paragraph contents'')
+              1 -> H.h1 contents''
+              2 -> H.h2 contents''
+              3 -> H.h3 contents''
+              4 -> H.h4 contents''
+              5 -> H.h5 contents''
+              6 -> H.h6 contents''
+              _ -> H.p contents'')
 blockToHtml opts (BulletList lst) = do
   contents <- mapM (blockListToHtml opts) lst
-  let attribs = if writerIncremental opts
-                   then [theclass "incremental"]
-                   else []
-  return $ (unordList opts contents) ! attribs
+  let lst' = unordList opts contents
+  let lst'' = if writerIncremental opts
+                 then lst' ! A.class_ "incremental"
+                 else lst'
+  return lst''
 blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
   contents <- mapM (blockListToHtml opts) lst
   let numstyle' = camelCaseToHyphenated $ show numstyle
   let attribs = (if writerIncremental opts
-                   then [theclass "incremental"]
+                   then [A.class_ "incremental"]
                    else []) ++
                 (if startnum /= 1
-                   then [start startnum]
+                   then [A.start $ toValue startnum]
                    else []) ++
                 (if numstyle /= DefaultStyle
                    then if writerHtml5 opts
-                           then [strAttr "type" $
+                           then [A.type_ $
                                  case numstyle of
                                       Decimal    -> "1"
                                       LowerAlpha -> "a"
@@ -428,44 +434,44 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
                                       LowerRoman -> "i"
                                       UpperRoman -> "I"
                                       _          -> "1"]
-                           else [thestyle $ "list-style-type: " ++
+                           else [A.style $ toValue $ "list-style-type: " ++
                                    numstyle']
                    else [])
-  return $ (ordList opts contents) ! attribs
+  return $ foldl (!) (ordList opts contents) attribs
 blockToHtml opts (DefinitionList lst) = do
   contents <- mapM (\(term, defs) ->
-                  do term' <- liftM (dterm <<) $ inlineListToHtml opts term
-                     defs' <- mapM ((liftM (\x -> ddef << (x +++ nl opts))) .
+                  do term' <- liftM (H.dt) $ inlineListToHtml opts term
+                     defs' <- mapM ((liftM (\x -> H.dd $ (x >> nl opts))) .
                                     blockListToHtml opts) defs
-                     return $ nl opts : term' : nl opts : defs') lst
-  let attribs = if writerIncremental opts
-                   then [theclass "incremental"]
-                   else []
-  return $ dlist ! attribs << (concat contents +++ nl opts)
+                     return $ mconcat $ nl opts : term' : nl opts : defs') lst
+  let lst' = H.dl $ mconcat contents >> nl opts
+  let lst'' = if writerIncremental opts
+                 then lst' ! A.class_ "incremental"
+                 else lst'
+  return lst''
 blockToHtml opts (Table capt aligns widths headers rows') = do
   captionDoc <- if null capt
-                   then return noHtml
+                   then return mempty
                    else do
                      cs <- inlineListToHtml opts capt
-                     return $ caption cs +++ nl opts
+                     return $ H.caption cs >> nl opts
   let percent w = show (truncate (100*w) :: Integer) ++ "%"
-  let widthAttrs w = if writerHtml5 opts
-                        then [thestyle $ "width: " ++ percent w]
-                        else [width $ percent w]
   let coltags = if all (== 0.0) widths
-                   then noHtml
-                   else concatHtml $ map
-                         (\w -> (col ! (widthAttrs w)) noHtml +++ nl opts)
-                         widths
+                   then mempty
+                   else mconcat $ map (\w ->
+                          if writerHtml5 opts
+                             then H.col ! A.style (toValue $ "width: " ++ percent w)
+                             else H.col ! A.width (toValue $ percent w) >> nl opts)
+                          widths
   head' <- if all null headers
-              then return noHtml
+              then return mempty
               else do
                 contents <- tableRowToHtml opts aligns 0 headers
-                return $ thead << (nl opts +++ contents) +++ nl opts
-  body' <- liftM (\x -> tbody << (nl opts +++ x)) $
+                return $ H.thead (nl opts >> contents) >> nl opts
+  body' <- liftM (\x -> H.tbody (nl opts >> mconcat x)) $
                zipWithM (tableRowToHtml opts aligns) [1..] rows'
-  return $ table $ nl opts +++ captionDoc +++ coltags +++ head' +++
-                   body' +++ nl opts
+  return $ H.table $ nl opts >> captionDoc >> coltags >> head' >>
+                   body' >> nl opts
 
 tableRowToHtml :: WriterOptions
                -> [Alignment]
@@ -473,7 +479,7 @@ tableRowToHtml :: WriterOptions
                -> [[Block]]
                -> State WriterState Html
 tableRowToHtml opts aligns rownum cols' = do
-  let mkcell = if rownum == 0 then th else td
+  let mkcell = if rownum == 0 then H.th else H.td
   let rowclass = case rownum of
                       0                  -> "header"
                       x | x `rem` 2 == 1 -> "odd"
@@ -481,8 +487,8 @@ tableRowToHtml opts aligns rownum cols' = do
   cols'' <- sequence $ zipWith
             (\alignment item -> tableItemToHtml opts mkcell alignment item)
             aligns cols'
-  return $ (tr ! [theclass rowclass] $ nl opts +++ toHtmlFromList cols'')
-          +++ nl opts
+  return $ (H.tr ! A.class_ rowclass $ nl opts >> mconcat cols'')
+          >> nl opts
 
 alignmentToString :: Alignment -> [Char]
 alignmentToString alignment = case alignment of
@@ -498,85 +504,87 @@ tableItemToHtml :: WriterOptions
                 -> State WriterState Html
 tableItemToHtml opts tag' align' item = do
   contents <- blockListToHtml opts item
-  let alignAttrs = if writerHtml5 opts
-                      then [thestyle $ "align: " ++ alignmentToString align']
-                      else [align $ alignmentToString align']
-  return $ (tag' ! alignAttrs) contents +++ nl opts
+  let alignStr = alignmentToString align'
+  let attribs = if writerHtml5 opts
+                   then A.style (toValue $ "text-align: " ++ alignStr ++ ";")
+                   else A4.align (toValue alignStr)
+  return $ tag' ! attribs $ contents >> nl opts
 
 toListItems :: WriterOptions -> [Html] -> [Html]
 toListItems opts items = map (toListItem opts) items ++ [nl opts]
 
 toListItem :: WriterOptions -> Html -> Html
-toListItem opts item = nl opts +++ li item
+toListItem opts item = nl opts >> H.li item
 
 blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
 blockListToHtml opts lst =
   mapM (blockToHtml opts) lst >>=
-  return . toHtmlFromList . intersperse (nl opts)
+  return . mconcat . intersperse (nl opts)
 
 -- | Convert list of Pandoc inline elements to HTML.
 inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html
 inlineListToHtml opts lst =
-  mapM (inlineToHtml opts) lst >>= return . toHtmlFromList
+  mapM (inlineToHtml opts) lst >>= return . mconcat
 
 -- | Convert Pandoc inline element to HTML.
 inlineToHtml :: WriterOptions -> Inline -> State WriterState Html
 inlineToHtml opts inline =
   case inline of
-    (Str str)        -> return $ stringToHtml opts str
-    (Space)          -> return $ stringToHtml opts " "
-    (LineBreak)      -> return br
-    (EmDash)         -> return $ stringToHtml opts "—"
-    (EnDash)         -> return $ stringToHtml opts "–"
-    (Ellipses)       -> return $ stringToHtml opts "…"
-    (Apostrophe)     -> return $ stringToHtml opts "’"
-    (Emph lst)       -> inlineListToHtml opts lst >>= return . emphasize
-    (Strong lst)     -> inlineListToHtml opts lst >>= return . strong
+    (Str str)        -> return $ strToHtml str
+    (Space)          -> return $ strToHtml " "
+    (LineBreak)      -> return H.br
+    (EmDash)         -> return $ strToHtml "—"
+    (EnDash)         -> return $ strToHtml "–"
+    (Ellipses)       -> return $ strToHtml "…"
+    (Apostrophe)     -> return $ strToHtml "’"
+    (Emph lst)       -> inlineListToHtml opts lst >>= return . H.em
+    (Strong lst)     -> inlineListToHtml opts lst >>= return . H.strong
     (Code attr str)  -> case highlightHtml True attr str of
                              Left _  -> return
-                                        $ thecode ! (attrsToHtml opts attr)
-                                        $ stringToHtml opts str
+                                        $ foldl (!) H.code (attrsToHtml opts attr)
+                                        $ strToHtml str
                              Right h -> return h
     (Strikeout lst)  -> inlineListToHtml opts lst >>=
-                        return . (thespan ! [thestyle "text-decoration: line-through;"])
+                        return . (H.span ! A.style "text-decoration: line-through;")
     (SmallCaps lst)   -> inlineListToHtml opts lst >>=
-                         return . (thespan ! [thestyle "font-variant: small-caps;"])
-    (Superscript lst) -> inlineListToHtml opts lst >>= return . sup
-    (Subscript lst)   -> inlineListToHtml opts lst >>= return . sub
+                         return . (H.span ! A.style "font-variant: small-caps;")
+    (Superscript lst) -> inlineListToHtml opts lst >>= return . H.sup
+    (Subscript lst)   -> inlineListToHtml opts lst >>= return . H.sub
     (Quoted quoteType lst) ->
                         let (leftQuote, rightQuote) = case quoteType of
-                              SingleQuote -> (stringToHtml opts "‘",
-                                              stringToHtml opts "’")
-                              DoubleQuote -> (stringToHtml opts "“",
-                                              stringToHtml opts "”")
+                              SingleQuote -> (strToHtml "‘",
+                                              strToHtml "’")
+                              DoubleQuote -> (strToHtml "“",
+                                              strToHtml "”")
                         in  do contents <- inlineListToHtml opts lst
-                               return $ leftQuote +++ contents +++ rightQuote
+                               return $ leftQuote >> contents >> rightQuote
     (Math t str) ->     modify (\st -> st {stMath = True}) >>
                         (case writerHTMLMathMethod opts of
                                LaTeXMathML _ ->
                                   -- putting LaTeXMathML in container with class "LaTeX" prevents
                                   -- non-math elements on the page from being treated as math by
                                   -- the javascript
-                                  return $ thespan ! [theclass "LaTeX"] $
+                                  return $ H.span ! A.class_ "LaTeX" $
                                          case t of
-                                           InlineMath  -> primHtml ("$" ++ str ++ "$")
-                                           DisplayMath -> primHtml ("$$" ++ str ++ "$$")
+                                           InlineMath  -> toHtml ("$" ++ str ++ "$")
+                                           DisplayMath -> toHtml ("$$" ++ str ++ "$$")
                                JsMath _ -> do
-                                  let m = primHtml str
+                                  let m = preEscapedString str
                                   return $ case t of
-                                           InlineMath -> thespan ! [theclass "math"] $ m
-                                           DisplayMath -> thediv ! [theclass "math"] $ m
+                                           InlineMath -> H.span ! A.class_ "math" $ m
+                                           DisplayMath -> H.div ! A.class_ "math" $ m
                                WebTeX url -> do
-                                  let m = image ! [thestyle "vertical-align:middle",
-                                                   src (url ++ urlEncode str),
-                                                         alt str, title str]
+                                  let m = H.img ! A.style "vertical-align:middle"
+                                                ! A.src (toValue $ url ++ urlEncode str)
+                                                ! A.alt (toValue str)
+                                                ! A.title (toValue str)
                                   return $ case t of
                                             InlineMath  -> m
-                                            DisplayMath -> br +++ m +++ br
+                                            DisplayMath -> H.br >> m >> H.br
                                GladTeX ->
                                   return $ case t of
-                                             InlineMath -> primHtml $ "<EQ ENV=\"math\">" ++ str ++ "</EQ>"
-                                             DisplayMath -> primHtml $ "<EQ ENV=\"displaymath\">" ++ str ++ "</EQ>"
+                                             InlineMath -> preEscapedString "<EQ ENV=\"math\">" >> toHtml str >> preEscapedString "</EQ>"
+                                             DisplayMath -> preEscapedString "<EQ ENV=\"displaymath\">" >> toHtml str >> preEscapedString "</EQ>"
                                MathML _ -> do
                                   let dt = if t == InlineMath
                                               then DisplayInline
@@ -584,54 +592,55 @@ inlineToHtml opts inline =
                                   let conf = useShortEmptyTags (const False)
                                                defaultConfigPP
                                   case texMathToMathML dt str of
-                                        Right r -> return $ primHtml $
+                                        Right r -> return $ preEscapedString $
                                                     ppcElement conf r
                                         Left  _ -> inlineListToHtml opts
                                                    (readTeXMath str) >>= return .
-                                                     (thespan !  [theclass "math"])
-                               MathJax _ -> return $ primHtml $
+                                                     (H.span ! A.class_ "math")
+                               MathJax _ -> return $ toHtml $
                                   case t of
                                     InlineMath  -> "\\(" ++ str ++ "\\)"
                                     DisplayMath -> "\\[" ++ str ++ "\\]"
                                PlainMath -> do
                                   x <- inlineListToHtml opts (readTeXMath str)
-                                  let m = thespan ! [theclass "math"] $ x
+                                  let m = H.span ! A.class_ "math" $ x
                                   return  $ case t of
                                              InlineMath  -> m
-                                             DisplayMath -> br +++ m +++ br )
+                                             DisplayMath -> H.br >> m >> H.br )
     (RawInline "latex" str) -> case writerHTMLMathMethod opts of
                                LaTeXMathML _ -> do modify (\st -> st {stMath = True})
-                                                   return $ primHtml str
-                               _             -> return noHtml
-    (RawInline "html" str) -> return $ primHtml str
-    (RawInline _ _) -> return noHtml
+                                                   return $ toHtml str
+                               _             -> return mempty
+    (RawInline "html" str) -> return $ preEscapedString str
+    (RawInline _ _) -> return mempty
     (Link [Code _ str] (s,_)) | "mailto:" `isPrefixOf` s ->
                         return $ obfuscateLink opts str s
     (Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do
                         linkText <- inlineListToHtml opts txt
-                        return $ obfuscateLink opts (show linkText) s
+                        return $ obfuscateLink opts (renderHtml linkText) s
     (Link txt (s,tit)) -> do
                         linkText <- inlineListToHtml opts txt
-                        return $ anchor ! ([href s] ++
-                                 if null tit then [] else [title tit]) $
-                                 linkText
+                        let link = H.a ! A.href (toValue s) $ linkText
+                        return $ if null tit
+                                    then link
+                                    else link ! A.title (toValue tit)
     (Image txt (s,tit)) | treatAsImage s -> do
                         let alternate' = stringify txt
-                        let attributes = [src s] ++
+                        let attributes = [A.src $ toValue s] ++
                                          (if null tit
                                             then []
-                                            else [title tit]) ++
+                                            else [A.title $ toValue tit]) ++
                                          if null txt
                                             then []
-                                            else [alt alternate']
-                        return $ image ! attributes
+                                            else [A.alt $ toValue alternate']
+                        return $ foldl (!) H.img attributes
                         -- note:  null title included, as in Markdown.pl
     (Image _ (s,tit)) -> do
-                        let attributes = [src s] ++
+                        let attributes = [A.src $ toValue s] ++
                                          (if null tit
                                             then []
-                                            else [title tit])
-                        return $ itag "embed" ! attributes
+                                            else [A.title $ toValue tit])
+                        return $ foldl (!) H.embed attributes
                         -- note:  null title included, as in Markdown.pl
     (Note contents)          -> do
                         st <- get
@@ -641,20 +650,20 @@ inlineToHtml opts inline =
                         htmlContents <- blockListToNote opts ref contents
                         -- push contents onto front of notes
                         put $ st {stNotes = (htmlContents:notes)}
-                        return $ sup <<
-                                 anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ "fn" ++ ref),
-                                           theclass "footnoteRef",
-                                           prefixedId opts ("fnref" ++ ref)] << ref
+                        return $ H.sup $
+                                 H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ "fn" ++ ref)
+                                     ! A.class_ "footnoteRef"
+                                     ! prefixedId opts ("fnref" ++ ref)
+                                     $ toHtml ref
     (Cite _ il)  -> do contents <- inlineListToHtml opts il
-                       return $ thespan ! [theclass "citation"] << contents
+                       return $ H.span ! A.class_ "citation" $ contents
 
 blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html
 blockListToNote opts ref blocks =
   -- If last block is Para or Plain, include the backlink at the end of
   -- that block. Otherwise, insert a new Plain block with the backlink.
   let backlink = [RawInline "html" $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++
-                 "\" class=\"footnoteBackLink\">" ++
-                 (if writerAscii opts then "&#8617;" else "↩") ++ "</a>"]
+                 "\" class=\"footnoteBackLink\">↩</a>"]
       blocks'  = if null blocks
                     then []
                     else let lastBlock   = last blocks
@@ -667,4 +676,4 @@ blockListToNote opts ref blocks =
                                   _           -> otherBlocks ++ [lastBlock,
                                                  Plain backlink]
   in  do contents <- blockListToHtml opts blocks'
-         return $ nl opts +++ (li ! [prefixedId opts ("fn" ++ ref)]) contents
+         return $ nl opts >> (H.li ! (prefixedId opts ("fn" ++ ref)) $ contents)