{-# LANGUAGE DeriveDataTypeable #-}{-
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.Shared
Copyright : Copyright (C) 2006-8 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Utility functions and definitions used by the various Pandoc modules.
-}moduleText.Pandoc.Shared(-- * List processingsplitBy,splitByIndices,substitute,-- * Text processingbackslashEscapes,escapeStringUsing,stripTrailingNewlines,removeLeadingTrailingSpace,removeLeadingSpace,removeTrailingSpace,stripFirstAndLast,camelCaseToHyphenated,toRomanNumeral,wrapped,wrapIfNeeded,wrappedTeX,wrapTeXIfNeeded,BlockWrapper(..),wrappedBlocksToDoc,tabFilter,-- * Parsing(>>~),anyLine,many1Till,notFollowedBy',oneOfStrings,spaceChar,skipSpaces,blankline,blanklines,enclosed,stringAnyCase,parseFromString,lineClump,charsInBalanced,charsInBalanced',romanNumeral,emailAddress,uri,withHorizDisplacement,nullBlock,failIfStrict,failUnlessLHS,escaped,anyOrderedListMarker,orderedListMarker,charRef,readWith,testStringWith,ParserState(..),defaultParserState,HeaderType(..),ParserContext(..),QuoteContext(..),NoteTable,KeyTable,lookupKeySrc,refsMatch,-- * Prettyprintinghang',prettyPandoc,-- * Pandoc block and inline list processingorderedListMarkers,normalizeSpaces,compactify,Element(..),hierarchicalize,uniqueIdent,isHeaderBlock,-- * Writer optionsHTMLMathMethod(..),ObfuscationMethod(..),WriterOptions(..),defaultWriterOptions,-- * File handlinginDirectory,readDataFile)whereimportText.Pandoc.DefinitionimportText.ParserCombinators.ParsecimportText.PrettyPrint.HughesPJ(Doc,fsep,($$),(<>),empty,isEmpty,text,nest)importqualifiedText.PrettyPrint.HughesPJasPPimportText.Pandoc.CharacterReferences(characterReference)importData.Char(toLower,toUpper,ord,isLower,isUpper,isAlpha,isPunctuation)importData.List(find,isPrefixOf,intercalate)importNetwork.URI(parseURI,URI(..),isAllowedInURI)importSystem.DirectoryimportSystem.FilePath((</>))-- Note: ghc >= 6.12 (base >=4.2) supports unicode through iconv-- So we use System.IO.UTF8 only if we have an earlier version#if MIN_VERSION_base(4,2,0)#elseimportPreludehiding(putStr,putStrLn,writeFile,readFile,getContents)importSystem.IO.UTF8#endifimportData.GenericsimportqualifiedControl.Monad.StateasSimportControl.Monad(join)importPaths_pandoc(getDataFileName)---- List processing---- | Split list by groups of one or more sep.splitBy::(Eqa)=>a->[a]->[[a]]splitBy_[]=[]splitByseplst=let(first,rest)=break(==sep)lstrest'=dropWhile(==sep)restinfirst:(splitByseprest')-- | Split list into chunks divided at specified indices.splitByIndices::[Int]->[a]->[[a]]splitByIndices[]lst=[lst]splitByIndices(x:xs)lst=let(first,rest)=splitAtxlstinfirst:(splitByIndices(map(\y->y-x)xs)rest)-- | Replace each occurrence of one sublist in a list with another.substitute::(Eqa)=>[a]->[a]->[a]->[a]substitute__[]=[]substitute[]_lst=lstsubstitutetargetreplacementlst=iftarget`isPrefixOf`lstthenreplacement++(substitutetargetreplacement$drop(lengthtarget)lst)else(headlst):(substitutetargetreplacement$taillst)---- Text processing---- | Returns an association list of backslash escapes for the-- designated characters.backslashEscapes::[Char]-- ^ list of special characters to escape->[(Char,String)]backslashEscapes=map(\ch->(ch,['\\',ch]))-- | Escape a string of characters, using an association list of-- characters and strings.escapeStringUsing::[(Char,String)]->String->StringescapeStringUsing_[]=""escapeStringUsingescapeTable(x:xs)=case(lookupxescapeTable)ofJuststr->str++restNothing->x:restwhererest=escapeStringUsingescapeTablexs-- | Strip trailing newlines from string.stripTrailingNewlines::String->StringstripTrailingNewlines=reverse.dropWhile(=='\n').reverse-- | Remove leading and trailing space (including newlines) from string.removeLeadingTrailingSpace::String->StringremoveLeadingTrailingSpace=removeLeadingSpace.removeTrailingSpace-- | Remove leading space (including newlines) from string.removeLeadingSpace::String->StringremoveLeadingSpace=dropWhile(`elem`" \n\t")-- | Remove trailing space (including newlines) from string.removeTrailingSpace::String->StringremoveTrailingSpace=reverse.removeLeadingSpace.reverse-- | Strip leading and trailing characters from stringstripFirstAndLast::String->StringstripFirstAndLaststr=drop1$take((lengthstr)-1)str-- | Change CamelCase word to hyphenated lowercase (e.g., camel-case). camelCaseToHyphenated::String->StringcamelCaseToHyphenated[]=""camelCaseToHyphenated(a:b:rest)|isLowera&&isUpperb=a:'-':(toLowerb):(camelCaseToHyphenatedrest)camelCaseToHyphenated(a:rest)=(toLowera):(camelCaseToHyphenatedrest)-- | Convert number < 4000 to uppercase roman numeral.toRomanNumeral::Int->StringtoRomanNumeralx=ifx>=4000||x<0then"?"elsecasexof_|x>=1000->"M"++toRomanNumeral(x-1000)_|x>=900->"CM"++toRomanNumeral(x-900)_|x>=500->"D"++toRomanNumeral(x-500)_|x>=400->"CD"++toRomanNumeral(x-400)_|x>=100->"C"++toRomanNumeral(x-100)_|x>=90->"XC"++toRomanNumeral(x-90)_|x>=50->"L"++toRomanNumeral(x-50)_|x>=40->"XL"++toRomanNumeral(x-40)_|x>=10->"X"++toRomanNumeral(x-10)_|x>=9->"IX"++toRomanNumeral(x-5)_|x>=5->"V"++toRomanNumeral(x-5)_|x>=4->"IV"++toRomanNumeral(x-4)_|x>=1->"I"++toRomanNumeral(x-1)_->""-- | Wrap inlines to line length.wrapped::Monadm=>([Inline]->mDoc)->[Inline]->mDocwrappedlistWritersect=(mapMlistWriter$splitBySpacesect)>>=return.fsep-- | Wrap inlines if the text wrap option is selected.wrapIfNeeded::Monadm=>WriterOptions->([Inline]->mDoc)->[Inline]->mDocwrapIfNeededopts=ifwriterWrapTextoptsthenwrappedelse($)-- auxiliary function for wrappedTeXisNote::Inline->BoolisNote(Note_)=TrueisNote_=False-- | Wrap inlines to line length, treating footnotes in a way that-- makes sense in LaTeX and ConTeXt.wrappedTeX::Monadm=>Bool->([Inline]->mDoc)->[Inline]->mDocwrappedTeXincludePercentlistWritersect=dolet(firstpart,rest)=breakisNotesectfirstpartWrapped<-wrappedlistWriterfirstpartifnullrestthenreturnfirstpartWrappedelsedolet(note:rest')=restlet(rest1,rest2)=break(==Space)rest'-- rest1 is whatever comes between the note and a Space.-- if the note is followed directly by a Space, rest1 is null.-- rest1 is printed after the note but before the line break,-- to avoid spurious blank space the note and immediately-- following punctuation.rest1Out<-ifnullrest1thenreturnemptyelselistWriterrest1rest2Wrapped<-ifnullrest2thenreturnemptyelsewrappedTeXincludePercentlistWriter(tailrest2)noteText<-listWriter[note]return$(firstpartWrapped<>ifincludePercentthenPP.char'%'elseempty)$$(noteText<>rest1Out)$$rest2Wrapped-- | Wrap inlines if the text wrap option is selected, specialized -- for LaTeX and ConTeXt.wrapTeXIfNeeded::Monadm=>WriterOptions->Bool->([Inline]->mDoc)->[Inline]->mDocwrapTeXIfNeededoptsincludePercent=ifwriterWrapTextoptsthenwrappedTeXincludePercentelse($)-- | Indicates whether block should be surrounded by blank lines (@Pad@) or not (@Reg@).dataBlockWrapper=PadDoc|RegDoc-- | Converts a list of wrapped blocks to a Doc, with appropriate spaces around blocks.wrappedBlocksToDoc::[BlockWrapper]->DocwrappedBlocksToDoc=foldraddBlockemptywhereaddBlock(Padd)accum|isEmptyaccum=daddBlock(Padd)accum=d$$text""$$accumaddBlock(Regd)accum=d$$accum-- | Convert tabs to spaces and filter out DOS line endings.-- Tabs will be preserved if tab stop is set to 0.tabFilter::Int-- ^ Tab stop->String-- ^ Input->StringtabFiltertabStop=letgo_[]=""go_('\n':xs)='\n':gotabStopxsgo_('\r':'\n':xs)='\n':gotabStopxsgo_('\r':xs)='\n':gotabStopxsgospsToNextStop('\t':xs)=iftabStop==0then'\t':gotabStopxselsereplicatespsToNextStop' '++gotabStopxsgo1(x:xs)=x:gotabStopxsgospsToNextStop(x:xs)=x:go(spsToNextStop-1)xsingotabStop---- Parsing---- | Like >>, but returns the operation on the left.-- (Suggested by Tillmann Rendel on Haskell-cafe list.)(>>~)::(Monadm)=>ma->mb->maa>>~b=a>>=\x->b>>returnx-- | Parse any line of textanyLine::GenParserCharst[Char]anyLine=manyTillanyCharnewline-- | Like @manyTill@, but reads at least one item.many1Till::GenParsertoksta->GenParsertokstend->GenParsertokst[a]many1Tillpend=dofirst<-prest<-manyTillpendreturn(first:rest)-- | A more general form of @notFollowedBy@. This one allows any -- type of parser to be specified, and succeeds only if that parser fails.-- It does not consume any input.notFollowedBy'::Showb=>GenParserastb->GenParserast()notFollowedBy'p=try$join$doa<-trypreturn(unexpected(showa))<|>return(return())-- (This version due to Andrew Pimlott on the Haskell mailing list.)-- | Parses one of a list of strings (tried in order). oneOfStrings::[String]->GenParserCharstStringoneOfStringslistOfStrings=choice$map(try.string)listOfStrings-- | Parses a space or tab.spaceChar::CharParserstCharspaceChar=char' '<|>char'\t'-- | Skips zero or more spaces or tabs.skipSpaces::GenParserCharst()skipSpaces=skipManyspaceChar-- | Skips zero or more spaces or tabs, then reads a newline.blankline::GenParserCharstCharblankline=try$skipSpaces>>newline-- | Parses one or more blank lines and returns a string of newlines.blanklines::GenParserCharst[Char]blanklines=many1blankline-- | Parses material enclosed between start and end parsers.enclosed::GenParserCharstt-- ^ start parser->GenParserCharstend-- ^ end parser->GenParserCharsta-- ^ content parser (to be used repeatedly)->GenParserCharst[a]enclosedstartendparser=try$start>>notFollowedByspace>>many1Tillparserend-- | Parse string, case insensitive.stringAnyCase::[Char]->CharParserstStringstringAnyCase[]=string""stringAnyCase(x:xs)=dofirstChar<-char(toUpperx)<|>char(toLowerx)rest<-stringAnyCasexsreturn(firstChar:rest)-- | Parse contents of 'str' using 'parser' and return result.parseFromString::GenParsertoksta->[tok]->GenParsertokstaparseFromStringparserstr=dooldPos<-getPositionoldInput<-getInputsetInputstrresult<-parsersetInputoldInputsetPositionoldPosreturnresult-- | Parse raw line block up to and including blank lines.lineClump::GenParserCharstStringlineClump=blanklines<|>(many1(notFollowedByblankline>>anyLine)>>=return.unlines)-- | Parse a string of characters between an open character-- and a close character, including text between balanced-- pairs of open and close, which must be different. For example,-- @charsInBalanced '(' ')'@ will parse "(hello (there))"-- and return "hello (there)". Stop if a blank line is-- encountered.charsInBalanced::Char->Char->GenParserCharstStringcharsInBalancedopenclose=try$docharopenraw<-many$(many1(noneOf[open,close,'\n']))<|>(dores<-charsInBalancedopenclosereturn$[open]++res++[close])<|>try(string"\n">>~notFollowedBy'blanklines)charclosereturn$concatraw-- | Like @charsInBalanced@, but allow blank lines in the content.charsInBalanced'::Char->Char->GenParserCharstStringcharsInBalanced'openclose=try$docharopenraw<-many$(many1(noneOf[open,close]))<|>(dores<-charsInBalanced'openclosereturn$[open]++res++[close])charclosereturn$concatraw-- Auxiliary functions for romanNumeral:lowercaseRomanDigits::[Char]lowercaseRomanDigits=['i','v','x','l','c','d','m']uppercaseRomanDigits::[Char]uppercaseRomanDigits=maptoUpperlowercaseRomanDigits-- | Parses a roman numeral (uppercase or lowercase), returns number.romanNumeral::Bool-- ^ Uppercase if true->GenParserCharstIntromanNumeralupperCase=doletromanDigits=ifupperCasethenuppercaseRomanDigitselselowercaseRomanDigitslookAhead$oneOfromanDigitslet[one,five,ten,fifty,hundred,fivehundred,thousand]=mapcharromanDigitsthousands<-manythousand>>=(return.(1000*).length)ninehundreds<-option0$try$hundred>>thousand>>return900fivehundreds<-manyfivehundred>>=(return.(500*).length)fourhundreds<-option0$try$hundred>>fivehundred>>return400hundreds<-manyhundred>>=(return.(100*).length)nineties<-option0$try$ten>>hundred>>return90fifties<-manyfifty>>=(return.(50*).length)forties<-option0$try$ten>>fifty>>return40tens<-manyten>>=(return.(10*).length)nines<-option0$try$one>>ten>>return9fives<-manyfive>>=(return.(5*).length)fours<-option0$try$one>>five>>return4ones<-manyone>>=(return.length)lettotal=thousands+ninehundreds+fivehundreds+fourhundreds+hundreds+nineties+fifties+forties+tens+nines+fives+fours+onesiftotal==0thenfail"not a roman numeral"elsereturntotal-- Parsers for email addresses and URIsemailChar::GenParserCharstCharemailChar=alphaNum<|>oneOf"-+_."domainChar::GenParserCharstChardomainChar=alphaNum<|>char'-'domain::GenParserCharst[Char]domain=dofirst<-many1domainChardom<-many1$try(char'.'>>many1domainChar)return$intercalate"."(first:dom)-- | Parses an email address; returns string.emailAddress::GenParserCharst[Char]emailAddress=try$dofirstLetter<-alphaNumrestAddr<-manyemailCharletaddr=firstLetter:restAddrchar'@'dom<-domainreturn$addr++'@':dom-- | Parses a URI.uri::GenParserCharstStringuri=try$dostr<-many1$satisfyisAllowedInURIcaseparseURIstrofJusturi'->ifuriSchemeuri'`elem`["http:","https:","ftp:","file:","mailto:","news:","telnet:"]thenreturn$showuri'elsefail"not a URI"Nothing->fail"not a URI"-- | Applies a parser, returns tuple of its results and its horizontal-- displacement (the difference between the source column at the end-- and the source column at the beginning). Vertical displacement-- (source row) is ignored.withHorizDisplacement::GenParserCharsta-- ^ Parser to apply->GenParserCharst(a,Int)-- ^ (result, displacement)withHorizDisplacementparser=dopos1<-getPositionresult<-parserpos2<-getPositionreturn(result,sourceColumnpos2-sourceColumnpos1)-- | Parses a character and returns 'Null' (so that the parser can move on-- if it gets stuck).nullBlock::GenParserCharstBlocknullBlock=anyChar>>returnNull-- | Fail if reader is in strict markdown syntax mode.failIfStrict::GenParserCharParserState()failIfStrict=dostate<-getStateifstateStrictstatethenfail"strict mode"elsereturn()-- | Fail unless we're in literate haskell mode.failUnlessLHS::GenParsertokParserState()failUnlessLHS=dostate<-getStateifstateLiterateHaskellstatethenreturn()elsefail"Literate haskell feature"-- | Parses backslash, then applies character parser.escaped::GenParserCharstChar-- ^ Parser for character to escape->GenParserCharstInlineescapedparser=try$dochar'\\'result<-parserreturn(Str[result])-- | Parses an uppercase roman numeral and returns (UpperRoman, number).upperRoman::GenParserCharst(ListNumberStyle,Int)upperRoman=donum<-romanNumeralTruereturn(UpperRoman,num)-- | Parses a lowercase roman numeral and returns (LowerRoman, number).lowerRoman::GenParserCharst(ListNumberStyle,Int)lowerRoman=donum<-romanNumeralFalsereturn(LowerRoman,num)-- | Parses a decimal numeral and returns (Decimal, number).decimal::GenParserCharst(ListNumberStyle,Int)decimal=donum<-many1digitreturn(Decimal,readnum)-- | Parses a '#' returns (DefaultStyle, 1).defaultNum::GenParserCharst(ListNumberStyle,Int)defaultNum=dochar'#'return(DefaultStyle,1)-- | Parses a lowercase letter and returns (LowerAlpha, number).lowerAlpha::GenParserCharst(ListNumberStyle,Int)lowerAlpha=doch<-oneOf['a'..'z']return(LowerAlpha,ordch-ord'a'+1)-- | Parses an uppercase letter and returns (UpperAlpha, number).upperAlpha::GenParserCharst(ListNumberStyle,Int)upperAlpha=doch<-oneOf['A'..'Z']return(UpperAlpha,ordch-ord'A'+1)-- | Parses a roman numeral i or IromanOne::GenParserCharst(ListNumberStyle,Int)romanOne=(char'i'>>return(LowerRoman,1))<|>(char'I'>>return(UpperRoman,1))-- | Parses an ordered list marker and returns list attributes.anyOrderedListMarker::GenParserCharstListAttributesanyOrderedListMarker=choice$[delimParsernumParser|delimParser<-[inPeriod,inOneParen,inTwoParens],numParser<-[decimal,defaultNum,romanOne,lowerAlpha,lowerRoman,upperAlpha,upperRoman]]-- | Parses a list number (num) followed by a period, returns list attributes.inPeriod::GenParserCharst(ListNumberStyle,Int)->GenParserCharstListAttributesinPeriodnum=try$do(style,start)<-numchar'.'letdelim=ifstyle==DefaultStylethenDefaultDelimelsePeriodreturn(start,style,delim)-- | Parses a list number (num) followed by a paren, returns list attributes.inOneParen::GenParserCharst(ListNumberStyle,Int)->GenParserCharstListAttributesinOneParennum=try$do(style,start)<-numchar')'return(start,style,OneParen)-- | Parses a list number (num) enclosed in parens, returns list attributes.inTwoParens::GenParserCharst(ListNumberStyle,Int)->GenParserCharstListAttributesinTwoParensnum=try$dochar'('(style,start)<-numchar')'return(start,style,TwoParens)-- | Parses an ordered list marker with a given style and delimiter,-- returns number.orderedListMarker::ListNumberStyle->ListNumberDelim->GenParserCharstIntorderedListMarkerstyledelim=doletnum=defaultNum<|>-- # can continue any kind of listcasestyleofDefaultStyle->decimalDecimal->decimalUpperRoman->upperRomanLowerRoman->lowerRomanUpperAlpha->upperAlphaLowerAlpha->lowerAlphaletcontext=casedelimofDefaultDelim->inPeriodPeriod->inPeriodOneParen->inOneParenTwoParens->inTwoParens(start,_,_)<-contextnumreturnstart-- | Parses a character reference and returns a Str element.charRef::GenParserCharstInlinecharRef=doc<-characterReferencereturn$Str[c]-- | Parse a string with a given parser and state.readWith::GenParserCharParserStatea-- ^ parser->ParserState-- ^ initial state->String-- ^ input string->areadWithparserstateinput=caserunParserparserstate"source"inputofLefterr->error$"\nError:\n"++showerrRightresult->result-- | Parse a string with @parser@ (for testing).testStringWith::(Showa)=>GenParserCharParserStatea->String->IO()testStringWithparserstr=putStrLn$show$readWithparserdefaultParserStatestr-- | Parsing options.dataParserState=ParserState{stateParseRaw::Bool,-- ^ Parse raw HTML and LaTeX?stateParserContext::ParserContext,-- ^ Inside list?stateQuoteContext::QuoteContext,-- ^ Inside quoted environment?stateSanitizeHTML::Bool,-- ^ Sanitize HTML?stateKeys::KeyTable,-- ^ List of reference keys#ifdef _CITEPROCstateCitations::[String],-- ^ List of available citations#endifstateNotes::NoteTable,-- ^ List of notesstateTabStop::Int,-- ^ Tab stopstateStandalone::Bool,-- ^ Parse bibliographic info?stateTitle::[Inline],-- ^ Title of documentstateAuthors::[[Inline]],-- ^ Authors of documentstateDate::[Inline],-- ^ Date of documentstateStrict::Bool,-- ^ Use strict markdown syntax?stateSmart::Bool,-- ^ Use smart typography?stateLiterateHaskell::Bool,-- ^ Treat input as literate haskellstateColumns::Int,-- ^ Number of columns in terminalstateHeaderTable::[HeaderType],-- ^ Ordered list of header types usedstateIndentedCodeClasses::[String]-- ^ Classes to use for indented code blocks}derivingShowdefaultParserState::ParserStatedefaultParserState=ParserState{stateParseRaw=False,stateParserContext=NullState,stateQuoteContext=NoQuote,stateSanitizeHTML=False,stateKeys=[],#ifdef _CITEPROCstateCitations=[],#endifstateNotes=[],stateTabStop=4,stateStandalone=False,stateTitle=[],stateAuthors=[],stateDate=[],stateStrict=False,stateSmart=False,stateLiterateHaskell=False,stateColumns=80,stateHeaderTable=[],stateIndentedCodeClasses=[]}dataHeaderType=SingleHeaderChar-- ^ Single line of characters underneath|DoubleHeaderChar-- ^ Lines of characters above and belowderiving(Eq,Show)dataParserContext=ListItemState-- ^ Used when running parser on list item contents|NullState-- ^ Default statederiving(Eq,Show)dataQuoteContext=InSingleQuote-- ^ Used when parsing inside single quotes|InDoubleQuote-- ^ Used when parsing inside double quotes|NoQuote-- ^ Used when not parsing inside quotesderiving(Eq,Show)typeNoteTable=[(String,String)]typeKeyTable=[([Inline],Target)]-- | Look up key in key table and return target object.lookupKeySrc::KeyTable-- ^ Key table->[Inline]-- ^ Key->MaybeTargetlookupKeySrctablekey=casefind(refsMatchkey.fst)tableofNothing->NothingJust(_,src)->Justsrc-- | Returns @True@ if keys match (case insensitive).refsMatch::[Inline]->[Inline]->BoolrefsMatch((Strx):restx)((Stry):resty)=((maptoLowerx)==(maptoLowery))&&refsMatchrestxrestyrefsMatch((Emphx):restx)((Emphy):resty)=refsMatchxy&&refsMatchrestxrestyrefsMatch((Strongx):restx)((Strongy):resty)=refsMatchxy&&refsMatchrestxrestyrefsMatch((Strikeoutx):restx)((Strikeouty):resty)=refsMatchxy&&refsMatchrestxrestyrefsMatch((Superscriptx):restx)((Superscripty):resty)=refsMatchxy&&refsMatchrestxrestyrefsMatch((Subscriptx):restx)((Subscripty):resty)=refsMatchxy&&refsMatchrestxrestyrefsMatch((SmallCapsx):restx)((SmallCapsy):resty)=refsMatchxy&&refsMatchrestxrestyrefsMatch((Quotedtx):restx)((Quoteduy):resty)=t==u&&refsMatchxy&&refsMatchrestxrestyrefsMatch((Codex):restx)((Codey):resty)=((maptoLowerx)==(maptoLowery))&&refsMatchrestxrestyrefsMatch((Mathtx):restx)((Mathuy):resty)=((maptoLowerx)==(maptoLowery))&&t==u&&refsMatchrestxrestyrefsMatch((TeXx):restx)((TeXy):resty)=((maptoLowerx)==(maptoLowery))&&refsMatchrestxrestyrefsMatch((HtmlInlinex):restx)((HtmlInliney):resty)=((maptoLowerx)==(maptoLowery))&&refsMatchrestxrestyrefsMatch(x:restx)(y:resty)=(x==y)&&refsMatchrestxrestyrefsMatch[]x=nullxrefsMatchx[]=nullx---- Prettyprinting---- | A version of hang that works like the version in pretty-1.0.0.0hang'::Doc->Int->Doc->Dochang'd1nd2=d1$$(nestnd2)-- | Indent string as a block.indentBy::Int-- ^ Number of spaces to indent the block ->Int-- ^ Number of spaces (rel to block) to indent first line->String-- ^ Contents of block to indent->StringindentBy__[]=""indentBynumfirststr=let(firstLine:restLines)=linesstrfirstLineIndent=num+firstin(replicatefirstLineIndent' ')++firstLine++"\n"++(intercalate"\n"$map((replicatenum' ')++)restLines)-- | Prettyprint list of Pandoc blocks elements.prettyBlockList::Int-- ^ Number of spaces to indent list of blocks->[Block]-- ^ List of blocks->StringprettyBlockListindent[]=indentByindent0"[]"prettyBlockListindentblocks=indentByindent(-2)$"[ "++(intercalate"\n, "(mapprettyBlockblocks))++" ]"-- | Prettyprint Pandoc block element.prettyBlock::Block->StringprettyBlock(BlockQuoteblocks)="BlockQuote\n "++(prettyBlockList2blocks)prettyBlock(OrderedListattribsblockLists)="OrderedList "++showattribs++"\n"++indentBy20("[ "++(intercalate", "$map(\blocks->prettyBlockList2blocks)blockLists))++" ]"prettyBlock(BulletListblockLists)="BulletList\n"++indentBy20("[ "++(intercalate", "(map(\blocks->prettyBlockList2blocks)blockLists)))++" ]"prettyBlock(DefinitionListitems)="DefinitionList\n"++indentBy20("[ "++(intercalate"\n, "(map(\(term,defs)->"("++showterm++",\n"++indentBy30("[ "++(intercalate", "(map(\blocks->prettyBlockList2blocks)defs))++"]")++")")items)))++" ]"prettyBlock(Tablecaptionalignswidthsheaderrows)="Table "++showcaption++" "++showaligns++" "++showwidths++"\n"++prettyRowheader++" [\n"++(intercalate",\n"(mapprettyRowrows))++" ]"whereprettyRowcols=indentBy20("[ "++(intercalate", "(map(\blocks->prettyBlockList2blocks)cols)))++" ]"prettyBlockblock=showblock-- | Prettyprint Pandoc document.prettyPandoc::Pandoc->StringprettyPandoc(Pandocmetablocks)="Pandoc "++"("++showmeta++")\n"++(prettyBlockList0blocks)++"\n"---- Pandoc block and inline list processing---- | Generate infinite lazy list of markers for an ordered list,-- depending on list attributes.orderedListMarkers::(Int,ListNumberStyle,ListNumberDelim)->[String]orderedListMarkers(start,numstyle,numdelim)=letsingletonc=[c]nums=casenumstyleofDefaultStyle->mapshow[start..]Decimal->mapshow[start..]UpperAlpha->drop(start-1)$cycle$mapsingleton['A'..'Z']LowerAlpha->drop(start-1)$cycle$mapsingleton['a'..'z']UpperRoman->maptoRomanNumeral[start..]LowerRoman->map(maptoLower.toRomanNumeral)[start..]inDelimstr=casenumdelimofDefaultDelim->str++"."Period->str++"."OneParen->str++")"TwoParens->"("++str++")"inmapinDelimnums-- | Normalize a list of inline elements: remove leading and trailing-- @Space@ elements, collapse double @Space@s into singles, and-- remove empty Str elements.normalizeSpaces::[Inline]->[Inline]normalizeSpaces[]=[]normalizeSpaceslist=letremoveDoubles[]=[]removeDoubles(Space:Space:rest)=removeDoubles(Space:rest)removeDoubles(Space:(Str""):Space:rest)=removeDoubles(Space:rest)removeDoubles((Str""):rest)=removeDoublesrestremoveDoubles(x:rest)=x:(removeDoublesrest)removeLeading(Space:xs)=removeLeadingxsremoveLeadingx=xremoveTrailing[]=[]removeTrailinglst=if(lastlst==Space)theninitlstelselstinremoveLeading$removeTrailing$removeDoubleslist-- | Change final list item from @Para@ to @Plain@ if the list contains-- no other @Para@ blocks.compactify::[[Block]]-- ^ List of list items (each a list of blocks)->[[Block]]compactify[]=[]compactifyitems=case(inititems,lastitems)of(_,[])->items(others,final)->caselastfinalofParaa->case(filterisPara$concatitems)of-- if this is only Para, change to Plain[_]->others++[initfinal++[Plaina]]_->items_->itemsisPara::Block->BoolisPara(Para_)=TrueisPara_=False-- | Data structure for defining hierarchical Pandoc documentsdataElement=BlkBlock|SecInt[Int]String[Inline][Element]-- lvl num ident label contentsderiving(Eq,Read,Show,Typeable,Data)-- | 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`elem`"_-."||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_->""-- | Convert list of Pandoc blocks into (hierarchical) list of Elementshierarchicalize::[Block]->[Element]hierarchicalizeblocks=S.evalState(hierarchicalizeWithIdsblocks)([],[])hierarchicalizeWithIds::[Block]->S.State([Int],[String])[Element]hierarchicalizeWithIds[]=return[]hierarchicalizeWithIds((Headerleveltitle'):xs)=do(lastnum,usedIdents)<-S.getletident=uniqueIdenttitle'usedIdentsletlastnum'=takelevellastnumletnewnum=iflengthlastnum'>=leveltheninitlastnum'++[lastlastnum'+1]elselastnum++replicate(level-lengthlastnum-1)0++[1]S.put(newnum,(ident:usedIdents))let(sectionContents,rest)=break(headerLtEqlevel)xssectionContents'<-hierarchicalizeWithIdssectionContentsrest'<-hierarchicalizeWithIdsrestreturn$Seclevelnewnumidenttitle'sectionContents':rest'hierarchicalizeWithIds(x:rest)=dorest'<-hierarchicalizeWithIdsrestreturn$(Blkx):rest'headerLtEq::Int->Block->BoolheaderLtEqlevel(Headerl_)=l<=levelheaderLtEq__=False-- | Generate a unique identifier from a list of inlines.-- Second argument is a list of already used identifiers.uniqueIdent::[Inline]->[String]->StringuniqueIdenttitle'usedIdents=letbaseIdent=inlineListToIdentifiertitle'numIdentn=baseIdent++"-"++showninifbaseIdent`elem`usedIdentsthencasefind(\x->numIdentx`notElem`usedIdents)([1..60000]::[Int])ofJustx->numIdentxNothing->baseIdent-- if we have more than 60,000, allow repeatselsebaseIdent-- | True if block is a Header block.isHeaderBlock::Block->BoolisHeaderBlock(Header__)=TrueisHeaderBlock_=False---- Writer options--dataHTMLMathMethod=PlainMath|LaTeXMathML(MaybeString)-- url of LaTeXMathML.js|JsMath(MaybeString)-- url of jsMath load script|GladTeX|MimeTeXString-- url of mimetex.cgi |MathML(MaybeString)-- url of MathMLinHTML.jsderiving(Show,Read,Eq)-- | Methods for obfuscating email addresses in HTML.dataObfuscationMethod=NoObfuscation|ReferenceObfuscation|JavascriptObfuscationderiving(Show,Read,Eq)-- | Options for writersdataWriterOptions=WriterOptions{writerStandalone::Bool-- ^ Include header and footer,writerTemplate::String-- ^ Template to use in standalone mode,writerVariables::[(String,String)]-- ^ Variables to set in template,writerIncludeBefore::String-- ^ Text to include before the body,writerIncludeAfter::String-- ^ Text to include after the body,writerTabStop::Int-- ^ Tabstop for conversion btw spaces and tabs,writerTableOfContents::Bool-- ^ Include table of contents,writerS5::Bool-- ^ We're writing S5 ,writerXeTeX::Bool-- ^ Create latex suitable for use by xetex,writerHTMLMathMethod::HTMLMathMethod-- ^ How to print math in HTML,writerIgnoreNotes::Bool-- ^ Ignore footnotes (used in making toc),writerIncremental::Bool-- ^ Incremental S5 lists,writerNumberSections::Bool-- ^ Number sections in LaTeX,writerStrictMarkdown::Bool-- ^ Use strict markdown syntax,writerReferenceLinks::Bool-- ^ Use reference links in writing markdown, rst,writerWrapText::Bool-- ^ Wrap text to line length,writerLiterateHaskell::Bool-- ^ Write as literate haskell,writerEmailObfuscation::ObfuscationMethod-- ^ How to obfuscate emails,writerIdentifierPrefix::String-- ^ Prefix for section & note ids in HTML}derivingShow-- | Default writer options.defaultWriterOptions::WriterOptionsdefaultWriterOptions=WriterOptions{writerStandalone=False,writerTemplate="",writerVariables=[],writerIncludeBefore="",writerIncludeAfter="",writerTabStop=4,writerTableOfContents=False,writerS5=False,writerXeTeX=False,writerHTMLMathMethod=PlainMath,writerIgnoreNotes=False,writerIncremental=False,writerNumberSections=False,writerStrictMarkdown=False,writerReferenceLinks=False,writerWrapText=True,writerLiterateHaskell=False,writerEmailObfuscation=JavascriptObfuscation,writerIdentifierPrefix=""}---- File handling---- | Perform an IO action in a directory, returning to starting directory.inDirectory::FilePath->IOa->IOainDirectorypathaction=dooldDir<-getCurrentDirectorysetCurrentDirectorypathresult<-actionsetCurrentDirectoryoldDirreturnresult-- | Read file from specified user data directory or, if not found there, from-- Cabal data directory.readDataFile::MaybeFilePath->FilePath->IOStringreadDataFileuserDirfname=caseuserDirofNothing->getDataFileNamefname>>=readFileJustu->catch(readFile$u</>fname)(\_->getDataFileNamefname>>=readFile)