{-# 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-2013 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.DefinitionimportqualifiedData.TextasTimportData.Text(Text)importqualifiedData.YamlasYamlimportData.Yaml(ParseException(..),YamlException(..),YamlMark(..))importqualifiedData.HashMap.StrictasHimportqualifiedText.Pandoc.BuilderasBimportqualifiedText.Pandoc.UTF8asUTF8importqualifiedData.VectorasVimportText.Pandoc.Builder(Inlines,Blocks,trimInlines,(<>))importText.Pandoc.OptionsimportText.Pandoc.SharedimportText.Pandoc.XML(fromEntities)importText.Pandoc.Parsinghiding(tableWith)importText.Pandoc.Readers.LaTeX(rawLaTeXInline,rawLaTeXBlock)importText.Pandoc.Readers.HTML(htmlTag,htmlInBalanced,isInlineTag,isBlockTag,isTextTag,isCommentTag)importData.Monoid(mconcat,mempty)importControl.Applicative((<$>),(<*),(*>),(<$))importControl.MonadimportSystem.FilePath(takeExtension,addExtension)importText.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'<|>characterReference<|>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()titleBlock=pandocTitleBlock<|>mmdTitleBlockpandocTitleBlock::MarkdownParser()pandocTitleBlock=try$doguardEnabledExt_pandoc_title_blocklookAhead(char'%')title<-optionmemptytitleLineauthor<-option(return[])authorsLinedate<-optionmemptydateLineoptionalblanklinesletmeta'=dotitle'<-titleauthor'<-authordate'<-datereturn$(ifB.isNulltitle'thenidelseB.setMeta"title"title'.ifnullauthor'thenidelseB.setMeta"author"author'.ifB.isNulldate'thenidelseB.setMeta"date"date')nullMetaupdateState$\st->st{stateMeta'=stateMeta'st<>meta'}yamlMetaBlock::MarkdownParser(FBlocks)yamlMetaBlock=try$doguardEnabledExt_yaml_metadata_blockpos<-getPositionstring"---"blanklinerawYamlLines<-manyTillanyLinestopLine-- by including --- and ..., we allow yaml blocks with just comments:letrawYaml=unlines("---":(rawYamlLines++["..."]))optionalblanklinesopts<-stateOptions<$>getStatemeta'<-caseYaml.decodeEither'$UTF8.fromStringrawYamlofRight(Yaml.Objecthashmap)->return$return$H.foldrWithKey(\kvm->ifignorablekthenmelseB.setMeta(T.unpackk)(yamlToMetaoptsv)m)nullMetahashmapRightYaml.Null->return$returnnullMetaRight_->doaddWarning(Justpos)"YAML header is not an object"return$returnnullMetaLefterr'->docaseerr'ofInvalidYaml(JustYamlParseException{yamlProblem=problem,yamlContext=_ctxt,yamlProblemMark=Yaml.YamlMark{yamlLine=yline,yamlColumn=ycol}})->addWarning(Just$setSourceLine(setSourceColumnpos(sourceColumnpos+ycol))(sourceLinepos+1+yline))$"Could not parse YAML header: "++problem_->addWarning(Justpos)$"Could not parse YAML header: "++showerr'return$returnnullMetaupdateState$\st->st{stateMeta'=stateMeta'st<>meta'}returnmempty-- ignore fields ending with _ignorable::Text->Boolignorablet=(T.pack"_")`T.isSuffixOf`ttoMetaValue::ReaderOptions->Text->MetaValuetoMetaValueoptsx=casereadMarkdownopts(T.unpackx)ofPandoc_[Plainxs]->MetaInlinesxsPandoc_[Paraxs]|endsWithNewlinex->MetaBlocks[Paraxs]|otherwise->MetaInlinesxsPandoc_bs->MetaBlocksbswhereendsWithNewlinet=(T.pack"\n")`T.isSuffixOf`tyamlToMeta::ReaderOptions->Yaml.Value->MetaValueyamlToMetaopts(Yaml.Stringt)=toMetaValueoptstyamlToMeta_(Yaml.Numbern)=MetaString$shownyamlToMeta_(Yaml.Boolb)=MetaBoolbyamlToMetaopts(Yaml.Arrayxs)=B.toMetaValue$map(yamlToMetaopts)$V.toListxsyamlToMetaopts(Yaml.Objecto)=MetaMap$H.foldrWithKey(\kvm->ifignorablekthenmelseM.insert(T.unpackk)(yamlToMetaoptsv)m)M.emptyoyamlToMeta__=MetaString""stopLine::MarkdownParser()stopLine=try$(string"---"<|>string"...")>>blankline>>return()mmdTitleBlock::MarkdownParser()mmdTitleBlock=try$doguardEnabledExt_mmd_title_blockkvPairs<-many1kvPairblanklinesupdateState$\st->st{stateMeta'=stateMeta'st<>return(Meta$M.fromListkvPairs)}kvPair::MarkdownParser(String,MetaValue)kvPair=try$dokey<-many1Till(alphaNum<|>oneOf"_- ")(char':')val<-manyTillanyChar(try$newline>>lookAhead(blankline<|>nonspaceChar))letkey'=concat$words$maptoLowerkeyletval'=MetaBlocks$B.toList$B.plain$B.text$trimvalreturn(key',val')parseMarkdown::MarkdownParserPandocparseMarkdown=do-- markdown allows raw HTMLupdateState$\state->state{stateOptions=letoldOpts=stateOptionsstateinoldOpts{readerParseRaw=True}}optionaltitleBlockblocks<-parseBlocksst<-getStateletmeta=runF(stateMeta'st)stletPandoc_bs=B.doc$runFblocksstreturn$PandocmetabsaddWarning::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$notFollowedByspace>>litCharletbetweenAngles=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>>skipSpacesquotedTitle'"'<|>quotedTitle'\''<|>charsInBalanced'('')'litChar-- 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[mempty<$blanklines,codeBlockFenced,yamlMetaBlock,guardEnabledExt_latex_macros*>(macro>>=return.return),header,lhsCodeBlock,rawTeXBlock,divHtml,htmlBlock,table,lineBlock,codeBlockIndented,blockQuote,hrule,bulletList,orderedList,definitionList,noteBlock,referenceKey,abbrevKey,para,plain]<?>"block"---- header blocks--header::MarkdownParser(FBlocks)header=setextHeader<|>atxHeader<?>"header"atxHeader::MarkdownParser(FBlocks)atxHeader=try$dolevel<-many1(char'#')>>=return.lengthnotFollowedBy$guardEnabledExt_fancy_lists>>(char'.'<|>char')')-- this would be a listskipSpacestext<-trimInlinesF.mconcat<$>many(notFollowedByatxClosing>>inline)attr<-atxClosingattr'<-registerHeaderattr(runFtextdefaultParserState)return$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'<-registerHeaderattr(runFtextdefaultParserState)return$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>>anyLine>>=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::MarkdownParserAttrattributes=try$dochar'{'spnlattrs<-many(attribute>>~spnl)char'}'return$foldl(\xf->fx)nullAttrattrsattribute::MarkdownParser(Attr->Attr)attribute=identifierAttr<|>classAttr<|>keyValAttr<|>specialAttridentifier::MarkdownParserStringidentifier=dofirst<-letterrest<-many$alphaNum<|>oneOf"-_:."return(first:rest)identifierAttr::MarkdownParser(Attr->Attr)identifierAttr=try$dochar'#'result<-identifierreturn$\(_,cs,kvs)->(result,cs,kvs)classAttr::MarkdownParser(Attr->Attr)classAttr=try$dochar'.'result<-identifierreturn$\(id',cs,kvs)->(id',cs++[result],kvs)keyValAttr::MarkdownParser(Attr->Attr)keyValAttr=try$dokey<-identifierchar'='val<-enclosed(char'"')(char'"')litChar<|>enclosed(char'\'')(char'\'')litChar<|>many(escapedChar'<|>noneOf" \t\n\r}")return$\(id',cs,kvs)->(id',cs,kvs++[(key,val)])specialAttr::MarkdownParser(Attr->Attr)specialAttr=dochar'-'return$\(id',cs,kvs)->(id',cs++["unnumbered"],kvs)codeBlockFenced::MarkdownParser(FBlocks)codeBlockFenced=try$doc<-try(guardEnabledExt_fenced_code_blocks>>lookAhead(char'~'))<|>(guardEnabledExt_backtick_code_blocks>>lookAhead(char'`'))size<-blockDelimiter(==c)NothingskipManyspaceCharattr<-option([],[],[])$try(guardEnabledExt_fenced_code_attributes>>attributes)<|>((\x->("",[x],[]))<$>identifier)blanklinecontents<-manyTillanyLine(blockDelimiter(==c)(Justsize))blanklinesreturn$return$B.codeBlockWithattr$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=='<')$notFollowedByletteranyLine---- 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-- parse raw text for one list item, excluding start marker and continuationsrawListItem::MarkdownParsera->MarkdownParserStringrawListItemstart=try$dostartfirst<-listLinerest<-many(notFollowedBylistStart>>listLine)blanks<-manyblanklinereturn$unlines(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<-anyLinereturn$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$do-- 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=doguardEnabledExt_definition_listsitems<-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)<|>(guardEnabledExt_backtick_code_blocks>>()<$lookAheadcodeBlockFenced)<|>(guardDisabledExt_blank_before_header>>()<$lookAheadheader)<|>(guardEnabledExt_lists_without_preceding_blankline>>()<$lookAheadlistStart)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---- 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)""elsemapunwordsrawHeadsListheads<-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)""elsemapunwords$transpose$map(gridTableSplitLineindices)rawContentheads<-fmapsequence$mapM(parseFromStringparseBlocks.trim)rawHeadsreturn(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(parseFromStringparseBlocks)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<$>many1pipeTableRowletwidths=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=try$doskipManyspaceCharleft<-optionMaybe(char':')many1(char'-')right<-optionMaybe(char':')skipManyspaceCharreturn$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=doinp<-getInputcasebreak(\c->c=='\n'||c=='|')inpof(_,'|':_)->return()_->mzero-- | 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,strongOrEmph,note,cite,link,image,math,strikeout,subscript,superscript,inlineNote-- after superscript because of ^[link](/foo)^,autoLink,spanHtml,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'-- Parses material enclosed in *s, **s, _s, or __s.-- Designed to avoid backtracking.enclosure::Char->MarkdownParser(FInlines)enclosurec=docs<-many1(charc)(return(B.strcs)<>)<$>whitespace<|>caselengthcsof3->threec2->twocmempty1->onecmempty_->return(return$B.strcs)-- Parse inlines til you hit one c or a sequence of two cs.-- If one c, emit emph and then parse two.-- If two cs, emit strong and then parse one.three::Char->MarkdownParser(FInlines)threec=docontents<-mconcat<$>many(notFollowedBy(charc)>>inline)(try(string[c,c,c])>>return((B.strong.B.emph)<$>contents))<|>(try(string[c,c])>>onec(B.strong<$>contents))<|>(charc>>twoc(B.emph<$>contents))<|>return(return(B.str[c,c,c])<>contents)-- Parse inlines til you hit two c's, and emit strong.-- If you never do hit two cs, emit ** plus inlines parsed.two::Char->FInlines->MarkdownParser(FInlines)twocprefix'=doletender=try$string[c,c]contents<-mconcat<$>many(try$notFollowedByender>>inline)(ender>>return(B.strong<$>(prefix'<>contents)))<|>return(return(B.str[c,c])<>(prefix'<>contents))-- Parse inlines til you hit a c, and emit emph.-- If you never hit a c, emit * plus inlines parsed.one::Char->FInlines->MarkdownParser(FInlines)onecprefix'=docontents<-mconcat<$>many((notFollowedBy(charc)>>inline)<|>try(string[c,c]>>notFollowedBy(charc)>>twocprefix'))(charc>>return(B.emph<$>(prefix'<>contents)))<|>return(return(B.str[c])<>(prefix'<>contents))strongOrEmph::MarkdownParser(FInlines)strongOrEmph=enclosure'*'<|>(checkIntraword>>enclosure'_')wherecheckIntraword=doexts<-getOptionreaderExtensionswhen(Ext_intraword_underscores`Set.member`exts)$dopos<-getPositionlastStrPos<-stateLastStrPos<$>getStateguard$lastStrPos/=Justpos-- | 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'endstrikeout::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=doresult<-many1alphaNumpos<-getPositionupdateState$\s->s{stateLastStrPos=Justpos}letspacesToNbr=map(\c->ifc==' 'then'\160'elsec)isSmart<-getOptionreaderSmartifisSmartthencaselikelyAbbrevresultof[]->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$donewlinenotFollowedByblanklineguardDisabledExt_lists_without_preceding_blankline<|>notFollowedBylistStartguardEnabledExt_blank_before_blockquote<|>notFollowedByemailBlockQuoteStartguardEnabledExt_blank_before_header<|>notFollowedBy(char'#')-- atx headerguardEnabledExt_backtick_code_blocks>>notFollowedBy(()<$(lookAhead(char'`')>>codeBlockFenced))-- parse potential list-starts differently if in a list:st<-getStatewhen(stateParserContextst==ListItemState)$donotFollowedBy'bulletListStartnotFollowedBy'anyOrderedListStart(guardEnabledExt_hard_line_breaks>>return(returnB.linebreak))<|>(guardEnabledExt_ignore_line_breaks>>returnmempty)<|>(return$returnB.space)---- links---- a reference label for a linkreference::MarkdownParser(FInlines,String)reference=donotFollowedBy'(string"[^")-- footnote referencewithRaw$trimInlinesF<$>inlinesInBalancedBracketsparenthesizedChars::MarkdownParser[Char]parenthesizedChars=doresult<-charsInBalanced'('')'litCharreturn$'(':result++")"-- source for a link, with optional titlesource::MarkdownParser(String,String)source=dochar'('skipSpacesleturlChunk=try$notFollowedBy(oneOf"\"')")>>(parenthesizedChars<|>count1litChar)letsourceURL=(unwords.words.concat)<$>manyurlChunkletbetweenAngles=try$char'<'>>manyTilllitChar(char'>')src<-trybetweenAngles<|>sourceURLtit<-option""$try$spnl>>linkTitleskipSpaceschar')'return(escapeURI$trimrsrc,tit)linkTitle::MarkdownParserStringlinkTitle=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)=dosp<-(True<$lookAhead(char' '))<|>returnFalse(ref,raw')<-try(skipSpaces>>optional(newline>>skipSpaces)>>reference)<|>return(mempty,"")letlabIsRef=raw'==""||raw'=="[]"letkey=toKey$iflabIsRefthenrawelseraw'parsedRaw<-parseFromString(mconcat<$>manyinline)raw'fallback<-parseFromString(mconcat<$>manyinline)$dropBracketsrawimplicitHeaderRefs<-optionFalse$True<$guardEnabledExt_implicit_header_referencesletmakeFallback=doparsedRaw'<-parsedRawfallback'<-fallbackreturn$B.str"["<>fallback'<>B.str"]"<>(ifsp&&not(nullraw)thenB.spaceelsemempty)<>parsedRaw'return$dokeys<-asksFstateKeyscaseM.lookupkeykeysofNothing->doheaders<-asksFstateHeadersref'<-iflabIsRefthenlabelserefifimplicitHeaderRefsthencaseM.lookupref'headersofJustident->constructor('#':ident)""<$>labNothing->makeFallbackelsemakeFallbackJust(src,tit)->constructorsrctit<$>labdropBrackets::String->StringdropBrackets=reverse.dropRB.reverse.dropLBwheredropRB(']':xs)=xsdropRBxs=xsdropLB('[':xs)=xsdropLBxs=xsbareURL::MarkdownParser(FInlines)bareURL=try$doguardEnabledExt_autolink_bare_uris(orig,src)<-uri<|>emailAddressnotFollowedBy$try$spaces>>htmlTag(~==TagClose"a")return$return$B.linksrc""(B.strorig)autoLink::MarkdownParser(FInlines)autoLink=try$dochar'<'(orig,src)<-uri<|>emailAddress-- in rare cases, something may remain after the uri parser-- is finished, because the uri parser tries to avoid parsing-- final punctuation. for example: in `<http://hi---there>`,-- the URI parser will stop before the dashes.extra<-fromEntities<$>manyTillnonspaceChar(char'>')return$return$B.link(src++escapeURIextra)""(B.str$orig++extra)image::MarkdownParser(FInlines)image=try$dochar'!'(lab,raw)<-referencedefaultExt<-getOptionreaderDefaultImageExtensionletconstructorsrc=casetakeExtensionsrcof""->B.image(addExtensionsrcdefaultExt)_->B.imagesrcregLinkconstructorlab<|>referenceLinkconstructor(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++"]"spanHtml::MarkdownParser(FInlines)spanHtml=try$doguardEnabledExt_markdown_in_html_blocks(TagOpen_attrs,_)<-htmlTag(~==TagOpen"span"[])contents<-mconcat<$>manyTillinline(htmlTag(~==TagClose"span"))letident=maybe""id$lookup"id"attrsletclasses=maybe[]words$lookup"class"attrsletkeyvals=[(k,v)|(k,v)<-attrs,k/="id"&&k/="class"]return$B.spanWith(ident,classes,keyvals)<$>contentsdivHtml::MarkdownParser(FBlocks)divHtml=try$doguardEnabledExt_markdown_in_html_blocks(TagOpen_attrs,_)<-htmlTag(~==TagOpen"div"[])contents<-mconcat<$>manyTillblock(htmlTag(~==TagClose"div"))letident=maybe""id$lookup"id"attrsletclasses=maybe[]words$lookup"class"attrsletkeyvals=[(k,v)|(k,v)<-attrs,k/="id"&&k/="class"]return$B.divWith(ident,classes,keyvals)<$>contentsrawHtmlInline::MarkdownParser(FInlines)rawHtmlInline=doguardEnabledExt_raw_htmlmdInHtml<-optionFalse$guardEnabledExt_markdown_in_html_blocks>>returnTrue(_,result)<-htmlTag$ifmdInHtmlthenisInlineTagelsenot.isTextTagreturn$return$B.rawInline"html"result-- Citationscite::MarkdownParser(FInlines)cite=doguardEnabledExt_citationscitations<-textualCite<|>do(cs,raw)<-withRawnormalCitereturn$(flipB.cite(B.textraw))<$>csreturncitationstextualCite::MarkdownParser(FInlines)textualCite=try$do(_,key)<-citeKeyletfirst=Citation{citationId=key,citationPrefix=[],citationSuffix=[],citationMode=AuthorInText,citationNoteNum=0,citationHash=0}mbrest<-optionNothing$try$spnl>>Just<$>withRawnormalCitecasembrestofJust(rest,raw)->return$(flipB.cite(B.text$'@':key++" "++raw).(first:))<$>restNothing->(do(cs,raw)<-withRaw$barelocfirstreturn$(flipB.cite(B.text$'@':key++" "++raw))<$>cs)<|>return(dost<-askFreturn$caseM.lookupkey(stateExamplesst)ofJustn->B.str(shown)_->B.cite[first]$B.str$'@':key)bareloc::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$do-- make sure we're not right after an alphanumeric,-- since foo@bar.baz is probably an email addresslastStrPos<-stateLastStrPos<$>getStatepos<-getPositionguard$lastStrPos/=Justpossuppress_author<-optionFalse(char'-'>>returnTrue)char'@'first<-letterletinternalp=try$p>>~lookAhead(letter<|>digit)rest<-many$letter<|>digit<|>internal(oneOf":.#$%&-_+?<>~/")letkey=first:restreturn(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<$>many1TillinlinesingleQuoteEnd-- doubleQuoted will handle regular double-quoted sections, as well-- as dialogues with an open double-quote without a close double-quote-- in the same paragraph.doubleQuoted::MarkdownParser(FInlines)doubleQuoted=try$dodoubleQuoteStartcontents<-mconcat<$>many(try$notFollowedBydoubleQuoteEnd>>inline)(withQuoteContextInDoubleQuote$doubleQuoteEnd>>return(fmapB.doubleQuoted.trimInlinesF$contents))<|>(return$return(B.str"\8220")<>contents)