{-# LANGUAGE RelaxedPolyRec #-}-- needed for inlinesBetween on GHC < 7{-
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.Readers.Markdown
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 markdown-formatted plain text to 'Pandoc' document.
-}moduleText.Pandoc.Readers.Markdown(readMarkdown,readMarkdownWithWarnings)whereimportData.List(transpose,sortBy,findIndex,intersperse,intercalate)importqualifiedData.MapasMimportData.Ord(comparing)importData.Char(isAlphaNum,toLower)importData.MaybeimportText.Pandoc.DefinitionimportqualifiedText.Pandoc.BuilderasBimportText.Pandoc.Builder(Inlines,Blocks,trimInlines,(<>))importText.Pandoc.OptionsimportText.Pandoc.SharedimportText.Pandoc.Parsinghiding(tableWith)importText.Pandoc.Readers.LaTeX(rawLaTeXInline,rawLaTeXBlock)importText.Pandoc.Readers.HTML(htmlTag,htmlInBalanced,isInlineTag,isBlockTag,isTextTag,isCommentTag)importText.Pandoc.XML(fromEntities)importText.Pandoc.Biblio(processBiblio)importqualifiedText.CSLasCSLimportData.Monoid(mconcat,mempty)importControl.Applicative((<$>),(<*),(*>),(<$))importControl.MonadimportText.HTML.TagSoupimportText.HTML.TagSoup.Match(tagOpen)importqualifiedData.SetasSettypeMarkdownParser=Parser[Char]ParserState-- | Read markdown from an input string and return a Pandoc document.readMarkdown::ReaderOptions-- ^ Reader options->String-- ^ String to parse (assuming @'\n'@ line endings)->PandocreadMarkdownoptss=(readWithparseMarkdown)def{stateOptions=opts}(s++"\n\n")-- | Read markdown from an input string and return a pair of a Pandoc document-- and a list of warnings.readMarkdownWithWarnings::ReaderOptions-- ^ Reader options->String-- ^ String to parse (assuming @'\n'@ line endings)->(Pandoc,[String])readMarkdownWithWarningsoptss=(readWithparseMarkdownWithWarnings)def{stateOptions=opts}(s++"\n\n")whereparseMarkdownWithWarnings=dodoc<-parseMarkdownwarnings<-stateWarnings<$>getStatereturn(doc,warnings)trimInlinesF::FInlines->FInlinestrimInlinesF=liftMtrimInlines---- Constants and data structure definitions--isBulletListMarker::Char->BoolisBulletListMarker'*'=TrueisBulletListMarker'+'=TrueisBulletListMarker'-'=TrueisBulletListMarker_=FalseisHruleChar::Char->BoolisHruleChar'*'=TrueisHruleChar'-'=TrueisHruleChar'_'=TrueisHruleChar_=FalsesetextHChars::StringsetextHChars="=-"isBlank::Char->BoolisBlank' '=TrueisBlank'\t'=TrueisBlank'\n'=TrueisBlank_=False---- auxiliary functions--isNull::FInlines->BoolisNullils=B.isNull$runFilsdefspnl::Parser[Char]st()spnl=try$doskipSpacesoptionalnewlineskipSpacesnotFollowedBy(char'\n')indentSpaces::MarkdownParserStringindentSpaces=try$dotabStop<-getOptionreaderTabStopcounttabStop(char' ')<|>string"\t"<?>"indentation"nonindentSpaces::MarkdownParserStringnonindentSpaces=dotabStop<-getOptionreaderTabStopsps<-many(char' ')iflengthsps<tabStopthenreturnspselseunexpected"indented line"skipNonindentSpaces::MarkdownParser()skipNonindentSpaces=dotabStop<-getOptionreaderTabStopatMostSpaces(tabStop-1)atMostSpaces::Int->MarkdownParser()atMostSpaces0=notFollowedBy(char' ')atMostSpacesn=(char' '>>atMostSpaces(n-1))<|>return()litChar::MarkdownParserCharlitChar=escapedChar'<|>noneOf"\n"<|>try(newline>>notFollowedByblankline>>return' ')-- | Parse a sequence of inline elements between square brackets,-- including inlines between balanced pairs of square brackets.inlinesInBalancedBrackets::MarkdownParser(FInlines)inlinesInBalancedBrackets=charsInBalancedBrackets>>=parseFromString(trimInlinesF.mconcat<$>manyinline)charsInBalancedBrackets::MarkdownParser[Char]charsInBalancedBrackets=dochar'['result<-manyTill(many1(noneOf"`[]\n")<|>(snd<$>withRawcode)<|>((\xs->'[':xs++"]")<$>charsInBalancedBrackets)<|>count1(satisfy(/='\n'))<|>(newline>>notFollowedByblankline>>return"\n"))(char']')return$concatresult---- document structure--titleLine::MarkdownParser(FInlines)titleLine=try$dochar'%'skipSpacesres<-many$(notFollowedBynewline>>inline)<|>try(endline>>whitespace)newlinereturn$trimInlinesF$mconcatresauthorsLine::MarkdownParser(F[Inlines])authorsLine=try$dochar'%'skipSpacesauthors<-sepEndBy(many(notFollowedBy(satisfy$\c->c==';'||c=='\n')>>inline))(char';'<|>try(newline>>notFollowedByblankline>>spaceChar))newlinereturn$sequence$filter(not.isNull)$map(trimInlinesF.mconcat)authorsdateLine::MarkdownParser(FInlines)dateLine=try$dochar'%'skipSpacestrimInlinesF.mconcat<$>manyTillinlinenewlinetitleBlock::MarkdownParser(FInlines,F[Inlines],FInlines)titleBlock=pandocTitleBlock<|>mmdTitleBlockpandocTitleBlock::MarkdownParser(FInlines,F[Inlines],FInlines)pandocTitleBlock=try$doguardEnabledExt_pandoc_title_blocktitle<-optionmemptytitleLineauthor<-option(return[])authorsLinedate<-optionmemptydateLineoptionalblanklinesreturn(title,author,date)mmdTitleBlock::MarkdownParser(FInlines,F[Inlines],FInlines)mmdTitleBlock=try$doguardEnabledExt_mmd_title_blockkvPairs<-many1kvPairblanklineslettitle=maybememptyreturn$lookup"title"kvPairsletauthor=maybemempty(\x->return[x])$lookup"author"kvPairsletdate=maybememptyreturn$lookup"date"kvPairsreturn(title,author,date)kvPair::MarkdownParser(String,Inlines)kvPair=try$dokey<-many1Till(alphaNum<|>oneOf"_- ")(char':')val<-manyTillanyChar(try$newline>>lookAhead(blankline<|>nonspaceChar))letkey'=concat$words$maptoLowerkeyletval'=trimInlines$B.textvalreturn(key',val')parseMarkdown::MarkdownParserPandocparseMarkdown=do-- markdown allows raw HTMLupdateState$\state->state{stateOptions=letoldOpts=stateOptionsstateinoldOpts{readerParseRaw=True}}(title,authors,date)<-option(mempty,return[],mempty)titleBlockblocks<-parseBlocksst<-getStatembsty<-getOptionreaderCitationStylerefs<-getOptionreaderReferencesreturn$processBibliombstyrefs$B.setTitle(runFtitlest)$B.setAuthors(runFauthorsst)$B.setDate(runFdatest)$B.doc$runFblocksstaddWarning::MaybeSourcePos->String->MarkdownParser()addWarningmbposmsg=updateState$\st->st{stateWarnings=(msg++maybe""(\pos->" "++showpos)mbpos):stateWarningsst}referenceKey::MarkdownParser(FBlocks)referenceKey=try$dopos<-getPositionskipNonindentSpaces(_,raw)<-referencechar':'skipSpaces>>optionalnewline>>skipSpaces>>notFollowedBy(char'[')letsourceURL=liftMunwords$many$try$donotFollowedBy'referenceTitleskipManyspaceCharoptional$newline>>notFollowedByblanklineskipManyspaceCharnotFollowedBy'(()<$reference)many1$escapedChar'<|>satisfy(not.isBlank)letbetweenAngles=try$char'<'>>manyTill(escapedChar'<|>litChar)(char'>')src<-trybetweenAngles<|>sourceURLtit<-option""referenceTitle-- currently we just ignore MMD-style link/image attributes_kvs<-option[]$guardEnabledExt_link_attributes>>many(spnl>>keyValAttr)blanklineslettarget=(escapeURI$trimrsrc,tit)st<-getStateletoldkeys=stateKeysstletkey=toKeyrawcaseM.lookupkeyoldkeysofJust_->addWarning(Justpos)$"Duplicate link reference `"++raw++"'"Nothing->return()updateState$\s->s{stateKeys=M.insertkeytargetoldkeys}return$returnmemptyreferenceTitle::MarkdownParserStringreferenceTitle=try$doskipSpaces>>optionalnewline>>skipSpacesletparenTit=charsInBalanced'('')'litCharfromEntities<$>(quotedTitle'"'<|>quotedTitle'\''<|>parenTit)-- A link title in quotesquotedTitle::Char->MarkdownParserStringquotedTitlec=try$docharcnotFollowedByspacesletpEnder=try$charc>>notFollowedBy(satisfyisAlphaNum)letregChunk=many1(noneOf['\\','\n',c])<|>count1litCharletnestedChunk=(\x->[c]++x++[c])<$>quotedTitlecunwords.words.concat<$>manyTill(nestedChunk<|>regChunk)pEnder-- | PHP Markdown Extra style abbreviation key. Currently-- we just skip them, since Pandoc doesn't have an element for-- an abbreviation.abbrevKey::MarkdownParser(FBlocks)abbrevKey=doguardEnabledExt_abbreviationstry$dochar'*'referencechar':'skipMany(satisfy(/='\n'))blanklinesreturn$returnmemptynoteMarker::MarkdownParserStringnoteMarker=string"[^">>many1Till(satisfy$not.isBlank)(char']')rawLine::MarkdownParserStringrawLine=try$donotFollowedByblanklinenotFollowedBy'$try$skipNonindentSpaces>>noteMarkeroptionalindentSpacesanyLinerawLines::MarkdownParserStringrawLines=dofirst<-anyLinerest<-manyrawLinereturn$unlines(first:rest)noteBlock::MarkdownParser(FBlocks)noteBlock=try$dopos<-getPositionskipNonindentSpacesref<-noteMarkerchar':'optionalblanklineoptionalindentSpacesfirst<-rawLinesrest<-many$try$blanklines>>indentSpaces>>rawLinesletraw=unlines(first:rest)++"\n"optionalblanklinesparsed<-parseFromStringparseBlocksrawletnewnote=(ref,parsed)oldnotes<-stateNotes'<$>getStatecaselookuprefoldnotesofJust_->addWarning(Justpos)$"Duplicate note reference `"++ref++"'"Nothing->return()updateState$\s->s{stateNotes'=newnote:oldnotes}returnmempty---- parsing blocks--parseBlocks::MarkdownParser(FBlocks)parseBlocks=mconcat<$>manyTillblockeofblock::MarkdownParser(FBlocks)block=choice[codeBlockFenced,codeBlockBackticks,guardEnabledExt_latex_macros*>(mempty<$macro),header,rawTeXBlock,htmlBlock,lineBlock,table,codeBlockIndented,lhsCodeBlock,blockQuote,hrule,bulletList,orderedList,definitionList,noteBlock,referenceKey,abbrevKey,para,plain]<?>"block"---- header blocks--header::MarkdownParser(FBlocks)header=setextHeader<|>atxHeader<?>"header"-- returns unique identifieraddToHeaderList::Attr->FInlines->MarkdownParserAttraddToHeaderList(ident,classes,kvs)text=doletheaderList=B.toList$runFtextdefaultParserStateupdateState$\st->st{stateHeaders=headerList:stateHeadersst}(doguardEnabledExt_auto_identifiersids<-stateIdentifiers`fmap`getStateletid'=ifnullidentthenuniqueIdentheaderListidselseidentupdateState$\st->st{stateIdentifiers=id':ids}return(id',classes,kvs))<|>return("",classes,kvs)atxHeader::MarkdownParser(FBlocks)atxHeader=try$dolevel<-many1(char'#')>>=return.lengthnotFollowedBy(char'.'<|>char')')-- this would be a listskipSpacestext<-trimInlinesF.mconcat<$>many(notFollowedByatxClosing>>inline)attr<-atxClosingattr'<-addToHeaderListattrtextreturn$B.headerWithattr'level<$>textatxClosing::MarkdownParserAttratxClosing=try$doattr'<-optionnullAttr(guardEnabledExt_mmd_header_identifiers>>mmdHeaderIdentifier)skipMany(char'#')skipSpacesattr<-optionattr'(guardEnabledExt_header_attributes>>attributes)blanklinesreturnattrsetextHeaderEnd::MarkdownParserAttrsetextHeaderEnd=try$doattr<-optionnullAttr$(guardEnabledExt_mmd_header_identifiers>>mmdHeaderIdentifier)<|>(guardEnabledExt_header_attributes>>attributes)blanklinesreturnattrmmdHeaderIdentifier::MarkdownParserAttrmmdHeaderIdentifier=doident<-stripFirstAndLast.snd<$>referenceskipSpacesreturn(ident,[],[])setextHeader::MarkdownParser(FBlocks)setextHeader=try$do-- This lookahead prevents us from wasting time parsing Inlines-- unless necessary -- it gives a significant performance boost.lookAhead$anyLine>>many1(oneOfsetextHChars)>>blanklinetext<-trimInlinesF.mconcat<$>many1(notFollowedBysetextHeaderEnd>>inline)attr<-setextHeaderEndunderlineChar<-oneOfsetextHCharsmany(charunderlineChar)blanklinesletlevel=(fromMaybe0$findIndex(==underlineChar)setextHChars)+1attr'<-addToHeaderListattrtextreturn$B.headerWithattr'level<$>text---- hrule block--hrule::Parser[Char]st(FBlocks)hrule=try$doskipSpacesstart<-satisfyisHruleCharcount2(skipSpaces>>charstart)skipMany(spaceChar<|>charstart)newlineoptionalblanklinesreturn$returnB.horizontalRule---- code blocks--indentedLine::MarkdownParserStringindentedLine=indentSpaces>>manyTillanyCharnewline>>=return.(++"\n")blockDelimiter::(Char->Bool)->MaybeInt->Parser[Char]stIntblockDelimiterflen=try$doc<-lookAhead(satisfyf)caselenofJustl->countl(charc)>>many(charc)>>returnlNothing->count3(charc)>>many(charc)>>=return.(+3).lengthattributes::Parser[Char]st(String,[String],[(String,String)])attributes=try$dochar'{'spnlattrs<-many(attribute>>~spnl)char'}'let(ids,classes,keyvals)=unzip3attrsletfirstNonNull[]=""firstNonNull(x:xs)|not(nullx)=x|otherwise=firstNonNullxsreturn(firstNonNull$reverseids,concatclasses,concatkeyvals)attribute::Parser[Char]st(String,[String],[(String,String)])attribute=identifierAttr<|>classAttr<|>keyValAttridentifier::Parser[Char]stStringidentifier=dofirst<-letterrest<-many$alphaNum<|>oneOf"-_:."return(first:rest)identifierAttr::Parser[Char]st(String,[a],[a1])identifierAttr=try$dochar'#'result<-identifierreturn(result,[],[])classAttr::Parser[Char]st(String,[String],[a])classAttr=try$dochar'.'result<-identifierreturn("",[result],[])keyValAttr::Parser[Char]st(String,[a],[(String,String)])keyValAttr=try$dokey<-identifierchar'='val<-enclosed(char'"')(char'"')anyChar<|>enclosed(char'\'')(char'\'')anyChar<|>manynonspaceCharreturn("",[],[(key,val)])codeBlockFenced::MarkdownParser(FBlocks)codeBlockFenced=try$doguardEnabledExt_fenced_code_blockssize<-blockDelimiter(=='~')NothingskipManyspaceCharattr<-option([],[],[])$guardEnabledExt_fenced_code_attributes>>attributesblanklinecontents<-manyTillanyLine(blockDelimiter(=='~')(Justsize))blanklinesreturn$return$B.codeBlockWithattr$intercalate"\n"contentscodeBlockBackticks::MarkdownParser(FBlocks)codeBlockBackticks=try$doguardEnabledExt_backtick_code_blocksblockDelimiter(=='`')(Just3)skipManyspaceCharcls<-many1alphaNumblanklinecontents<-manyTillanyLine$blockDelimiter(=='`')(Just3)blanklinesreturn$return$B.codeBlockWith("",[cls],[])$intercalate"\n"contentscodeBlockIndented::MarkdownParser(FBlocks)codeBlockIndented=docontents<-many1(indentedLine<|>try(dob<-blanklinesl<-indentedLinereturn$b++l))optionalblanklinesclasses<-getOptionreaderIndentedCodeClassesreturn$return$B.codeBlockWith("",classes,[])$stripTrailingNewlines$concatcontentslhsCodeBlock::MarkdownParser(FBlocks)lhsCodeBlock=doguardEnabledExt_literate_haskell(return.B.codeBlockWith("",["sourceCode","literate","haskell"],[])<$>(lhsCodeBlockBird<|>lhsCodeBlockLaTeX))<|>(return.B.codeBlockWith("",["sourceCode","haskell"],[])<$>lhsCodeBlockInverseBird)lhsCodeBlockLaTeX::MarkdownParserStringlhsCodeBlockLaTeX=try$dostring"\\begin{code}"manyTillspaceCharnewlinecontents<-many1TillanyChar(try$string"\\end{code}")blanklinesreturn$stripTrailingNewlinescontentslhsCodeBlockBird::MarkdownParserStringlhsCodeBlockBird=lhsCodeBlockBirdWith'>'lhsCodeBlockInverseBird::MarkdownParserStringlhsCodeBlockInverseBird=lhsCodeBlockBirdWith'<'lhsCodeBlockBirdWith::Char->MarkdownParserStringlhsCodeBlockBirdWithc=try$dopos<-getPositionwhen(sourceColumnpos/=1)$fail"Not in first column"lns<-many1$birdTrackLinec-- if (as is normal) there is always a space after >, drop itletlns'=ifall(\ln->nullln||take1ln==" ")lnsthenmap(drop1)lnselselnsblanklinesreturn$intercalate"\n"lns'birdTrackLine::Char->Parser[Char]stStringbirdTrackLinec=try$docharc-- allow html tags on left margin:when(c=='<')$notFollowedBylettermanyTillanyCharnewline---- block quotes--emailBlockQuoteStart::MarkdownParserCharemailBlockQuoteStart=try$skipNonindentSpaces>>char'>'>>~optional(char' ')emailBlockQuote::MarkdownParser[String]emailBlockQuote=try$doemailBlockQuoteStartletemailLine=many$nonEndline<|>try(endline>>notFollowedByemailBlockQuoteStart>>return'\n')letemailSep=try(newline>>emailBlockQuoteStart)first<-emailLinerest<-many$try$emailSep>>emailLineletraw=first:restnewline<|>(eof>>return'\n')optionalblanklinesreturnrawblockQuote::MarkdownParser(FBlocks)blockQuote=doraw<-emailBlockQuote-- parse the extracted block, which may contain various block elements:contents<-parseFromStringparseBlocks$(intercalate"\n"raw)++"\n\n"return$B.blockQuote<$>contents---- list blocks--bulletListStart::MarkdownParser()bulletListStart=try$dooptionalnewline-- if preceded by a Plain block in a list contextskipNonindentSpacesnotFollowedBy'(()<$hrule)-- because hrules start out just like listssatisfyisBulletListMarkerspaceCharskipSpacesanyOrderedListStart::MarkdownParser(Int,ListNumberStyle,ListNumberDelim)anyOrderedListStart=try$dooptionalnewline-- if preceded by a Plain block in a list contextskipNonindentSpacesnotFollowedBy$string"p.">>spaceChar>>digit-- page number(guardDisabledExt_fancy_lists>>domany1digitchar'.'spaceCharreturn(1,DefaultStyle,DefaultDelim))<|>do(num,style,delim)<-anyOrderedListMarker-- if it could be an abbreviated first name, insist on more than one spaceifdelim==Period&&(style==UpperAlpha||(style==UpperRoman&&num`elem`[1,5,10,50,100,500,1000]))thenchar'\t'<|>(try$char' '>>spaceChar)elsespaceCharskipSpacesreturn(num,style,delim)listStart::MarkdownParser()listStart=bulletListStart<|>(anyOrderedListStart>>return())-- parse a line of a list item (start = parser for beginning of list item)listLine::MarkdownParserStringlistLine=try$donotFollowedByblanklinenotFollowedBy'(doindentSpacesmany(spaceChar)listStart)chunks<-manyTill(liftMsnd(htmlTagisCommentTag)<|>count1anyChar)newlinereturn$concatchunks++"\n"-- parse raw text for one list item, excluding start marker and continuationsrawListItem::MarkdownParsera->MarkdownParserStringrawListItemstart=try$dostartfirst<-listLinerest<-many(notFollowedBylistStart>>listLine)blanks<-manyblanklinereturn$concat(first:rest)++blanks-- continuation of a list item - indented and separated by blankline-- or (in compact lists) endline.-- note: nested lists are parsed as continuationslistContinuation::MarkdownParserStringlistContinuation=try$dolookAheadindentSpacesresult<-many1listContinuationLineblanks<-manyblanklinereturn$concatresult++blankslistContinuationLine::MarkdownParserStringlistContinuationLine=try$donotFollowedByblanklinenotFollowedBy'listStartoptionalindentSpacesresult<-manyTillanyCharnewlinereturn$result++"\n"listItem::MarkdownParsera->MarkdownParser(FBlocks)listItemstart=try$dofirst<-rawListItemstartcontinuations<-manylistContinuation-- parsing with ListItemState forces markers at beginning of lines to-- count as list item markers, even if not separated by blank space.-- see definition of "endline"state<-getStateletoldContext=stateParserContextstatesetState$state{stateParserContext=ListItemState}-- parse the extracted block, which may contain various block elements:letraw=concat(first:continuations)contents<-parseFromStringparseBlocksrawupdateState(\st->st{stateParserContext=oldContext})returncontentsorderedList::MarkdownParser(FBlocks)orderedList=try$do(start,style,delim)<-lookAheadanyOrderedListStartunless((style==DefaultStyle||style==Decimal||style==Example)&&(delim==DefaultDelim||delim==Period))$guardEnabledExt_fancy_listswhen(style==Example)$guardEnabledExt_example_listsitems<-fmapsequence$many1$listItem(try$dooptionalnewline-- if preceded by Plain block in a listskipNonindentSpacesorderedListMarkerstyledelim)start'<-option1$guardEnabledExt_startnum>>returnstartreturn$B.orderedListWith(start',style,delim)<$>fmapcompactify'itemsbulletList::MarkdownParser(FBlocks)bulletList=doitems<-fmapsequence$many1$listItembulletListStartreturn$B.bulletList<$>fmapcompactify'items-- definition listsdefListMarker::MarkdownParser()defListMarker=dosps<-nonindentSpaceschar':'<|>char'~'tabStop<-getOptionreaderTabStopletremaining=tabStop-(lengthsps+1)ifremaining>0thencountremaining(char' ')<|>string"\t"elsemzeroreturn()definitionListItem::MarkdownParser(F(Inlines,[Blocks]))definitionListItem=try$doguardEnabledExt_definition_lists-- first, see if this has any chance of being a definition list:lookAhead(anyLine>>optionalblankline>>defListMarker)term<-trimInlinesF.mconcat<$>manyTillinlinenewlineoptionalblanklineraw<-many1defRawBlockstate<-getStateletoldContext=stateParserContextstate-- parse the extracted block, which may contain various block elements:contents<-mapM(parseFromStringparseBlocks)rawupdateState(\st->st{stateParserContext=oldContext})return$liftM2(,)term(sequencecontents)defRawBlock::MarkdownParserStringdefRawBlock=try$dodefListMarkerfirstline<-anyLinerawlines<-many(notFollowedByblankline>>indentSpaces>>anyLine)trailing<-option""blanklinescont<-liftMconcat$many$dolns<-many1$notFollowedByblankline>>indentSpaces>>anyLinetrl<-option""blanklinesreturn$unlineslns++trlreturn$firstline++"\n"++unlinesrawlines++trailing++contdefinitionList::MarkdownParser(FBlocks)definitionList=doitems<-fmapsequence$many1definitionListItemreturn$B.definitionList<$>fmapcompactify'DLitemscompactify'DL::[(Inlines,[Blocks])]->[(Inlines,[Blocks])]compactify'DLitems=letdefs=concatMapsnditemsdefBlocks=reverse$concatMapB.toListdefsisPara(Para_)=TrueisPara_=FalseincasedefBlocksof(Parax:_)->ifnot$anyisPara(drop1defBlocks)thenlet(t,ds)=lastitemslastDef=B.toList$lastdsds'=initds++[B.fromList$initlastDef++[Plainx]]ininititems++[(t,ds')]elseitems_->items---- paragraph block--para::MarkdownParser(FBlocks)para=try$doexts<-getOptionreaderExtensionsresult<-trimInlinesF.mconcat<$>many1inlineoption(B.plain<$>result)$try$donewline(blanklines>>returnmempty)<|>(guardDisabledExt_blank_before_blockquote>>lookAheadblockQuote)<|>(guardDisabledExt_blank_before_header>>lookAheadheader)return$doresult'<-resultcaseB.toListresult'of[Imagealt(src,tit)]|Ext_implicit_figures`Set.member`exts->-- the fig: at beginning of title indicates a figurereturn$B.para$B.singleton$Imagealt(src,'f':'i':'g':':':tit)_->return$B.pararesult'plain::MarkdownParser(FBlocks)plain=fmapB.plain.trimInlinesF.mconcat<$>many1inline<*spaces---- raw html--htmlElement::MarkdownParserStringhtmlElement=strictHtmlBlock<|>liftMsnd(htmlTagisBlockTag)htmlBlock::MarkdownParser(FBlocks)htmlBlock=doguardEnabledExt_raw_htmlres<-(guardEnabledExt_markdown_in_html_blocks>>rawHtmlBlocks)<|>htmlBlock'return$return$B.rawBlock"html"reshtmlBlock'::MarkdownParserStringhtmlBlock'=try$dofirst<-htmlElementfinalSpace<-manyspaceCharfinalNewlines<-manynewlinereturn$first++finalSpace++finalNewlinesstrictHtmlBlock::MarkdownParserStringstrictHtmlBlock=htmlInBalanced(not.isInlineTag)rawVerbatimBlock::MarkdownParserStringrawVerbatimBlock=try$do(TagOpentag_,open)<-htmlTag(tagOpen(\t->t=="pre"||t=="style"||t=="script")(constTrue))contents<-manyTillanyChar(htmlTag(~==TagClosetag))return$open++contents++renderTags[TagClosetag]rawTeXBlock::MarkdownParser(FBlocks)rawTeXBlock=doguardEnabledExt_raw_texresult<-(B.rawBlock"latex"<$>rawLaTeXBlock)<|>(B.rawBlock"context"<$>rawConTeXtEnvironment)spacesreturn$returnresultrawHtmlBlocks::MarkdownParserStringrawHtmlBlocks=dohtmlBlocks<-many1$try$dos<-rawVerbatimBlock<|>try(do(t,raw)<-htmlTagisBlockTagexts<-getOptionreaderExtensions-- if open tag, need markdown="1" if-- markdown_attributes extension is setcasetofTagOpen_as|Ext_markdown_attribute`Set.member`exts->if"markdown"`notElem`mapfstasthenmzeroelsereturn$stripMarkdownAttributeraw|otherwise->returnraw_->returnraw)sps<-dosp1<-manyspaceCharsp2<-option""(blankline>>return"\n")sp3<-manyspaceCharsp4<-option""blanklinesreturn$sp1++sp2++sp3++sp4-- note: we want raw html to be able to-- precede a code block, when separated-- by a blank linereturn$s++spsletcombined=concathtmlBlocksreturn$iflastcombined=='\n'theninitcombinedelsecombined-- remove markdown="1" attributestripMarkdownAttribute::String->StringstripMarkdownAttributes=renderTags'$mapfilterAttrib$parseTagsswherefilterAttrib(TagOpentas)=TagOpent[(k,v)|(k,v)<-as,k/="markdown"]filterAttribx=x---- line block--lineBlock::MarkdownParser(FBlocks)lineBlock=try$doguardEnabledExt_line_blockslines'<-lineBlockLines>>=mapM(parseFromString(trimInlinesF.mconcat<$>manyinline))return$B.para<$>(mconcat$intersperse(returnB.linebreak)lines')---- Tables---- Parse a dashed line with optional trailing spaces; return its length-- and the length including trailing space.dashedLine::Char->Parser[Char]st(Int,Int)dashedLinech=dodashes<-many1(charch)sp<-manyspaceCharreturn$(lengthdashes,length$dashes++sp)-- Parse a table header with dashed lines of '-' preceded by-- one (or zero) line of text.simpleTableHeader::Bool-- ^ Headerless table->MarkdownParser(F[Blocks],[Alignment],[Int])simpleTableHeaderheadless=try$dorawContent<-ifheadlessthenreturn""elseanyLineinitSp<-nonindentSpacesdashes<-many1(dashedLine'-')newlinelet(lengths,lines')=unzipdashesletindices=scanl(+)(lengthinitSp)lines'-- If no header, calculate alignment on basis of first row of textrawHeads<-liftM(tail.splitStringByIndices(initindices))$ifheadlessthenlookAheadanyLineelsereturnrawContentletaligns=zipWithalignType(map(\a->[a])rawHeads)lengthsletrawHeads'=ifheadlessthenreplicate(lengthdashes)""elserawHeadsheads<-fmapsequence$mapM(parseFromString(mconcat<$>manyplain))$maptrimrawHeads'return(heads,aligns,indices)-- Returns an alignment type for a table, based on a list of strings-- (the rows of the column header) and a number (the length of the-- dashed line under the rows.alignType::[String]->Int->AlignmentalignType[]_=AlignDefaultalignTypestrLstlen=letnonempties=filter(not.null)$maptrimrstrLst(leftSpace,rightSpace)=casesortBy(comparinglength)nonemptiesof(x:_)->(headx`elem`" \t",lengthx<len)[]->(False,False)incase(leftSpace,rightSpace)of(True,False)->AlignRight(False,True)->AlignLeft(True,True)->AlignCenter(False,False)->AlignDefault-- Parse a table footer - dashed lines followed by blank line.tableFooter::MarkdownParserStringtableFooter=try$skipNonindentSpaces>>many1(dashedLine'-')>>blanklines-- Parse a table separator - dashed line.tableSep::MarkdownParserChartableSep=try$skipNonindentSpaces>>many1(dashedLine'-')>>char'\n'-- Parse a raw line and split it into chunks by indices.rawTableLine::[Int]->MarkdownParser[String]rawTableLineindices=donotFollowedBy'(blanklines<|>tableFooter)line<-many1TillanyCharnewlinereturn$maptrim$tail$splitStringByIndices(initindices)line-- Parse a table line and return a list of lists of blocks (columns).tableLine::[Int]->MarkdownParser(F[Blocks])tableLineindices=rawTableLineindices>>=fmapsequence.mapM(parseFromString(mconcat<$>manyplain))-- Parse a multiline table row and return a list of blocks (columns).multilineRow::[Int]->MarkdownParser(F[Blocks])multilineRowindices=docolLines<-many1(rawTableLineindices)letcols=mapunlines$transposecolLinesfmapsequence$mapM(parseFromString(mconcat<$>manyplain))cols-- Parses a table caption: inlines beginning with 'Table:'-- and followed by blank lines.tableCaption::MarkdownParser(FInlines)tableCaption=try$doguardEnabledExt_table_captionsskipNonindentSpacesstring":"<|>string"Table:"trimInlinesF.mconcat<$>many1inline<*blanklines-- Parse a simple table with '---' header and one line per row.simpleTable::Bool-- ^ Headerless table->MarkdownParser([Alignment],[Double],F[Blocks],F[[Blocks]])simpleTableheadless=do(aligns,_widths,heads',lines')<-tableWith(simpleTableHeaderheadless)tableLine(return())(ifheadlessthentableFooterelsetableFooter<|>blanklines)-- Simple tables get 0s for relative column widths (i.e., use default)return(aligns,replicate(lengthaligns)0,heads',lines')-- Parse a multiline table: starts with row of '-' on top, then header-- (which may be multiline), then the rows,-- which may be multiline, separated by blank lines, and-- ending with a footer (dashed line followed by blank line).multilineTable::Bool-- ^ Headerless table->MarkdownParser([Alignment],[Double],F[Blocks],F[[Blocks]])multilineTableheadless=tableWith(multilineTableHeaderheadless)multilineRowblanklinestableFootermultilineTableHeader::Bool-- ^ Headerless table->MarkdownParser(F[Blocks],[Alignment],[Int])multilineTableHeaderheadless=try$doifheadlessthenreturn'\n'elsetableSep>>~notFollowedByblanklinerawContent<-ifheadlessthenreturn$repeat""elsemany1(notFollowedBytableSep>>many1TillanyCharnewline)initSp<-nonindentSpacesdashes<-many1(dashedLine'-')newlinelet(lengths,lines')=unzipdashesletindices=scanl(+)(lengthinitSp)lines'rawHeadsList<-ifheadlessthenliftM(map(:[]).tail.splitStringByIndices(initindices))$lookAheadanyLineelsereturn$transpose$map(\ln->tail$splitStringByIndices(initindices)ln)rawContentletaligns=zipWithalignTyperawHeadsListlengthsletrawHeads=ifheadlessthenreplicate(lengthdashes)""elsemap(intercalate" ")rawHeadsListheads<-fmapsequence$mapM(parseFromString(mconcat<$>manyplain))$maptrimrawHeadsreturn(heads,aligns,indices)-- Parse a grid table: starts with row of '-' on top, then header-- (which may be grid), then the rows,-- which may be grid, separated by blank lines, and-- ending with a footer (dashed line followed by blank line).gridTable::Bool-- ^ Headerless table->MarkdownParser([Alignment],[Double],F[Blocks],F[[Blocks]])gridTableheadless=tableWith(gridTableHeaderheadless)gridTableRow(gridTableSep'-')gridTableFootergridTableSplitLine::[Int]->String->[String]gridTableSplitLineindicesline=mapremoveFinalBar$tail$splitStringByIndices(initindices)$trimrlinegridPart::Char->Parser[Char]st(Int,Int)gridPartch=dodashes<-many1(charch)char'+'return(lengthdashes,lengthdashes+1)gridDashedLines::Char->Parser[Char]st[(Int,Int)]gridDashedLinesch=try$char'+'>>many1(gridPartch)>>~blanklineremoveFinalBar::String->StringremoveFinalBar=reverse.dropWhile(`elem`" \t").dropWhile(=='|').reverse-- | Separator between rows of grid table.gridTableSep::Char->MarkdownParserChargridTableSepch=try$gridDashedLinesch>>return'\n'-- | Parse header for a grid table.gridTableHeader::Bool-- ^ Headerless table->MarkdownParser(F[Blocks],[Alignment],[Int])gridTableHeaderheadless=try$dooptionalblanklinesdashes<-gridDashedLines'-'rawContent<-ifheadlessthenreturn$repeat""elsemany1(notFollowedBy(gridTableSep'=')>>char'|'>>many1TillanyCharnewline)ifheadlessthenreturn()elsegridTableSep'='>>return()letlines'=mapsnddashesletindices=scanl(+)0lines'letaligns=replicate(lengthlines')AlignDefault-- RST does not have a notion of alignmentsletrawHeads=ifheadlessthenreplicate(lengthdashes)""elsemap(intercalate" ")$transpose$map(gridTableSplitLineindices)rawContentheads<-fmapsequence$mapM(parseFromStringblock)$maptrimrawHeadsreturn(heads,aligns,indices)gridTableRawLine::[Int]->MarkdownParser[String]gridTableRawLineindices=dochar'|'line<-many1TillanyCharnewlinereturn(gridTableSplitLineindicesline)-- | Parse row of grid table.gridTableRow::[Int]->MarkdownParser(F[Blocks])gridTableRowindices=docolLines<-many1(gridTableRawLineindices)letcols=map((++"\n").unlines.removeOneLeadingSpace)$transposecolLinesfmapcompactify'<$>fmapsequence(mapM(parseFromStringblock)cols)removeOneLeadingSpace::[String]->[String]removeOneLeadingSpacexs=ifallstartsWithSpacexsthenmap(drop1)xselsexswherestartsWithSpace""=TruestartsWithSpace(y:_)=y==' '-- | Parse footer for a grid table.gridTableFooter::MarkdownParser[Char]gridTableFooter=blanklinespipeTable::MarkdownParser([Alignment],[Double],F[Blocks],F[[Blocks]])pipeTable=try$doletpipeBreak=nonindentSpaces*>optional(char'|')*>pipeTableHeaderPart`sepBy1`sepPipe<*optional(char'|')<*blankline(heads,aligns)<-try(pipeBreak>>=\als->return(return$replicate(lengthals)mempty,als))<|>(pipeTableRow>>=\row->pipeBreak>>=\als->return(row,als))lines'<-sequence<$>many1pipeTableRowblanklinesletwidths=replicate(lengthaligns)0.0return$(aligns,widths,heads,lines')sepPipe::MarkdownParser()sepPipe=try$dochar'|'<|>char'+'notFollowedByblankline-- parse a row, also returning probable alignments for org-table cellspipeTableRow::MarkdownParser(F[Blocks])pipeTableRow=dononindentSpacesoptional(char'|')letcell=mconcat<$>many(notFollowedBy(blankline<|>char'|')>>inline)first<-cellsepPiperest<-cell`sepBy1`sepPipeoptional(char'|')blanklineletcells=sequence(first:rest)return$docells'<-cellsreturn$map(\ils->casetrimInlinesilsofils'|B.isNullils'->mempty|otherwise->B.plain$ils')cells'pipeTableHeaderPart::Parser[Char]stAlignmentpipeTableHeaderPart=doleft<-optionMaybe(char':')many1(char'-')right<-optionMaybe(char':')return$case(left,right)of(Nothing,Nothing)->AlignDefault(Just_,Nothing)->AlignLeft(Nothing,Just_)->AlignRight(Just_,Just_)->AlignCenter-- Succeed only if current line contains a pipe.scanForPipe::Parser[Char]st()scanForPipe=lookAhead(manyTill(satisfy(/='\n'))(char'|'))>>return()-- | Parse a table using 'headerParser', 'rowParser',-- 'lineParser', and 'footerParser'. Variant of the version in-- Text.Pandoc.Parsing.tableWith::MarkdownParser(F[Blocks],[Alignment],[Int])->([Int]->MarkdownParser(F[Blocks]))->MarkdownParsersep->MarkdownParserend->MarkdownParser([Alignment],[Double],F[Blocks],F[[Blocks]])tableWithheaderParserrowParserlineParserfooterParser=try$do(heads,aligns,indices)<-headerParserlines'<-fmapsequence$rowParserindices`sepEndBy1`lineParserfooterParsernumColumns<-getOptionreaderColumnsletwidths=if(indices==[])thenreplicate(lengthaligns)0.0elsewidthsFromIndicesnumColumnsindicesreturn$(aligns,widths,heads,lines')table::MarkdownParser(FBlocks)table=try$dofrontCaption<-optionNothing(Just<$>tableCaption)(aligns,widths,heads,lns)<-try(guardEnabledExt_pipe_tables>>scanForPipe>>pipeTable)<|>try(guardEnabledExt_multiline_tables>>multilineTableFalse)<|>try(guardEnabledExt_simple_tables>>(simpleTableTrue<|>simpleTableFalse))<|>try(guardEnabledExt_multiline_tables>>multilineTableTrue)<|>try(guardEnabledExt_grid_tables>>(gridTableFalse<|>gridTableTrue))<?>"table"optionalblanklinescaption<-casefrontCaptionofNothing->option(returnmempty)tableCaptionJustc->returncreturn$docaption'<-captionheads'<-headslns'<-lnsreturn$B.tablecaption'(zipalignswidths)heads'lns'---- inline--inline::MarkdownParser(FInlines)inline=choice[whitespace,bareURL,str,endline,code,fours,strong,emph,note,cite,link,image,math,strikeout,superscript,subscript,inlineNote-- after superscript because of ^[link](/foo)^,autoLink,rawHtmlInline,escapedChar,rawLaTeXInline',exampleRef,smart,return.B.singleton<$>charRef,symbol,ltSign]<?>"inline"escapedChar'::MarkdownParserCharescapedChar'=try$dochar'\\'(guardEnabledExt_all_symbols_escapable>>satisfy(not.isAlphaNum))<|>oneOf"\\`*_{}[]()>#+-.!~\""escapedChar::MarkdownParser(FInlines)escapedChar=doresult<-escapedChar'caseresultof' '->return$return$B.str"\160"-- "\ " is a nonbreaking space'\n'->guardEnabledExt_escaped_line_breaks>>return(returnB.linebreak)-- "\[newline]" is a linebreak_->return$return$B.str[result]ltSign::MarkdownParser(FInlines)ltSign=doguardDisabledExt_raw_html<|>guardDisabledExt_markdown_in_html_blocks<|>(notFollowedBy'rawHtmlBlocks>>return())char'<'return$return$B.str"<"exampleRef::MarkdownParser(FInlines)exampleRef=try$doguardEnabledExt_example_listschar'@'lab<-many1(alphaNum<|>oneOf"-_")return$dost<-askFreturn$caseM.lookuplab(stateExamplesst)ofJustn->B.str(shown)Nothing->B.str('@':lab)symbol::MarkdownParser(FInlines)symbol=doresult<-noneOf"<\\\n\t "<|>try(dolookAhead$char'\\'notFollowedBy'(()<$rawTeXBlock)char'\\')return$return$B.str[result]-- parses inline code, between n `s and n `scode::MarkdownParser(FInlines)code=try$dostarts<-many1(char'`')skipSpacesresult<-many1Till(many1(noneOf"`\n")<|>many1(char'`')<|>(char'\n'>>notFollowedBy'blankline>>return" "))(try(skipSpaces>>count(lengthstarts)(char'`')>>notFollowedBy(char'`')))attr<-option([],[],[])(try$guardEnabledExt_inline_code_attributes>>optionalwhitespace>>attributes)return$return$B.codeWithattr$trim$concatresultmath::MarkdownParser(FInlines)math=(return.B.displayMath<$>(mathDisplay>>=applyMacros'))<|>(return.B.math<$>(mathInline>>=applyMacros'))mathDisplay::MarkdownParserStringmathDisplay=(guardEnabledExt_tex_math_dollars>>mathDisplayWith"$$""$$")<|>(guardEnabledExt_tex_math_single_backslash>>mathDisplayWith"\\[""\\]")<|>(guardEnabledExt_tex_math_double_backslash>>mathDisplayWith"\\\\[""\\\\]")mathDisplayWith::String->String->MarkdownParserStringmathDisplayWithopcl=try$dostringopmany1Till(noneOf"\n"<|>(newline>>~notFollowedBy'blankline))(try$stringcl)mathInline::MarkdownParserStringmathInline=(guardEnabledExt_tex_math_dollars>>mathInlineWith"$""$")<|>(guardEnabledExt_tex_math_single_backslash>>mathInlineWith"\\(""\\)")<|>(guardEnabledExt_tex_math_double_backslash>>mathInlineWith"\\\\(""\\\\)")mathInlineWith::String->String->MarkdownParserStringmathInlineWithopcl=try$dostringopnotFollowedByspacewords'<-many1Till(count1(noneOf"\n\\")<|>(char'\\'>>anyChar>>=\c->return['\\',c])<|>count1newline<*notFollowedBy'blankline*>return" ")(try$stringcl)notFollowedBydigit-- to prevent capture of $5return$concatwords'-- to avoid performance problems, treat 4 or more _ or * or ~ or ^ in a row-- as a literal rather than attempting to parse for emph/strong/strikeout/super/subfours::Parser[Char]st(FInlines)fours=try$dox<-char'*'<|>char'_'<|>char'~'<|>char'^'count2$satisfy(==x)rest<-many1(satisfy(==x))return$return$B.str(x:x:x:rest)-- | Parses a list of inlines between start and end delimiters.inlinesBetween::(Showb)=>MarkdownParsera->MarkdownParserb->MarkdownParser(FInlines)inlinesBetweenstartend=(trimInlinesF.mconcat)<$>try(start>>many1Tillinnerend)whereinner=innerSpace<|>(notFollowedBy'(()<$whitespace)>>inline)innerSpace=try$whitespace>>~notFollowedBy'endemph::MarkdownParser(FInlines)emph=fmapB.emph<$>nested(inlinesBetweenstarStartstarEnd<|>inlinesBetweenulStartulEnd)wherestarStart=char'*'>>lookAheadnonspaceCharstarEnd=notFollowedBy'(()<$strong)>>char'*'ulStart=char'_'>>lookAheadnonspaceCharulEnd=notFollowedBy'(()<$strong)>>char'_'strong::MarkdownParser(FInlines)strong=fmapB.strong<$>nested(inlinesBetweenstarStartstarEnd<|>inlinesBetweenulStartulEnd)wherestarStart=string"**">>lookAheadnonspaceCharstarEnd=try$string"**"ulStart=string"__">>lookAheadnonspaceCharulEnd=try$string"__"strikeout::MarkdownParser(FInlines)strikeout=fmapB.strikeout<$>(guardEnabledExt_strikeout>>inlinesBetweenstrikeStartstrikeEnd)wherestrikeStart=string"~~">>lookAheadnonspaceChar>>notFollowedBy(char'~')strikeEnd=try$string"~~"superscript::MarkdownParser(FInlines)superscript=fmapB.superscript<$>try(doguardEnabledExt_superscriptchar'^'mconcat<$>many1Till(notFollowedByspaceChar>>inline)(char'^'))subscript::MarkdownParser(FInlines)subscript=fmapB.subscript<$>try(doguardEnabledExt_subscriptchar'~'mconcat<$>many1Till(notFollowedByspaceChar>>inline)(char'~'))whitespace::MarkdownParser(FInlines)whitespace=spaceChar>>return<$>(lb<|>regsp)<?>"whitespace"wherelb=spaceChar>>skipManyspaceChar>>optionB.space(endline>>returnB.linebreak)regsp=skipManyspaceChar>>returnB.spacenonEndline::Parser[Char]stCharnonEndline=satisfy(/='\n')str::MarkdownParser(FInlines)str=doisSmart<-readerSmart.stateOptions<$>getStatea<-alphaNumas<-many$alphaNum<|>(guardEnabledExt_intraword_underscores>>try(char'_'>>~lookAheadalphaNum))<|>ifisSmartthen(try$satisfy(\c->c=='\''||c=='\x2019')>>lookAheadalphaNum>>return'\x2019')-- for things like l'aideelsemzeropos<-getPositionupdateState$\s->s{stateLastStrPos=Justpos}letresult=a:asletspacesToNbr=map(\c->ifc==' 'then'\160'elsec)ifisSmartthencaselikelyAbbrevresultof[]->return$return$B.strresultxs->choice(map(\x->try(stringx>>oneOf" \n">>lookAheadalphaNum>>return(return$B.str$result++spacesToNbrx++"\160")))xs)<|>(return$return$B.strresult)elsereturn$return$B.strresult-- | if the string matches the beginning of an abbreviation (before-- the first period, return strings that would finish the abbreviation.likelyAbbrev::String->[String]likelyAbbrevx=letabbrevs=["Mr.","Mrs.","Ms.","Capt.","Dr.","Prof.","Gen.","Gov.","e.g.","i.e.","Sgt.","St.","vol.","vs.","Sen.","Rep.","Pres.","Hon.","Rev.","Ph.D.","M.D.","M.A.","p.","pp.","ch.","sec.","cf.","cp."]abbrPairs=map(break(=='.'))abbrevsinmapsnd$filter(\(y,_)->y==x)abbrPairs-- an endline character that can be treated as a space, not a structural breakendline::MarkdownParser(FInlines)endline=try$donewlinenotFollowedByblanklineguardEnabledExt_blank_before_blockquote<|>notFollowedByemailBlockQuoteStartguardEnabledExt_blank_before_header<|>notFollowedBy(char'#')-- atx header-- parse potential list-starts differently if in a list:st<-getStatewhen(stateParserContextst==ListItemState)$donotFollowedBy'bulletListStartnotFollowedBy'anyOrderedListStart(guardEnabledExt_hard_line_breaks>>return(returnB.linebreak))<|>(return$returnB.space)---- links---- a reference label for a linkreference::MarkdownParser(FInlines,String)reference=donotFollowedBy'(string"[^")-- footnote referencewithRaw$trimInlinesF<$>inlinesInBalancedBrackets-- source for a link, with optional titlesource::MarkdownParser(String,String)source=dochar'('skipSpacesleturlChunk=try$notFollowedBy(oneOf"\"')")>>(charsInBalanced'('')'litChar<|>count1litChar)letsourceURL=(unwords.words.concat)<$>manyurlChunkletbetweenAngles=try$char'<'>>manyTilllitChar(char'>')src<-trybetweenAngles<|>sourceURLtit<-option""$try$spnl>>linkTitleskipSpaceschar')'return(escapeURI$trimrsrc,tit)linkTitle::MarkdownParserStringlinkTitle=fromEntities<$>(quotedTitle'"'<|>quotedTitle'\'')link::MarkdownParser(FInlines)link=try$dost<-getStateguard$stateAllowLinksstsetState$st{stateAllowLinks=False}(lab,raw)<-referencesetState$st{stateAllowLinks=True}regLinkB.linklab<|>referenceLinkB.link(lab,raw)regLink::(String->String->Inlines->Inlines)->FInlines->MarkdownParser(FInlines)regLinkconstructorlab=try$do(src,tit)<-sourcereturn$constructorsrctit<$>lab-- a link like [this][ref] or [this][] or [this]referenceLink::(String->String->Inlines->Inlines)->(FInlines,String)->MarkdownParser(FInlines)referenceLinkconstructor(lab,raw)=do(ref,raw')<-try(optional(char' ')>>optional(newline>>skipSpaces)>>reference)<|>return(mempty,"")letlabIsRef=raw'==""||raw'=="[]"letkey=toKey$iflabIsRefthenrawelseraw'letdropRB(']':xs)=xsdropRBxs=xsletdropLB('[':xs)=xsdropLBxs=xsletdropBrackets=reverse.dropRB.reverse.dropLBfallback<-parseFromString(mconcat<$>manyinline)$dropBracketsrawimplicitHeaderRefs<-optionFalse$True<$guardEnabledExt_implicit_header_referencesreturn$dokeys<-asksFstateKeyscaseM.lookupkeykeysofNothing->doheaders<-asksFstateHeadersletref'=B.toList$runF(iflabIsRefthenlabelseref)defaultParserStateifimplicitHeaderRefs&&ref'`elem`headersthendoletsrc='#':uniqueIdentref'[]constructorsrc""<$>labelse(\x->B.str"["<>x<>B.str"]"<>B.strraw')<$>fallbackJust(src,tit)->constructorsrctit<$>labbareURL::MarkdownParser(FInlines)bareURL=try$doguardEnabledExt_autolink_bare_uris(orig,src)<-uri<|>emailAddressreturn$return$B.linksrc""(B.strorig)autoLink::MarkdownParser(FInlines)autoLink=try$dochar'<'(orig,src)<-uri<|>emailAddresschar'>'return$return$B.linksrc""(B.strorig)image::MarkdownParser(FInlines)image=try$dochar'!'(lab,raw)<-referenceregLinkB.imagelab<|>referenceLinkB.image(lab,raw)note::MarkdownParser(FInlines)note=try$doguardEnabledExt_footnotesref<-noteMarkerreturn$donotes<-asksFstateNotes'caselookuprefnotesofNothing->return$B.str$"[^"++ref++"]"Justcontents->dost<-askF-- process the note in a context that doesn't resolve-- notes, to avoid infinite looping with notes inside-- notes:letcontents'=runFcontentsst{stateNotes'=[]}return$B.notecontents'inlineNote::MarkdownParser(FInlines)inlineNote=try$doguardEnabledExt_inline_noteschar'^'contents<-inlinesInBalancedBracketsreturn$B.note.B.para<$>contentsrawLaTeXInline'::MarkdownParser(FInlines)rawLaTeXInline'=try$doguardEnabledExt_raw_texlookAhead$char'\\'>>notFollowedBy'(string"start")-- context envRawInline_s<-rawLaTeXInlinereturn$return$B.rawInline"tex"s-- "tex" because it might be context or latexrawConTeXtEnvironment::Parser[Char]stStringrawConTeXtEnvironment=try$dostring"\\start"completion<-inBrackets(letter<|>digit<|>spaceChar)<|>(many1letter)contents<-manyTill(rawConTeXtEnvironment<|>(count1anyChar))(try$string"\\stop">>stringcompletion)return$"\\start"++completion++concatcontents++"\\stop"++completioninBrackets::(Parser[Char]stChar)->Parser[Char]stStringinBracketsparser=dochar'['contents<-manyparserchar']'return$"["++contents++"]"rawHtmlInline::MarkdownParser(FInlines)rawHtmlInline=doguardEnabledExt_raw_htmlmdInHtml<-optionFalse$guardEnabledExt_markdown_in_html_blocks>>returnTrue(_,result)<-ifmdInHtmlthenhtmlTagisInlineTagelsehtmlTag(not.isTextTag)return$return$B.rawInline"html"result-- Citationscite::MarkdownParser(FInlines)cite=doguardEnabledExt_citationsgetOptionreaderReferences>>=guard.not.nullcitations<-textualCite<|>normalCitereturn$flipB.citemempty<$>citationstextualCite::MarkdownParser(F[Citation])textualCite=try$do(_,key)<-citeKeyletfirst=Citation{citationId=key,citationPrefix=[],citationSuffix=[],citationMode=AuthorInText,citationNoteNum=0,citationHash=0}mbrest<-optionNothing$try$spnl>>Just<$>normalCitecasembrestofJustrest->return$(first:)<$>restNothing->option(return[first])$barelocfirstbareloc::Citation->MarkdownParser(F[Citation])barelocc=try$dospnlchar'['suff<-suffixrest<-option(return[])$try$char';'>>citeListspnlchar']'return$dosuff'<-suffrest'<-restreturn$c{citationSuffix=B.toListsuff'}:rest'normalCite::MarkdownParser(F[Citation])normalCite=try$dochar'['spnlcitations<-citeListspnlchar']'returncitationsciteKey::MarkdownParser(Bool,String)citeKey=try$dosuppress_author<-optionFalse(char'-'>>returnTrue)char'@'first<-letterletinternalp=try$p>>~lookAhead(letter<|>digit)rest<-many$letter<|>digit<|>internal(oneOf":.#$%&-_?<>~/")letkey=first:restcitations'<-mapCSL.refId<$>getOptionreaderReferencesguard$key`elem`citations'return(suppress_author,key)suffix::MarkdownParser(FInlines)suffix=try$dohasSpace<-optionFalse(notFollowedBynonspaceChar>>returnTrue)spnlrest<-trimInlinesF.mconcat<$>many(notFollowedBy(oneOf";]")>>inline)return$ifhasSpacethen(B.space<>)<$>restelserestprefix::MarkdownParser(FInlines)prefix=trimInlinesF.mconcat<$>manyTillinline(char']'<|>liftM(const']')(lookAheadciteKey))citeList::MarkdownParser(F[Citation])citeList=fmapsequence$sepBy1citation(try$char';'>>spnl)citation::MarkdownParser(FCitation)citation=try$dopref<-prefix(suppress_author,key)<-citeKeysuff<-suffixreturn$dox<-prefy<-suffreturn$Citation{citationId=key,citationPrefix=B.toListx,citationSuffix=B.toListy,citationMode=ifsuppress_authorthenSuppressAuthorelseNormalCitation,citationNoteNum=0,citationHash=0}smart::MarkdownParser(FInlines)smart=dogetOptionreaderSmart>>=guarddoubleQuoted<|>singleQuoted<|>choice(map(return.B.singleton<$>)[apostrophe,dash,ellipses])singleQuoted::MarkdownParser(FInlines)singleQuoted=try$dosingleQuoteStartwithQuoteContextInSingleQuote$fmapB.singleQuoted.trimInlinesF.mconcat<$>many1TillinlinesingleQuoteEnddoubleQuoted::MarkdownParser(FInlines)doubleQuoted=try$dodoubleQuoteStartwithQuoteContextInDoubleQuote$fmapB.doubleQuoted.trimInlinesF.mconcat<$>many1TillinlinedoubleQuoteEnd