{-
Copyright (C) 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.Textile
Copyright : Copyright (C) 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 Textile markup.
Textile: <http://thresholdstate.com/articles/4312/the-textile-reference-manual>
-}moduleText.Pandoc.Writers.Textile(writeTextile)whereimportText.Pandoc.DefinitionimportText.Pandoc.SharedimportText.Pandoc.Templates(renderTemplate)importText.Pandoc.XML(escapeStringForXML)importData.List(intercalate)importControl.Monad.StateimportData.Char(isSpace)dataWriterState=WriterState{stNotes::[String]-- Footnotes,stListLevel::[Char]-- String at beginning of list items, e.g. "**",stUseTags::Bool-- True if we should use HTML tags because we're in a complex list}-- | Convert Pandoc to Textile.writeTextile::WriterOptions->Pandoc->StringwriteTextileoptsdocument=evalState(pandocToTextileoptsdocument)(WriterState{stNotes=[],stListLevel=[],stUseTags=False})-- | Return Textile representation of document.pandocToTextile::WriterOptions->Pandoc->StateWriterStateStringpandocToTextileopts(Pandoc_blocks)=dobody<-blockListToTextileoptsblocksnotes<-liftM(unlines.reverse.stNotes)getletmain=body++ifnullnotesthen""else("\n\n"++notes)letcontext=writerVariablesopts++[("body",main)]ifwriterStandaloneoptsthenreturn$renderTemplatecontext$writerTemplateoptselsereturnmainwithUseTags::StateWriterStatea->StateWriterStateawithUseTagsaction=dooldUseTags<-liftMstUseTagsgetmodify$\s->s{stUseTags=True}result<-actionmodify$\s->s{stUseTags=oldUseTags}returnresult-- | Escape one character as needed for Textile.escapeCharForTextile::Char->StringescapeCharForTextilex=casexof'&'->"&amp;"'<'->"&lt;"'>'->"&gt;"'"'->"&quot;"'*'->"&#42;"'_'->"&#95;"'@'->"&#64;"'|'->"&#124;"c->[c]-- | Escape string as needed for Textile.escapeStringForTextile::String->StringescapeStringForTextile=concatMapescapeCharForTextile-- | Convert Pandoc block element to Textile. blockToTextile::WriterOptions-- ^ Options->Block-- ^ Block element->StateWriterStateStringblockToTextile_Null=return""blockToTextileopts(Plaininlines)=inlineListToTextileoptsinlinesblockToTextileopts(Para[Imagetxt(src,tit)])=docapt<-blockToTextileopts(Paratxt)im<-inlineToTextileopts(Imagetxt(src,tit))return$im++"\n"++captblockToTextileopts(Parainlines)=douseTags<-liftMstUseTagsgetlistLevel<-liftMstListLevelgetcontents<-inlineListToTextileoptsinlinesreturn$ifuseTagsthen"<p>"++contents++"</p>"elsecontents++ifnulllistLevelthen"\n"else""blockToTextile_(RawBlockfstr)=iff=="html"||f=="textile"thenreturnstrelsereturn""blockToTextile_HorizontalRule=return"<hr />\n"blockToTextileopts(Headerlevelinlines)=docontents<-inlineListToTextileoptsinlinesletprefix='h':(showlevel++". ")return$prefix++contents++"\n"blockToTextile_(CodeBlock(_,classes,_)str)|any(allisSpace)(linesstr)=return$"<pre"++classes'++">\n"++escapeStringForXMLstr++"\n</pre>\n"whereclasses'=ifnullclassesthen""else" class=\""++unwordsclasses++"\""blockToTextile_(CodeBlock(_,classes,_)str)=return$"bc"++classes'++". "++str++"\n\n"whereclasses'=ifnullclassesthen""else"("++unwordsclasses++")"blockToTextileopts(BlockQuotebs@[Para_])=docontents<-blockListToTextileoptsbsreturn$"bq. "++contents++"\n\n"blockToTextileopts(BlockQuoteblocks)=docontents<-blockListToTextileoptsblocksreturn$"<blockquote>\n\n"++contents++"\n</blockquote>\n"blockToTextileopts(Table[]alignswidthsheadersrows')|all(==0)widths&&all(`elem`[AlignLeft,AlignDefault])aligns=dohs<-mapM(liftM(("_. "++).stripTrailingNewlines).blockListToTextileopts)headersletcellsToRowcells="|"++intercalate"|"cells++"|"letheader=ifallnullheadersthen""elsecellsToRowhsletrowToCells=mapM(liftMstripTrailingNewlines.blockListToTextileopts)bs<-mapMrowToCellsrows'letbody=unlines$mapcellsToRowbsreturn$header++"\n"++body++"\n"blockToTextileopts(Tablecaptalignswidthsheadersrows')=doletalignStrings=mapalignmentToStringalignscaptionDoc<-ifnullcaptthenreturn""elsedoc<-inlineListToTextileoptscaptreturn$"<caption>"++c++"</caption>\n"letpercentw=show(truncate(100*w)::Integer)++"%"letcoltags=ifall(==0.0)widthsthen""elseunlines$map(\w->"<col width=\""++percentw++"\" />")widthshead'<-ifallnullheadersthenreturn""elsedohs<-tableRowToTextileoptsalignStrings0headersreturn$"<thead>\n"++hs++"\n</thead>\n"body'<-zipWithM(tableRowToTextileoptsalignStrings)[1..]rows'return$"<table>\n"++captionDoc++coltags++head'++"<tbody>\n"++unlinesbody'++"</tbody>\n</table>\n"blockToTextileoptsx@(BulletListitems)=dooldUseTags<-liftMstUseTagsgetletuseTags=oldUseTags||not(isSimpleListx)ifuseTagsthendocontents<-withUseTags$mapM(listItemToTextileopts)itemsreturn$"<ul>\n"++vcatcontents++"\n</ul>\n"elsedomodify$\s->s{stListLevel=stListLevels++"*"}level<-get>>=return.length.stListLevelcontents<-mapM(listItemToTextileopts)itemsmodify$\s->s{stListLevel=init(stListLevels)}return$vcatcontents++(iflevel>1then""else"\n")blockToTextileoptsx@(OrderedListattribsitems)=dooldUseTags<-liftMstUseTagsgetletuseTags=oldUseTags||not(isSimpleListx)ifuseTagsthendocontents<-withUseTags$mapM(listItemToTextileopts)itemsreturn$"<ol"++listAttribsToStringattribs++">\n"++vcatcontents++"\n</ol>\n"elsedomodify$\s->s{stListLevel=stListLevels++"#"}level<-get>>=return.length.stListLevelcontents<-mapM(listItemToTextileopts)itemsmodify$\s->s{stListLevel=init(stListLevels)}return$vcatcontents++(iflevel>1then""else"\n")blockToTextileopts(DefinitionListitems)=docontents<-withUseTags$mapM(definitionListItemToTextileopts)itemsreturn$"<dl>\n"++vcatcontents++"\n</dl>\n"-- Auxiliary functions for lists:-- | Convert ordered list attributes to HTML attribute stringlistAttribsToString::ListAttributes->StringlistAttribsToString(startnum,numstyle,_)=letnumstyle'=camelCaseToHyphenated$shownumstylein(ifstartnum/=1then" start=\""++showstartnum++"\""else"")++(ifnumstyle/=DefaultStylethen" style=\"list-style-type: "++numstyle'++";\""else"")-- | Convert bullet or ordered list item (list of blocks) to Textile.listItemToTextile::WriterOptions->[Block]->StateWriterStateStringlistItemToTextileoptsitems=docontents<-blockListToTextileoptsitemsuseTags<-get>>=return.stUseTagsifuseTagsthenreturn$"<li>"++contents++"</li>"elsedomarker<-get>>=return.stListLevelreturn$marker++" "++contents-- | Convert definition list item (label, list of blocks) to Textile.definitionListItemToTextile::WriterOptions->([Inline],[[Block]])->StateWriterStateStringdefinitionListItemToTextileopts(label,items)=dolabelText<-inlineListToTextileoptslabelcontents<-mapM(blockListToTextileopts)itemsreturn$"<dt>"++labelText++"</dt>\n"++(intercalate"\n"$map(\d->"<dd>"++d++"</dd>")contents)-- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed.isSimpleList::Block->BoolisSimpleListx=casexofBulletListitems->allisSimpleListItemitemsOrderedList(num,sty,_)items->allisSimpleListItemitems&&num==1&&sty`elem`[DefaultStyle,Decimal]_->False-- | True if list item can be handled with the simple wiki syntax. False if-- HTML tags will be needed.isSimpleListItem::[Block]->BoolisSimpleListItem[]=TrueisSimpleListItem[x]=casexofPlain_->TruePara_->TrueBulletList_->isSimpleListxOrderedList__->isSimpleListx_->FalseisSimpleListItem[x,y]|isPlainOrParax=caseyofBulletList_->isSimpleListyOrderedList__->isSimpleListy_->FalseisSimpleListItem_=FalseisPlainOrPara::Block->BoolisPlainOrPara(Plain_)=TrueisPlainOrPara(Para_)=TrueisPlainOrPara_=False-- | Concatenates strings with line breaks between them.vcat::[String]->Stringvcat=intercalate"\n"-- Auxiliary functions for tables. (TODO: these are common to HTML, MediaWiki,-- and Textile writers, and should be abstracted out.)tableRowToTextile::WriterOptions->[String]->Int->[[Block]]->StateWriterStateStringtableRowToTextileoptsalignStringsrownumcols'=doletcelltype=ifrownum==0then"th"else"td"letrowclass=caserownumof0->"header"x|x`rem`2==1->"odd"_->"even"cols''<-sequence$zipWith(\alignmentitem->tableItemToTextileoptscelltypealignmentitem)alignStringscols'return$"<tr class=\""++rowclass++"\">\n"++unlinescols''++"</tr>"alignmentToString::Alignment->[Char]alignmentToStringalignment=casealignmentofAlignLeft->"left"AlignRight->"right"AlignCenter->"center"AlignDefault->"left"tableItemToTextile::WriterOptions->String->String->[Block]->StateWriterStateStringtableItemToTextileoptscelltypealign'item=doletmkcellx="<"++celltype++" align=\""++align'++"\">"++x++"</"++celltype++">"contents<-blockListToTextileoptsitemreturn$mkcellcontents-- | Convert list of Pandoc block elements to Textile.blockListToTextile::WriterOptions-- ^ Options->[Block]-- ^ List of block elements->StateWriterStateStringblockListToTextileoptsblocks=mapM(blockToTextileopts)blocks>>=return.vcat-- | Convert list of Pandoc inline elements to Textile.inlineListToTextile::WriterOptions->[Inline]->StateWriterStateStringinlineListToTextileoptslst=mapM(inlineToTextileopts)lst>>=return.concat-- | Convert Pandoc inline element to Textile.inlineToTextile::WriterOptions->Inline->StateWriterStateStringinlineToTextileopts(Emphlst)=docontents<-inlineListToTextileoptslstreturn$if'_'`elem`contentsthen"<em>"++contents++"</em>"else"_"++contents++"_"inlineToTextileopts(Stronglst)=docontents<-inlineListToTextileoptslstreturn$if'*'`elem`contentsthen"<strong>"++contents++"</strong>"else"*"++contents++"*"inlineToTextileopts(Strikeoutlst)=docontents<-inlineListToTextileoptslstreturn$if'-'`elem`contentsthen"<del>"++contents++"</del>"else"-"++contents++"-"inlineToTextileopts(Superscriptlst)=docontents<-inlineListToTextileoptslstreturn$if'^'`elem`contentsthen"<sup>"++contents++"</sup>"else"[^"++contents++"^]"inlineToTextileopts(Subscriptlst)=docontents<-inlineListToTextileoptslstreturn$if'~'`elem`contentsthen"<sub>"++contents++"</sub>"else"[~"++contents++"~]"inlineToTextileopts(SmallCapslst)=inlineListToTextileoptslstinlineToTextileopts(QuotedSingleQuotelst)=docontents<-inlineListToTextileoptslstreturn$"'"++contents++"'"inlineToTextileopts(QuotedDoubleQuotelst)=docontents<-inlineListToTextileoptslstreturn$"\""++contents++"\""inlineToTextileopts(Cite_lst)=inlineListToTextileoptslstinlineToTextile_EmDash=return" -- "inlineToTextile_EnDash=return" - "inlineToTextile_Apostrophe=return"'"inlineToTextile_Ellipses=return"..."inlineToTextile_(Code_str)=return$if'@'`elem`strthen"<tt>"++escapeStringForXMLstr++"</tt>"else"@"++str++"@"inlineToTextile_(Strstr)=return$escapeStringForTextilestrinlineToTextile_(Math_str)=return$"<span class=\"math\">"++escapeStringForXMLstr++"</math>"inlineToTextile_(RawInlinefstr)=iff=="html"||f=="textile"thenreturnstrelsereturn""inlineToTextile_(LineBreak)=return"\n"inlineToTextile_Space=return" "inlineToTextileopts(Linktxt(src,_))=dolabel<-casetxtof[Code_s]->returns_->inlineListToTextileoptstxtreturn$"\""++label++"\":"++srcinlineToTextileopts(Imagealt(source,tit))=doalt'<-inlineListToTextileoptsaltlettxt=ifnulltitthenifnullalt'then""else"("++alt'++")"else"("++tit++")"return$"!"++source++txt++"!"inlineToTextileopts(Notecontents)=docurNotes<-liftMstNotesgetletnewnum=lengthcurNotes+1contents'<-blockListToTextileoptscontentsletthisnote="fn"++shownewnum++". "++contents'++"\n"modify$\s->s{stNotes=thisnote:curNotes}return$"["++shownewnum++"]"-- note - may not work for notes with multiple blocks