{-# OPTIONS_GHC -fno-warn-deprecations #-}{-
Copyright (C) 2006-8 John MacFarlane <jgm@berkeley.edu>
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-8 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Conversion of 'Pandoc' documents to HTML.
-}moduleText.Pandoc.Writers.HTML(writeHtml,writeHtmlString)whereimportText.Pandoc.DefinitionimportText.Pandoc.LaTeXMathMLimportText.Pandoc.CharacterReferences(decodeCharacterReferences)importText.Pandoc.SharedimportText.Pandoc.Readers.TeXMathimportText.Pandoc.Highlighting(highlightHtml,defaultHighlightingCss)importNumeric(showHex)importData.Char(ord,toLower,isAlpha)importData.List(isPrefixOf,intercalate)importqualifiedData.SetasSimportControl.Monad.StateimportText.XHtml.Transitionalhiding(stringToHtml)dataWriterState=WriterState{stNotes::[Html]-- ^ List of notes,stIds::[String]-- ^ List of header identifiers,stMath::Bool-- ^ Math is used in document,stCSS::S.SetString-- ^ CSS to include in header}derivingShowdefaultWriterState::WriterStatedefaultWriterState=WriterState{stNotes=[],stIds=[],stMath=False,stCSS=S.empty}-- Helpers to render HTML with the appropriate function.render::(HTMLhtml)=>WriterOptions->html->Stringrenderopts=ifwriterWrapTextoptsthenrenderHtmlelseshowHtmlrenderFragment::(HTMLhtml)=>WriterOptions->html->StringrenderFragmentopts=ifwriterWrapTextoptsthenrenderHtmlFragmentelseshowHtmlFragment-- | Slightly modified version of Text.XHtml's stringToHtml.-- Only uses numerical entities for 0xff and greater.-- Adds &nbsp;.stringToHtml::String->HtmlstringToHtml=primHtml.concatMapfixCharwherefixChar'<'="&lt;"fixChar'>'="&gt;"fixChar'&'="&amp;"fixChar'"'="&quot;"fixChar'\160'="&nbsp;"fixCharc|ordc<0xff=[c]fixCharc="&#"++show(ordc)++";"-- | Convert Pandoc document to Html string.writeHtmlString::WriterOptions->Pandoc->StringwriteHtmlStringopts=ifwriterStandaloneoptsthenrenderopts.writeHtmloptselserenderFragmentopts.writeHtmlopts-- | Convert Pandoc document to Html structure.writeHtml::WriterOptions->Pandoc->HtmlwriteHtmlopts(Pandoc(Metatitauthorsdate)blocks)=lettitlePrefix=writerTitlePrefixoptstopTitle=evalState(inlineListToHtmloptstit)defaultWriterStatetopTitle'=ifnulltitlePrefixthentopTitleelseifnulltitthenstringToHtmltitlePrefixelsetitlePrefix+++" - "+++topTitlemetadata=thetitletopTitle'+++meta![httpequiv"Content-Type",content"text/html; charset=UTF-8"]+++meta![name"generator",content"pandoc"]+++(toHtmlFromList$map(\a->meta![name"author",contenta])authors)+++(ifnulldatethennoHtmlelsemeta![name"date",contentdate])titleHeader=ifwriterStandaloneopts&&not(nulltit)&&not(writerS5opts)thenh1![theclass"title"]$topTitleelsenoHtmlheaderBlocks=filterisHeaderBlockblocksids=uniqueIdentifiers$map(\(Header_lst)->lst)headerBlockstoc=ifwriterTableOfContentsoptsthentableOfContentsoptsheaderBlocksidselsenoHtml(blocks',newstate)=runState(blockListToHtmloptsblocks)(defaultWriterState{stIds=ids})cssLines=stCSSnewstatecss=ifS.nullcssLinesthennoHtmlelsestyle![thetype"text/css"]$primHtml$'\n':(unlines$S.toListcssLines)math=ifstMathnewstatethencasewriterHTMLMathMethodoptsofLaTeXMathMLNothing->primHtmllatexMathMLScriptLaTeXMathML(Justurl)->script![srcurl,thetype"text/javascript"]$noHtml_->noHtmlelsenoHtmlhead'=header$metadata+++math+++css+++primHtml(writerHeaderopts)notes=reverse(stNotesnewstate)before=primHtml$writerIncludeBeforeoptsafter=primHtml$writerIncludeAfteroptsthebody=before+++titleHeader+++toc+++blocks'+++footnoteSectionnotes+++afterinifwriterStandaloneoptsthenhead'+++bodythebodyelsethebody-- | Construct table of contents from list of header blocks and identifiers.-- Assumes there are as many identifiers as header blocks.tableOfContents::WriterOptions->[Block]->[String]->HtmltableOfContents_[]_=noHtmltableOfContentsoptsheadersids=letopts'=opts{writerIgnoreNotes=True}contentsTree=hierarchicalizeheaderscontents=evalState(mapM(elementToListItemopts')contentsTree)(defaultWriterState{stIds=ids})inthediv![identifier"toc"]$unordListcontents-- | Converts an Element to a list item for a table of contents,-- retrieving the appropriate identifier from state.elementToListItem::WriterOptions->Element->StateWriterStateHtmlelementToListItem_(Blk_)=returnnoHtmlelementToListItemopts(SecheaderTextsubsecs)=dost<-getletids=stIdsstlet(id',rest)=ifnullidsthen("",[])else(headids,tailids)put$st{stIds=rest}txt<-inlineListToHtmloptsheaderTextsubHeads<-mapM(elementToListItemopts)subsecsletsubList=ifnullsubHeadsthennoHtmlelseunordListsubHeadsreturn$(anchor![href("#"++id'),identifier("TOC-"++id')]$txt)+++subList-- | Convert list of Note blocks to a footnote <div>.-- Assumes notes are sorted.footnoteSection::[Html]->HtmlfootnoteSectionnotes=ifnullnotesthennoHtmlelsethediv![theclass"footnotes"]$hr+++(olist<<notes)-- | Parse a mailto link; return Just (name, domain) or Nothing.parseMailto::String->Maybe(String,String)parseMailto('m':'a':'i':'l':'t':'o':':':addr)=let(name',rest)=span(/='@')addrdomain=drop1restinJust(name',domain)parseMailto_=Nothing-- | Obfuscate a "mailto:" link using Javascript.obfuscateLink::WriterOptions->String->String->HtmlobfuscateLinkoptstxts=lets'=maptoLowersincaseparseMailtos'of(Just(name',domain))->letdomain'=substitute"."" dot "domainat'=obfuscateChar'@'(linkText,altText)=iftxt==drop7s'-- autolinkthen("'<code>'+e+'</code>'",name'++" at "++domain')else("'"++txt++"'",txt++" ("++name'++" at "++domain'++")")inifwriterStrictMarkdownoptsthen-- need to use primHtml or &'s are escaped to &amp; in URLprimHtml$"<a href=\""++(obfuscateStrings')++"\">"++(obfuscateStringtxt)++"</a>"else(script![thetype"text/javascript"]$primHtml("\n<!--\nh='"++obfuscateStringdomain++"';a='"++at'++"';n='"++obfuscateStringname'++"';e=n+a+h;\n"++"document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+"++linkText++"+'<\\/'+'a'+'>');\n// -->\n"))+++noscript(primHtml$obfuscateStringaltText)_->anchor![hrefs]$primHtmltxt-- malformed email-- | Obfuscate character as entity.obfuscateChar::Char->StringobfuscateCharchar=letnum=ordcharnumstr=ifevennumthenshownumelse"x"++showHexnum""in"&#"++numstr++";"-- | Obfuscate string using entities.obfuscateString::String->StringobfuscateString=concatMapobfuscateChar.decodeCharacterReferences-- | True if character is a punctuation character (unicode).isPunctuation::Char->BoolisPunctuationc=letc'=ordcinifc`elem`"!\"'()*,-./:;<>?[\\]`{|}~"||c'>=0x2000&&c'<=0x206F||c'>=0xE000&&c'<=0xE0FFthenTrueelseFalse-- | Add CSS for document header.addToCSS::String->StateWriterState()addToCSSitem=dost<-getletcurrent=stCSSstput$st{stCSS=S.insertitemcurrent}-- | Convert Pandoc inline list to plain text identifier.inlineListToIdentifier::[Inline]->StringinlineListToIdentifier=dropWhile(not.isAlpha).inlineListToIdentifier'inlineListToIdentifier'::[Inline]->[Char]inlineListToIdentifier'[]=""inlineListToIdentifier'(x:xs)=xAsText++inlineListToIdentifier'xswherexAsText=casexofStrs->filter(\c->c=='-'||not(isPunctuationc))$intercalate"-"$words$maptoLowersEmphlst->inlineListToIdentifier'lstStrikeoutlst->inlineListToIdentifier'lstSuperscriptlst->inlineListToIdentifier'lstSmallCapslst->inlineListToIdentifier'lstSubscriptlst->inlineListToIdentifier'lstStronglst->inlineListToIdentifier'lstQuoted_lst->inlineListToIdentifier'lstCite_lst->inlineListToIdentifier'lstCodes->sSpace->"-"EmDash->"-"EnDash->"-"Apostrophe->""Ellipses->""LineBreak->"-"Math__->""TeX_->""HtmlInline_->""Linklst_->inlineListToIdentifier'lstImagelst_->inlineListToIdentifier'lstNote_->""-- | Return unique identifiers for list of inline lists.uniqueIdentifiers::[[Inline]]->[String]uniqueIdentifiersls=letaddIdentifier(nonuniqueIds,uniqueIds)l=letnew=inlineListToIdentifierlmatches=length$filter(==new)nonuniqueIdsnew'=(ifnullnewthen"section"elsenew)++ifmatches>0then("-"++showmatches)else""in(new:nonuniqueIds,new':uniqueIds)inreverse$snd$foldladdIdentifier([],[])ls-- | Convert Pandoc block element to HTML.blockToHtml::WriterOptions->Block->StateWriterStateHtmlblockToHtml_Null=return$noHtmlblockToHtmlopts(Plainlst)=inlineListToHtmloptslstblockToHtmlopts(Paralst)=inlineListToHtmloptslst>>=(return.paragraph)blockToHtml_(RawHtmlstr)=return$primHtmlstrblockToHtml_(HorizontalRule)=return$hrblockToHtml_(CodeBlockattr@(_,classes,_)rawCode)=docasehighlightHtmlattrrawCodeofLeft_->-- change leading newlines into <br /> tags, because some-- browsers ignore leading newlines in pre blockslet(leadingBreaks,rawCode')=span(=='\n')rawCodeinreturn$pre!(ifnullclassesthen[]else[theclass$unwordsclasses])$thecode<<(replicate(lengthleadingBreaks)br+++[stringToHtml$rawCode'++"\n"])Righth->addToCSSdefaultHighlightingCss>>returnhblockToHtmlopts(BlockQuoteblocks)=-- in S5, treat list in blockquote specially-- if default is incremental, make it nonincremental; -- otherwise incrementalifwriterS5optsthenletinc=not(writerIncrementalopts)incaseblocksof[BulletListlst]->blockToHtml(opts{writerIncremental=inc})(BulletListlst)[OrderedListattribslst]->blockToHtml(opts{writerIncremental=inc})(OrderedListattribslst)_->blockListToHtmloptsblocks>>=(return.blockquote)elseblockListToHtmloptsblocks>>=(return.blockquote)blockToHtmlopts(Headerlevellst)=docontents<-inlineListToHtmloptslstst<-getletids=stIdsstlet(id',rest)=ifnullidsthen("",[])else(headids,tailids)put$st{stIds=rest}letattribs=ifwriterStrictMarkdownopts&&not(writerTableOfContentsopts)then[]else[identifierid']letcontents'=ifwriterTableOfContentsoptsthenanchor![href("#TOC-"++id')]$contentselsecontentsreturn$caselevelof1->h1contents'!attribs2->h2contents'!attribs3->h3contents'!attribs4->h4contents'!attribs5->h5contents'!attribs6->h6contents'!attribs_->paragraphcontents'!attribsblockToHtmlopts(BulletListlst)=docontents<-mapM(blockListToHtmlopts)lstletattribs=ifwriterIncrementaloptsthen[theclass"incremental"]else[]return$unordList!attribs$contentsblockToHtmlopts(OrderedList(startnum,numstyle,_)lst)=docontents<-mapM(blockListToHtmlopts)lstletnumstyle'=camelCaseToHyphenated$shownumstyleletattribs=(ifwriterIncrementaloptsthen[theclass"incremental"]else[])++(ifstartnum/=1then[startstartnum]else[])++(ifnumstyle/=DefaultStylethen[thestyle$"list-style-type: "++numstyle'++";"]else[])return$ordList!attribs$contentsblockToHtmlopts(DefinitionListlst)=docontents<-mapM(\(term,def)->doterm'<-inlineListToHtmloptstermdef'<-blockListToHtmloptsdefreturn$(term',def'))lstletattribs=ifwriterIncrementaloptsthen[theclass"incremental"]else[]return$defList!attribs$contentsblockToHtmlopts(Tablecaptalignswidthsheadersrows')=doletalignStrings=mapalignmentToStringalignscaptionDoc<-ifnullcaptthenreturnnoHtmlelseinlineListToHtmloptscapt>>=return.captioncolHeads<-colHeadsToHtmloptsalignStringswidthsheadersrows''<-mapM(tableRowToHtmloptsalignStrings)rows'return$table$captionDoc+++colHeads+++rows''colHeadsToHtml::WriterOptions->[[Char]]->[Double]->[[Block]]->StateWriterStateHtmlcolHeadsToHtmloptsalignStringswidthsheaders=doheads<-sequence$zipWith3(\alignmentcolumnwidthitem->tableItemToHtmloptsthalignmentcolumnwidthitem)alignStringswidthsheadersreturn$tr$toHtmlFromListheadsalignmentToString::Alignment->[Char]alignmentToStringalignment=casealignmentofAlignLeft->"left"AlignRight->"right"AlignCenter->"center"AlignDefault->"left"tableRowToHtml::WriterOptions->[[Char]]->[[Block]]->StateWriterStateHtmltableRowToHtmloptsalignscolumns=(sequence$zipWith3(tableItemToHtmloptstd)aligns(repeat0)columns)>>=return.tr.toHtmlFromListtableItemToHtml::WriterOptions->(Html->Html)->[Char]->Double->[Block]->StateWriterStateHtmltableItemToHtmloptstag'align'width'item=docontents<-blockListToHtmloptsitemletattrib=[alignalign']++ifwidth'/=0then[thestyle("width: "++(show(truncate(100*width')::Integer))++"%;")]else[]return$tag'!attrib$contentsblockListToHtml::WriterOptions->[Block]->StateWriterStateHtmlblockListToHtmloptslst=mapM(blockToHtmlopts)lst>>=return.toHtmlFromList-- | Convert list of Pandoc inline elements to HTML.inlineListToHtml::WriterOptions->[Inline]->StateWriterStateHtmlinlineListToHtmloptslst=mapM(inlineToHtmlopts)lst>>=return.toHtmlFromList-- | Convert Pandoc inline element to HTML.inlineToHtml::WriterOptions->Inline->StateWriterStateHtmlinlineToHtmloptsinline=caseinlineof(Strstr)->return$stringToHtmlstr(Space)->return$stringToHtml" "(LineBreak)->return$br(EmDash)->return$primHtmlChar"mdash"(EnDash)->return$primHtmlChar"ndash"(Ellipses)->return$primHtmlChar"hellip"(Apostrophe)->return$primHtmlChar"rsquo"(Emphlst)->inlineListToHtmloptslst>>=return.emphasize(Stronglst)->inlineListToHtmloptslst>>=return.strong(Codestr)->return$thecode<<str(Strikeoutlst)->inlineListToHtmloptslst>>=return.(thespan![thestyle"text-decoration: line-through;"])(SmallCapslst)->inlineListToHtmloptslst>>=return.(thespan![thestyle"font-variant: small-caps;"])(Superscriptlst)->inlineListToHtmloptslst>>=return.sup(Subscriptlst)->inlineListToHtmloptslst>>=return.sub(QuotedquoteTypelst)->let(leftQuote,rightQuote)=casequoteTypeofSingleQuote->(primHtmlChar"lsquo",primHtmlChar"rsquo")DoubleQuote->(primHtmlChar"ldquo",primHtmlChar"rdquo")indocontents<-inlineListToHtmloptslstreturn$leftQuote+++contents+++rightQuote(Mathtstr)->modify(\st->st{stMath=True})>>(casewriterHTMLMathMethodoptsofLaTeXMathML_->return$ift==InlineMaththenprimHtml("$"++str++"$")elseprimHtml("$$"++str++"$$")MimeTeXurl->return$image![src(url++"?"++str),altstr,titlestr]GladTeX->return$primHtml$"<EQ>"++str++"</EQ>"PlainMath->inlineListToHtmlopts(readTeXMathstr)>>=return.(thespan![theclass"math"]))(TeXstr)->casewriterHTMLMathMethodoptsofLaTeXMathML_->domodify(\st->st{stMath=True})return$primHtmlstr_->returnnoHtml(HtmlInlinestr)->return$primHtmlstr(Link[Codestr](s,_))|"mailto:"`isPrefixOf`s->return$obfuscateLinkoptsstrs(Linktxt(s,_))|"mailto:"`isPrefixOf`s->dolinkText<-inlineListToHtmloptstxtreturn$obfuscateLinkopts(showlinkText)s(Linktxt(s,tit))->dolinkText<-inlineListToHtmloptstxtreturn$anchor!([hrefs]++ifnulltitthen[]else[titletit])$linkText(Imagetxt(s,tit))->doalternate<-inlineListToHtmloptstxtletalternate'=renderFragmentoptsalternateletattributes=[srcs]++(ifnulltitthen[]else[titletit])++ifnulltxtthen[]else[altalternate']return$image!attributes-- note: null title included, as in Markdown.pl (Notecontents)->dost<-getletnotes=stNotesstletnumber=(lengthnotes)+1letref=shownumberhtmlContents<-blockListToNoteoptsrefcontents-- push contents onto front of notesput$st{stNotes=(htmlContents:notes)}return$anchor![href("#fn"++ref),theclass"footnoteRef",identifier("fnref"++ref)]<<sup<<ref(Cite_il)->inlineListToHtmloptsilblockListToNote::WriterOptions->String->[Block]->StateWriterStateHtmlblockListToNoteoptsrefblocks=-- 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.letbacklink=[HtmlInline$" <a href=\"#fnref"++ref++"\" class=\"footnoteBackLink\""++" title=\"Jump back to footnote "++ref++"\">&#8617;</a>"]blocks'=ifnullblocksthen[]elseletlastBlock=lastblocksotherBlocks=initblocksincaselastBlockof(Paralst)->otherBlocks++[Para(lst++backlink)](Plainlst)->otherBlocks++[Plain(lst++backlink)]_->otherBlocks++[lastBlock,Plainbacklink]indocontents<-blockListToHtmloptsblocks'return$li![identifier("fn"++ref)]$contents