{-# OPTIONS_GHC -fno-warn-deprecations #-}{-
Copyright (C) 2006-2010 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-2010 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.CharacterReferences(decodeCharacterReferences)importText.Pandoc.SharedimportText.Pandoc.TemplatesimportText.Pandoc.Readers.TeXMathimportText.Pandoc.Highlighting(highlightHtml,defaultHighlightingCss)importText.Pandoc.XML(stripTags,escapeStringForXML)importNetwork.HTTP(urlEncode)importNumeric(showHex)importData.Char(ord,toLower)importData.List(isPrefixOf,intersperse)importData.Maybe(catMaybes)importControl.Monad.StateimportText.XHtml.Transitionalhiding(stringToHtml)importText.TeXMathimportText.XML.Light.OutputdataWriterState=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}derivingShowdefaultWriterState::WriterStatedefaultWriterState=WriterState{stNotes=[],stMath=False,stHighlighting=False,stSecNum=[]}-- Helpers to render HTML with the appropriate function.renderFragment::(HTMLhtml)=>WriterOptions->html->StringrenderFragmentopts=ifwriterWrapTextoptsthenrenderHtmlFragmentelseshowHtmlFragment-- | Modified version of Text.XHtml's stringToHtml.-- Use unicode characters wherever possible.stringToHtml::String->HtmlstringToHtml=primHtml.escapeStringForXML-- | Convert Pandoc document to Html string.writeHtmlString::WriterOptions->Pandoc->StringwriteHtmlStringoptsd=let(tit,auths,date,toc,body',newvars)=evalState(pandocToHtmloptsd)defaultWriterStateinifwriterStandaloneoptstheninTemplateoptstitauthsdatetocbody'newvarselserenderFragmentoptsbody'-- | Convert Pandoc document to Html structure.writeHtml::WriterOptions->Pandoc->HtmlwriteHtmloptsd=let(tit,auths,date,toc,body',newvars)=evalState(pandocToHtmloptsd)defaultWriterStateinifwriterStandaloneoptstheninTemplateoptstitauthsdatetocbody'newvarselsebody'-- result is (title, authors, date, toc, body, new variables)pandocToHtml::WriterOptions->Pandoc->StateWriterState(Html,[Html],Html,MaybeHtml,Html,[(String,String)])pandocToHtmlopts(Pandoc(Metatitle'authors'date')blocks)=doletstandalone=writerStandaloneoptstit<-ifstandalonetheninlineListToHtmloptstitle'elsereturnnoHtmlauths<-ifstandalonethenmapM(inlineListToHtmlopts)authors'elsereturn[]date<-ifstandalonetheninlineListToHtmloptsdate'elsereturnnoHtmlletsects=hierarchicalizeblockstoc<-ifwriterTableOfContentsoptsthentableOfContentsoptssectselsereturnNothingletstartSlide=RawHtml"<div class=\"slide\">\n"endSlide=RawHtml"</div>\n"letcutUp(HorizontalRule:Header1ys:xs)=cutUp(Header1ys:xs)cutUp(HorizontalRule:xs)=[endSlide,startSlide]++cutUpxscutUp(Header1ys:xs)=[endSlide,startSlide]++(Header1ys:cutUpxs)cutUp(x:xs)=x:cutUpxscutUp[]=[]letslides=caseblocksof(HorizontalRule:xs)->[startSlide]++cutUpxs++[endSlide](Header1ys:xs)->[startSlide,Header1ys]++cutUpxs++[endSlide]_->[startSlide]++cutUpblocks++[endSlide]blocks'<-liftMtoHtmlFromList$ifwriterSlideVariantopts`elem`[SlidySlides,S5Slides]thenmapM(blockToHtmlopts)slideselsemapM(elementToHtmlopts)sectsst<-getletnotes=reverse(stNotesst)letthebody=blocks'+++footnoteSectionnotesletmath=ifstMathstthencasewriterHTMLMathMethodoptsofLaTeXMathML(Justurl)->script![srcurl,thetype"text/javascript"]$noHtmlMathML(Justurl)->script![srcurl,thetype"text/javascript"]$noHtmlJsMath(Justurl)->script![srcurl,thetype"text/javascript"]$noHtml_->caselookup"mathml-script"(writerVariablesopts)ofJusts->script![thetype"text/javascript"]<<primHtmlsNothing->noHtmlelsenoHtmlletnewvars=[("highlighting-css",defaultHighlightingCss)|stHighlightingst]++[("math",renderHtmlFragmentmath)|stMathst]return(tit,auths,date,toc,thebody,newvars)inTemplate::TemplateTargeta=>WriterOptions->Html->[Html]->Html->MaybeHtml->Html->[(String,String)]->ainTemplateoptstitauthsdatetocbody'newvars=letrenderedTit=showHtmlFragmenttittopTitle'=stripTagsrenderedTitauthors=map(stripTags.showHtmlFragment)authsdate'=stripTags$showHtmlFragmentdatevariables=writerVariablesopts++newvarscontext=variables++[("body",renderHtmlFragmentbody'),("pagetitle",topTitle'),("title",renderHtmlFragmenttit),("date",date')]++(casetocofJustt->[("toc",renderHtmlFragmentt)]Nothing->[])++[("author",a)|a<-authors]inrenderTemplatecontext$writerTemplateopts-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefixprefixedId::WriterOptions->String->HtmlAttrprefixedIdoptss=identifier$writerIdentifierPrefixopts++s-- | Construct table of contents from list of elements.tableOfContents::WriterOptions->[Element]->StateWriterState(MaybeHtml)tableOfContents_[]=returnNothingtableOfContentsoptssects=doletopts'=opts{writerIgnoreNotes=True}contents<-mapM(elementToListItemopts')sectslettocList=catMaybescontentsreturn$ifnulltocListthenNothingelseJust$thediv![prefixedIdopts'"TOC"]$unordListtocList-- | Convert section number to stringshowSecNum::[Int]->StringshowSecNum=concat.intersperse".".mapshow-- | Converts an Element to a list item for a table of contents,-- retrieving the appropriate identifier from state.elementToListItem::WriterOptions->Element->StateWriterState(MaybeHtml)elementToListItem_(Blk_)=returnNothingelementToListItemopts(Sec_numid'headerTextsubsecs)=doletsectnum=ifwriterNumberSectionsoptsthen(thespan![theclass"toc-section-number"]<<showSecNumnum)+++stringToHtml" "elsenoHtmltxt<-liftM(sectnum+++)$inlineListToHtmloptsheaderTextsubHeads<-mapM(elementToListItemopts)subsecs>>=return.catMaybesletsubList=ifnullsubHeadsthennoHtmlelseunordListsubHeadsreturn$Just$(anchor![href("#"++writerIdentifierPrefixopts++id')]$txt)+++subList-- | Convert an Element to Html.elementToHtml::WriterOptions->Element->StateWriterStateHtmlelementToHtmlopts(Blkblock)=blockToHtmloptsblockelementToHtmlopts(Seclevelnumid'title'elements)=doinnerContents<-mapM(elementToHtmlopts)elementsmodify$\st->st{stSecNum=num}-- update section numberheader'<-blockToHtmlopts(Headerleveltitle')letslides=writerSlideVariantopts`elem`[SlidySlides,S5Slides]letheader''=header'![prefixedIdoptsid'|not(writerStrictMarkdownopts||writerSectionDivsopts||slides)]letstuff=header'':innerContentsreturn$ifslides-- S5 gets confused by the extra divs around sectionsthentoHtmlFromListstuffelseifwriterSectionDivsoptsthenthediv![prefixedIdoptsid']<<stuffelsetoHtmlFromListstuff-- | 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.obfuscateLink::WriterOptions->String->String->HtmlobfuscateLinkoptstxts|writerEmailObfuscationopts==NoObfuscation=anchor![hrefs]<<txtobfuscateLinkoptstxts=letmeth=writerEmailObfuscationoptss'=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'++")")incasemethofReferenceObfuscation->-- need to use primHtml or &'s are escaped to &amp; in URLprimHtml$"<a href=\""++(obfuscateStrings')++"\">"++(obfuscateStringtxt)++"</a>"JavascriptObfuscation->(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)_->error$"Unknown obfuscation method: "++showmeth_->anchor![hrefs]$stringToHtmltxt-- 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-- | Convert Pandoc block element to HTML.blockToHtml::WriterOptions->Block->StateWriterStateHtmlblockToHtml_Null=return$noHtmlblockToHtmlopts(Plainlst)=inlineListToHtmloptslstblockToHtmlopts(Para[Imagetxt(s,tit)])=doimg<-inlineToHtmlopts(Imagetxt(s,tit))capt<-inlineListToHtmloptstxtreturn$thediv![theclass"figure"]<<[img,paragraph![theclass"caption"]<<capt]blockToHtmlopts(Paralst)=inlineListToHtmloptslst>>=(return.paragraph)blockToHtml_(RawHtmlstr)=return$primHtmlstrblockToHtml_(HorizontalRule)=return$hrblockToHtmlopts(CodeBlock(id',classes,keyvals)rawCode)=doletclasses'=ifwriterLiterateHaskelloptsthenclasseselsefilter(/="literate")classescasehighlightHtml(id',classes',keyvals)rawCodeofLeft_->-- change leading newlines into <br /> tags, because some-- browsers ignore leading newlines in pre blockslet(leadingBreaks,rawCode')=span(=='\n')rawCodeattrs=[theclass(unwordsclasses')|not(nullclasses')]++[prefixedIdoptsid'|not(nullid')]++map(\(x,y)->strAttrxy)keyvalsaddBird=if"literate"`elem`classes'thenunlines.map("> "++).lineselseunlines.linesinreturn$pre!attrs$thecode<<(replicate(lengthleadingBreaks)br+++[stringToHtml$addBirdrawCode'])Righth->modify(\st->st{stHighlighting=True})>>returnhblockToHtmlopts(BlockQuoteblocks)=-- in S5, treat list in blockquote specially-- if default is incremental, make it nonincremental; -- otherwise incrementalifwriterSlideVariantopts/=NoSlidesthenletinc=not(writerIncrementalopts)incaseblocksof[BulletListlst]->blockToHtml(opts{writerIncremental=inc})(BulletListlst)[OrderedListattribslst]->blockToHtml(opts{writerIncremental=inc})(OrderedListattribslst)_->blockListToHtmloptsblocks>>=(return.blockquote)elseblockListToHtmloptsblocks>>=(return.blockquote)blockToHtmlopts(Headerlevellst)=docontents<-inlineListToHtmloptslstsecnum<-liftMstSecNumgetletcontents'=ifwriterNumberSectionsoptsthen(thespan![theclass"header-section-number"]<<showSecNumsecnum)+++stringToHtml" "+++contentselsecontentsletcontents''=ifwriterTableOfContentsoptsthenanchor![href$"#"++writerIdentifierPrefixopts++"TOC"]$contents'elsecontents'return$caselevelof1->h1contents''2->h2contents''3->h3contents''4->h4contents''5->h5contents''6->h6contents''_->paragraphcontents''blockToHtmlopts(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,defs)->doterm'<-liftM(dterm<<)$inlineListToHtmloptstermdefs'<-mapM(liftM(ddef<<).blockListToHtmlopts)defsreturn$term':defs')lstletattribs=ifwriterIncrementaloptsthen[theclass"incremental"]else[]return$dlist!attribs<<concatcontentsblockToHtmlopts(Tablecaptalignswidthsheadersrows')=doletalignStrings=mapalignmentToStringalignscaptionDoc<-ifnullcaptthenreturnnoHtmlelseinlineListToHtmloptscapt>>=return.captionletpercentw=show(truncate(100*w)::Integer)++"%"letcoltags=ifall(==0.0)widthsthennoHtmlelseconcatHtml$map(\w->col![width$percentw]$noHtml)widthshead'<-ifallnullheadersthenreturnnoHtmlelseliftM(thead<<)$tableRowToHtmloptsalignStrings0headersbody'<-liftM(tbody<<)$zipWithM(tableRowToHtmloptsalignStrings)[1..]rows'return$table$captionDoc+++coltags+++head'+++body'tableRowToHtml::WriterOptions->[String]->Int->[[Block]]->StateWriterStateHtmltableRowToHtmloptsalignStringsrownumcols'=doletmkcell=ifrownum==0thenthelsetdletrowclass=caserownumof0->"header"x|x`rem`2==1->"odd"_->"even"cols''<-sequence$zipWith(\alignmentitem->tableItemToHtmloptsmkcellalignmentitem)alignStringscols'return$tr![theclassrowclass]$toHtmlFromListcols''alignmentToString::Alignment->[Char]alignmentToStringalignment=casealignmentofAlignLeft->"left"AlignRight->"right"AlignCenter->"center"AlignDefault->"left"tableItemToHtml::WriterOptions->(Html->Html)->[Char]->[Block]->StateWriterStateHtmltableItemToHtmloptstag'align'item=docontents<-blockListToHtmloptsitemreturn$tag'![alignalign']$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)->returnbr(EmDash)->return$stringToHtml"—"(EnDash)->return$stringToHtml"–"(Ellipses)->return$stringToHtml"…"(Apostrophe)->return$stringToHtml"’"(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->(stringToHtml"‘",stringToHtml"’")DoubleQuote->(stringToHtml"“",stringToHtml"”")indocontents<-inlineListToHtmloptslstreturn$leftQuote+++contents+++rightQuote(Mathtstr)->modify(\st->st{stMath=True})>>(casewriterHTMLMathMethodoptsofLaTeXMathML_->-- putting LaTeXMathML in container with class "LaTeX" prevents-- non-math elements on the page from being treated as math by-- the javascriptreturn$thespan![theclass"LaTeX"]$casetofInlineMath->primHtml("$"++str++"$")DisplayMath->primHtml("$$"++str++"$$")JsMath_->doletm=primHtmlstrreturn$casetofInlineMath->thespan![theclass"math"]$mDisplayMath->thediv![theclass"math"]$mWebTeXurl->doletm=image![src(url++urlEncodestr),altstr,titlestr]return$casetofInlineMath->mDisplayMath->br+++m+++brGladTeX->return$primHtml$"<EQ>"++str++"</EQ>"MathML_->doletdt=ift==InlineMaththenDisplayInlineelseDisplayBlockletconf=useShortEmptyTags(constFalse)defaultConfigPPcasetexMathToMathMLdtstrofRightr->return$primHtml$ppcElementconfrLeft_->inlineListToHtmlopts(readTeXMathstr)>>=return.(thespan![theclass"math"])PlainMath->dox<-inlineListToHtmlopts(readTeXMathstr)letm=thespan![theclass"math"]$xreturn$casetofInlineMath->mDisplayMath->br+++m+++br)(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$sup<<anchor![href("#"++writerIdentifierPrefixopts++"fn"++ref),theclass"footnoteRef",prefixedIdopts("fnref"++ref)]<<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=\"#"++writerIdentifierPrefixopts++"fnref"++ref++"\" class=\"footnoteBackLink\""++" title=\"Jump back to footnote "++ref++"\">↩</a>"]blocks'=ifnullblocksthen[]elseletlastBlock=lastblocksotherBlocks=initblocksincaselastBlockof(Paralst)->otherBlocks++[Para(lst++backlink)](Plainlst)->otherBlocks++[Plain(lst++backlink)]_->otherBlocks++[lastBlock,Plainbacklink]indocontents<-blockListToHtmloptsblocks'return$li![prefixedIdopts("fn"++ref)]$contents