{- Copyright (C) 2006 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Writers.HTML Copyright : Copyright (C) 2006 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha Portability : portable Conversion of 'Pandoc' documents to HTML. -} module Text.Pandoc.Writers.HTML ( writeHtml, writeHtmlString ) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Regex ( mkRegex, matchRegex ) import Numeric ( showHex ) import Data.Char ( ord, toLower ) import Data.List ( isPrefixOf, partition ) import Text.XHtml.Strict -- | Convert Pandoc document to Html string. writeHtmlString :: WriterOptions -> Pandoc -> String writeHtmlString opts = if writerStandalone opts then renderHtml . (writeHtml opts) else renderHtmlFragment . (writeHtml opts) -- | Convert Pandoc document to Html structure. writeHtml :: WriterOptions -> Pandoc -> Html writeHtml opts (Pandoc (Meta tit authors date) blocks) = let titlePrefix = writerTitlePrefix opts topTitle = inlineListToHtml opts tit topTitle' = if not (null titlePrefix) then stringToHtml titlePrefix +++ if not (null tit) then '-' +++ topTitle else noHtml else topTitle head = header $ thetitle topTitle' +++ meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"] +++ meta ! [name "generator", content "pandoc"] +++ (toHtmlFromList $ map (\a -> meta ! [name "author", content a]) authors) +++ (if null date then noHtml else meta ! [name "date", content date]) +++ primHtml (writerHeader opts) titleHeader = if (writerStandalone opts) && (not (null tit)) && (not (writerS5 opts)) then h1 ! [theclass "title"] $ topTitle else noHtml blocks' = replaceReferenceLinks blocks (noteBlocks, blocks'') = partition isNoteBlock blocks' before = primHtml $ writerIncludeBefore opts after = primHtml $ writerIncludeAfter opts thebody = before +++ titleHeader +++ toHtmlFromList (map (blockToHtml opts) blocks'') +++ footnoteSection opts noteBlocks +++ after in if writerStandalone opts then head +++ (body thebody) else thebody -- | Convert list of Note blocks to a footnote
. -- Assumes notes are sorted. footnoteSection :: WriterOptions -> [Block] -> Html footnoteSection opts notes = if null notes then noHtml else thediv ! [theclass "footnotes"] $ hr +++ (olist $ toHtmlFromList $ map (blockToHtml opts) notes) -- | Obfuscate a "mailto:" link using Javascript. obfuscateLink :: WriterOptions -> [Inline] -> String -> Html obfuscateLink opts txt src = let emailRegex = mkRegex "mailto:*([^@]*)@(.*)" text' = show $ inlineListToHtml opts txt src' = map toLower src in case (matchRegex emailRegex src') of (Just [name, domain]) -> let domain' = substitute "." " dot " domain at' = obfuscateChar '@' linkText = if src' == ("mailto:" ++ text') then "e" else "'" ++ text' ++ "'" altText = if src' == ("mailto:" ++ text') then name ++ " at " ++ domain' else text' ++ " (" ++ name ++ " at " ++ domain' ++ ")" in if writerStrictMarkdown opts then anchor ! [href $ obfuscateString src'] $ stringToHtml $ obfuscateString text' else (script ! [thetype "text/javascript"] $ primHtml ("\n\n")) +++ noscript (stringToHtml $ obfuscateString altText) _ -> anchor ! [href src] $ inlineListToHtml opts txt -- malformed email -- | Obfuscate character as entity. obfuscateChar :: Char -> String obfuscateChar char = let num = ord char in let numstr = if even num then (show num) else ("x" ++ (showHex num "")) in "&#" ++ numstr ++ ";" -- | Obfuscate string using entities. obfuscateString :: String -> String obfuscateString = concatMap obfuscateChar -- | Convert Pandoc block element to HTML. blockToHtml :: WriterOptions -> Block -> Html blockToHtml opts Blank = noHtml blockToHtml opts Null = noHtml blockToHtml opts (Plain lst) = inlineListToHtml opts lst blockToHtml opts (Para lst) = paragraph $ inlineListToHtml opts lst blockToHtml opts (BlockQuote blocks) = if (writerS5 opts) then -- in S5, treat list in blockquote specially -- if default is incremental, make it nonincremental; -- otherwise incremental let inc = not (writerIncremental opts) in case blocks of [BulletList lst] -> blockToHtml (opts {writerIncremental = inc}) (BulletList lst) [OrderedList lst] -> blockToHtml (opts {writerIncremental = inc}) (OrderedList lst) otherwise -> blockquote $ toHtmlFromList $ map (blockToHtml opts) blocks else blockquote $ toHtmlFromList $ map (blockToHtml opts) blocks blockToHtml opts (Note ref lst) = let contents = toHtmlFromList $ map (blockToHtml opts) lst backlink = anchor ! [href ("#fnref" ++ ref), theclass "footnoteBacklink", title ("Jump back to footnote " ++ ref)] $ (primHtmlChar "#8617") in li ! [identifier ("fn" ++ ref)] $ contents +++ backlink blockToHtml opts (Key _ _) = noHtml blockToHtml opts (CodeBlock str) = pre $ thecode $ stringToHtml (str ++ "\n") -- the final \n for consistency with Markdown.pl blockToHtml opts (RawHtml str) = primHtml str blockToHtml opts (BulletList lst) = let attribs = if writerIncremental opts then [theclass "incremental"] else [] in ulist ! attribs $ toHtmlFromList $ map (listItemToHtml opts) lst blockToHtml opts (OrderedList lst) = let attribs = if writerIncremental opts then [theclass "incremental"] else [] in olist ! attribs $ toHtmlFromList $ map (listItemToHtml opts) lst blockToHtml opts HorizontalRule = hr blockToHtml opts (Header level lst) = let contents = inlineListToHtml opts lst in case level of 1 -> h1 contents 2 -> h2 contents 3 -> h3 contents 4 -> h4 contents 5 -> h5 contents 6 -> h6 contents _ -> paragraph contents blockToHtml opts (Table capt aligns widths headers rows) = let alignStrings = map alignmentToString aligns captionDoc = if null capt then noHtml else caption $ inlineListToHtml opts capt in table $ captionDoc +++ (colHeadsToHtml opts alignStrings widths headers) +++ (toHtmlFromList $ map (tableRowToHtml opts alignStrings) rows) colHeadsToHtml opts alignStrings widths headers = let heads = zipWith3 (\align width item -> tableItemToHtml opts th align width item) alignStrings widths headers in tr $ toHtmlFromList heads alignmentToString alignment = case alignment of AlignLeft -> "left" AlignRight -> "right" AlignCenter -> "center" AlignDefault -> "left" tableRowToHtml opts aligns cols = tr $ toHtmlFromList $ zipWith3 (tableItemToHtml opts td) aligns (repeat 0) cols tableItemToHtml opts tag align' width item = let attrib = [align align'] ++ if (width /= 0) then [thestyle ("{width: " ++ show (truncate (100*width)) ++ "%;}")] else [] in tag ! attrib $ toHtmlFromList $ map (blockToHtml opts) item listItemToHtml :: WriterOptions -> [Block] -> Html listItemToHtml opts list = li $ toHtmlFromList $ map (blockToHtml opts) list -- | Convert list of Pandoc inline elements to HTML. inlineListToHtml :: WriterOptions -> [Inline] -> Html inlineListToHtml opts lst = toHtmlFromList $ map (inlineToHtml opts) lst -- | Convert Pandoc inline element to HTML. inlineToHtml :: WriterOptions -> Inline -> Html inlineToHtml opts (Emph lst) = emphasize $ inlineListToHtml opts lst inlineToHtml opts (Strong lst) = strong $ inlineListToHtml opts lst inlineToHtml opts (Code str) = thecode $ stringToHtml $ str inlineToHtml opts (Quoted SingleQuote lst) = primHtmlChar "lsquo" +++ inlineListToHtml opts lst +++ primHtmlChar "rsquo" inlineToHtml opts (Quoted DoubleQuote lst) = primHtmlChar "ldquo" +++ inlineListToHtml opts lst +++ primHtmlChar "rdquo" inlineToHtml opts EmDash = primHtmlChar "mdash" inlineToHtml opts EnDash = primHtmlChar "ndash" inlineToHtml opts Ellipses = primHtmlChar "hellip" inlineToHtml opts Apostrophe = primHtmlChar "rsquo" inlineToHtml opts (Str str) = stringToHtml str inlineToHtml opts (TeX str) = stringToHtml str inlineToHtml opts (HtmlInline str) = primHtml str inlineToHtml opts (LineBreak) = br inlineToHtml opts Space = stringToHtml " " inlineToHtml opts (Link txt (Src src tit)) = if (isPrefixOf "mailto:" src) then obfuscateLink opts txt src else anchor ! ([href src] ++ if null tit then [] else [title tit]) $ inlineListToHtml opts txt inlineToHtml opts (Link txt (Ref ref)) = '[' +++ (inlineListToHtml opts txt) +++ ']' +++ '[' +++ (inlineListToHtml opts ref) +++ ']' -- this is what markdown does, for better or worse inlineToHtml opts (Image alttext (Src source tit)) = let alternate = renderHtml $ inlineListToHtml opts alttext in image ! ([src source, title tit] ++ if null alttext then [] else [alt alternate]) -- note: null title is included, as in Markdown.pl inlineToHtml opts (Image alternate (Ref ref)) = '!' +++ inlineToHtml opts (Link alternate (Ref ref)) inlineToHtml opts (NoteRef ref) = anchor ! [href ("#fn" ++ ref), theclass "footnoteRef", identifier ("fnref" ++ ref)] $ sup (stringToHtml ref)