Class {
	#name : 'PPCommonMarkBlockParser',
	#superclass : 'PPCompositeParser',
	#instVars : [
		'space',
		'lineEnd',
		'linePrefix',
		'indentedCode',
		'fencedCode',
		'codeFirstFenceIndent',
		'newline',
		'codeFenceStart',
		'infoString',
		'prefix',
		'codeFenceStop',
		'codeFenceIndent',
		'codeLine',
		'prefixedEmptyLine',
		'documentEnd',
		'codeIndent',
		'emptyLine',
		'contentElement',
		'horizontalRule',
		'quoteBlock',
		'code',
		'list',
		'htmlBlock',
		'header',
		'linkRefDef',
		'paragraph',
		'document',
		'ATXHeader',
		'setextHeader',
		'setexLine',
		'setextHeaderUnderline',
		'listItem',
		'htmlTag',
		'plainLine',
		'quoteDedent',
		'quote',
		'listBegin',
		'listEmptyItem',
		'listEnd',
		'listOrderedMarker',
		'listBulletMarker',
		'listMarker',
		'listDoubleBlanks',
		'listBullet',
		'listContent',
		'listItemEnd',
		'quoteIndent',
		'paragraphLine',
		'lazyParagraphPrefix',
		'content',
		'linkLabel',
		'linkDestination',
		'linkTitle',
		'lineStart',
		'linkQuoteStart',
		'linkQuoteStop',
		'htmlBlockLine',
		'abstractLinkTitle'
	],
	#category : 'PetitMarkdown-Parser'
}

{ #category : 'headers' }
PPCommonMarkBlockParser >> ATXHeader [
	| begin end title  |
	begin := (($# asParser plus) setMax: 6).
	end := ((space, $# asParser plus) optional trimRight: space), lineEnd.

	title := end negate plus flatten asPPCMPlainLine.
	
	^ linePrefix, begin, (end not, space, title ==> #last) optional, end
	
	map: [ :_lp :level :_titleLine :_end |
		| size titleLine |
		size := level size.
		titleLine := _titleLine ifNil: [ PPCMPlainLine empty ].

		PPCMHeader new
			level: size;
			title: titleLine;
			yourself 
	]
]

{ #category : 'links' }
PPCommonMarkBlockParser >> abstractLinkTitle [
	^ 	(space preceeds / lineStart),   
		linkQuoteStart, 
			( (linkQuoteStop / (lineEnd, emptyLine)) not, 
			  (('\' asParser, linkQuoteStop) / #any asParser)
			) plus flatten,
		linkQuoteStop	
				
	==> [ :e | self decodeEntities: (self escape: (e third)) ]
]

{ #category : 'code' }
PPCommonMarkBlockParser >> code [
	^ indentedCode / fencedCode
]

{ #category : 'code' }
PPCommonMarkBlockParser >> codeFenceIndent [
	^ [ :context |
		context codeFenceIndent parseOn: context
	] asParser
]

{ #category : 'code' }
PPCommonMarkBlockParser >> codeFenceStart [
	| tilde eh |
	tilde := ($~ asParser min: 3) >=> [ :context :cc |
		| retval |
		retval := cc value.
		retval isPetitFailure ifFalse: [ 
			context codeFence: ($~ asParser min: retval size).
		].
		retval
	].

	eh := ($` asParser min: 3) >=> [ :context :cc |
		| retval |
		retval := cc value.
		retval isPetitFailure ifFalse: [ 
			context codeFence: ($` asParser min: retval size).
		].
		retval
	].

	^ codeFirstFenceIndent, (tilde / eh)

]

{ #category : 'code' }
PPCommonMarkBlockParser >> codeFenceStop [
	^ ([ :context |
		context codeFence parseOn: context
	] asParser trimRight: space), lineEnd and
]

{ #category : 'code' }
PPCommonMarkBlockParser >> codeFirstFenceIndent [
	^ (space max: 3) >=> [ :context :cc | 
		| result |
		result := cc value.
		result isPetitFailure ifFalse: [ 
			context codeFenceIndent: (space max: result size).
		].
		result
	]
]

{ #category : 'code' }
PPCommonMarkBlockParser >> codeIndent [
	^ '    ' asParser / Character tab asParser
]

{ #category : 'code' }
PPCommonMarkBlockParser >> codeLine [
	^ newline negate star flatten
	
	map: [ :_text |
		| textNode |
		textNode := PPCMText new
			text: (self encodeEntities: _text);
			yourself.
			
		PPCMLine new
			addChild: textNode;
			yourself
	]
]

{ #category : 'document' }
PPCommonMarkBlockParser >> content [
	^ contentElement,
	((prefix, contentElement) nonEmpty ==> #second) star
	
	map: [ :first :rest |
		|  |
		PPCMContainer new
			addChild: first;
			addChildren: rest;
			yourself	
	] 
]

{ #category : 'document' }
PPCommonMarkBlockParser >> contentElement [
	^ 	
		horizontalRule /
		quoteBlock /
		code /
		list /
		htmlBlock /
		header /
		linkRefDef /
		paragraph /
		((emptyLine, lineEnd) ==> #first)
]

{ #category : 'support' }
PPCommonMarkBlockParser >> decodeEntities: string [
	^ PPCommonMarkUtils instance decodeEntities: string
]

{ #category : 'document' }
PPCommonMarkBlockParser >> document [
	^ ((prefix, contentElement) nonEmpty ==> #second) star
	
	map: [ :elems |
		PPCMDocument new
			addChildren: elems;
			yourself
	]
]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> documentEnd [
	^ #eof asParser
]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> emptyLine [
	^ space star, #endOfLine asParser ==> [ :e | 
		PPCMPlainLine empty
	]
]

{ #category : 'support' }
PPCommonMarkBlockParser >> encodeEntities: string [
	^ PPCommonMarkUtils instance encodeEntities: string
]

{ #category : 'support' }
PPCommonMarkBlockParser >> escape: string [
		^ PPCommonMarkUtils instance escape: string
]

{ #category : 'support' }
PPCommonMarkBlockParser >> escapeUrl: string [
	^ PPCommonMarkUtils instance escapeUrl: string
]

{ #category : 'code' }
PPCommonMarkBlockParser >> fencedCode [
	^ linePrefix and, codeFenceStart, infoString optional, lineEnd,
	(
		((
			(prefix, linePrefix, codeFenceStop) not, prefix, codeFenceIndent, codeLine, lineEnd) ==> #fourth /
			(prefixedEmptyLine, lineEnd ==> #first)
		) nonEmpty
	) star,
	((((prefix, linePrefix, codeFenceStop) / documentEnd), lineEnd) / prefix not)
	
	map: [ :_lp :_fenceStart :_info :_le :_code :_fenceStop |
		PPCMFencedCode new
			infoString: _info;
			addChildren: _code;
			yourself
	] 
]

{ #category : 'headers' }
PPCommonMarkBlockParser >> header [
	^ ATXHeader / setextHeader
]

{ #category : 'horizontal rule' }
PPCommonMarkBlockParser >> horizontalRule [
	| stars minus under |
	stars := '*' asParser, (('*' asParser trim: space) min: 2).
	minus := '-' asParser, (('-' asParser trim: space) min: 2).
	under := '_' asParser, (('_' asParser trim: space) min: 2).
	
	^ linePrefix, ((stars / minus / under) flatten), space star, lineEnd
	map: [ :_prefix :_hrule :_space :_le |
		PPCMHrule new
			rule: _hrule;
			yourself
	]
	
]

{ #category : 'html blocks' }
PPCommonMarkBlockParser >> htmlBlock [
	^ (linePrefix, htmlTag) and, htmlBlockLine, lineEnd,
		(prefix, (emptyLine not), htmlBlockLine, lineEnd ==> #third) star
		
	map: [ :_pred :_line :_le :_rest |
		PPCMHtmlBlock new
			addChild: _line;
			addChildren: _rest;
			yourself
	]
]

{ #category : 'html blocks' }
PPCommonMarkBlockParser >> htmlBlockLine [
	^ newline negate star flatten
	
	map: [ :_text |
		| text |
		text := PPCMText new
			text: _text;
			yourself.
		
		PPCMLine new
			addChild: text;
			yourself
	]
]

{ #category : 'html blocks' }
PPCommonMarkBlockParser >> htmlTag [
	^ 	'<table' asParser /
		'<tr' asParser /
		'<td' asParser /
		'<div' asParser /
		'<DIV' asParser /
		'<p' asParser /
		'</table' asParser /
		'</tr' asParser /
		'</td' asParser /
		'</div' asParser /
		'</DIV' asParser /
		'</p' asParser	/
		'<!--' asParser /
		('<?' asParser, #letter asParser plus) /
		'<![CDATA[' asParser
]

{ #category : 'code' }
PPCommonMarkBlockParser >> indentedCode [
	^ codeIndent, emptyLine not, codeLine, lineEnd,
	(
		((prefix, codeIndent, codeLine, lineEnd) ==> #third) /
		((prefix, emptyLine, lineEnd) nonEmpty ==> #second)
	) star
	
	map: [ :_cp :_pred :_first :_le :_rest |
		PPCMIndentedCode new
			addChild: _first;
			addChildren: _rest;
			yourself
	] 
]

{ #category : 'code' }
PPCommonMarkBlockParser >> infoString [
	^	((lineEnd / space / codeFenceStop  / $` asParser) negate plus trimBlanks flatten), 
		(lineEnd  / $` asParser) negate star ==> [:e | self decodeEntities: e first ]
]

{ #category : 'paragraphs' }
PPCommonMarkBlockParser >> lazyParagraphPrefix [
	^ (prefix, quoteIndent) not,
	(quote / space) star
]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> lineEnd [
	^ newline / documentEnd
]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> linePrefix [
	^ ((PPPossessiveRepeatingParser on: (#blank asParser ))
		setMax: 3;
		yourself),
	(#blank asParser not)
	==> #first
]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> lineStart [
	^ #startOfLine asParser
]

{ #category : 'links' }
PPCommonMarkBlockParser >> linkDestination [
	| parens escapedParen |
	"TODO: fix?"
	escapedParen := '\(' asParser / '\)' asParser.
	
	parens := PPDelegateParser new
		name: 'parens';
		yourself.
	"Parens cannot be nested!"
	parens setParser: $( asParser, (($( asParser / $) asParser) not, (escapedParen / #any asParser)) star, $) asParser.
	
	^ (($< asParser, ((($> asParser / newline) not, #any asParser) star) flatten, $> asParser) 
			==> [ :e | self escapeUrl: (self escape: e second) ]) /
	  ((space / lineEnd / $) asParser) not, (parens / escapedParen / $( asParser negate)) plus flatten
			==> [ :e | self escapeUrl: (self escape: e) ]
]

{ #category : 'links' }
PPCommonMarkBlockParser >> linkLabel [
	| label |
	label := ($] asParser not, ('\]' asParser / #any asParser)) star flatten.

	^ $[ asParser, label, $] asParser
	
	map: [ :_start :_label :_end |
		PPCMText new
			text: (self escape: _label);
			yourself
	]
]

{ #category : 'links' }
PPCommonMarkBlockParser >> linkQuoteStart [
	^ PPFailingParser message: 'abstract quote start'.
]

{ #category : 'links' }
PPCommonMarkBlockParser >> linkQuoteStop [
	^ PPFailingParser message: 'abstract quote stop'
]

{ #category : 'links' }
PPCommonMarkBlockParser >> linkRefDef [
	^ (linePrefix, linkLabel, ':' asParser, (lineEnd optional trim: space), linkDestination, ((lineEnd optional trim: space), linkTitle ==> #second) optional, space star, lineEnd
	
	map: [ :_lp :_label :_semicolon :_ws1 :_dest :_title :_ws3 :_le |
		PPCMLinkRefDef new
			label: _label;
			title: _title;
			destination: _dest;
			yourself.
	])

	>=> [ :context :cc | 
		| retval |
		retval := cc value.
		retval isPetitFailure ifFalse: [ 
			context registerLink: retval.
			retval := PPCMLinkRefDefPlaceholder new.
		].
		retval
	]
]

{ #category : 'links' }
PPCommonMarkBlockParser >> linkTitle [
	^ 
	((abstractLinkTitle 
		where: linkQuoteStart is: $" asParser)
		where: linkQuoteStop is: $" asParser) /
	((abstractLinkTitle 
		where: linkQuoteStart is: $' asParser)
		where: linkQuoteStop is: $' asParser) /		
	((abstractLinkTitle 
		where: linkQuoteStart is: $( asParser)
		where: linkQuoteStop is: $) asParser)
]

{ #category : 'lists' }
PPCommonMarkBlockParser >> list [
	^ 
	listBegin,
		listItem,
		(
		 	(prefix, listItem ==> #second) / 
			"empty item is part of the list only if followed by normal item"
		 	(listEmptyItem, (prefix, listItem) and ==> #first)
		) star,
	listEnd
	
	map: [ :_start :_first :_rest :_end |
		PPCMList new
			type: _start second;
			start: _start first;
			addChild: _first;
			addChildren: _rest;
			yourself
	]
]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listBegin [
	^ (linePrefix, (listOrderedMarker / listBulletMarker)) and ==> #second >=> [ :context :cc |
		| retval |
		retval := cc value.
		retval isPetitFailure ifFalse: [
			context listItemType: (retval third).
		].
		retval
	]

]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listBullet [
	^ 
		 "push content as spaces on the indent stack"
		 (
			(linePrefix, listMarker, space, linePrefix optional) flatten and
				==> [:e | self spaces: (e size)]
			/ 
			(linePrefix, listMarker, lineEnd) flatten and
				==> [:e | self spaces: (e size)]
		 ) pushAsParser,
		 "Consume marker and one space"
 		 (linePrefix, listMarker, (space / lineEnd and))
]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listBulletMarker [
	^ 
	  ($- asParser /
		$* asParser /
		$+ asParser)

	"Start . type . parser to accept the same type"	
	==> [ :e | { nil . #unordered . e asParser } ]
]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listContent [
	^ 	
	contentElement,	
	(	
		((prefix, contentElement) nonEmpty 	==> #second) /
		"Empty line of the list content is part of the content only if followed by non-empty line"
		((prefixedEmptyLine, lineEnd, (prefix, contentElement) and) nonEmpty 
			==> #first)
	) star
	
	map: [ :_first :_rest |
		|  |
		PPCMContainer new
			addChild: _first;
			addChildren: _rest;
			yourself
	] 
]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listDoubleBlanks [
	^
		(prefixedEmptyLine, lineEnd) nonEmpty,
		(prefixedEmptyLine, lineEnd) nonEmpty

]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listEmptyItem [
	^ (listDoubleBlanks not, prefixedEmptyLine, lineEnd) nonEmpty ==> #second

]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listEnd [
	^ [ :context |
		context listItemStack pop
	] asParser

]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listItem [
	^ horizontalRule not, listBullet, listContent, listItemEnd
	
	map: [ :_pred :_bullet :_content :_end |
		PPCMListItem new
			child: _content;
			yourself
	]
	

]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listItemEnd [
	^ [ :context | context indentStack pop ] asParser
]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listMarker [
	^ [ :context | context listItemType parseOn: context ] asParser
]

{ #category : 'lists' }
PPCommonMarkBlockParser >> listOrderedMarker [
	| dot bracket |
	dot := #digit asParser plus flatten, $. asParser.
	bracket := #digit asParser plus flatten, $) asParser.

	"Start . type . parser to accept the same type"	
	^ 	(dot ==> [ :e | { e first asNumber . #ordered . dot } ]) /
		(bracket ==> [ :e | { e first asNumber . #ordered . bracket } ])

]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> newline [
	^ #newline asParser
]

{ #category : 'paragraphs' }
PPCommonMarkBlockParser >> paragraph [
	^ linePrefix, (emptyLine) not, paragraphLine trimBlanks, lineEnd,
	(
		(prefix / lazyParagraphPrefix), 
		(emptyLine / ATXHeader / horizontalRule / fencedCode / htmlBlock / list / quote) not, 
		paragraphLine trimBlanks, 
		lineEnd ==> #third
	) nonEmpty star
	map: [ :_lp :_pred :_line :_end :_rest |
		| para |
		para := PPCMParagraph new.
		para addChild: _line.
		_rest do: [ :anotherLine | para addChild: anotherLine ].
		para
	]
]

{ #category : 'paragraphs' }
PPCommonMarkBlockParser >> paragraphLine [
	^ plainLine
]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> plainLine [
	^ newline negate star flatten
	
	map: [ :_text |
		PPCMPlainLine new
			text: _text;
			yourself
	]
]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> prefix [
	^ #prefix asParser
]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> prefixedEmptyLine [
	"empty line with appropriate number of quotes, but with arbitrary whitespaces"
	^ (quoteDedent not, (quote / space) star, #endOfLine asParser) ==> [ :e | PPCMPlainLine empty ]
]

{ #category : 'quotes' }
PPCommonMarkBlockParser >> quote [
	^ (linePrefix, $> asParser, space optional) flatten
]

{ #category : 'quotes' }
PPCommonMarkBlockParser >> quoteBlock [
	^ quoteIndent,
		content,
	  quoteDedent
	
	map: [ :indent :_content :dedent |
		PPCMBlockQuote new
			child: _content;
			yourself
	]
]

{ #category : 'quotes' }
PPCommonMarkBlockParser >> quoteDedent [
	^ (prefix not, quote pop) flatten
]

{ #category : 'quotes' }
PPCommonMarkBlockParser >> quoteIndent [
	^ (quote ==> [ :e | quote ]) pushAsParser
]

{ #category : 'headers' }
PPCommonMarkBlockParser >> setexLine [
	^ plainLine
]

{ #category : 'headers' }
PPCommonMarkBlockParser >> setextHeader [
	^ linePrefix, emptyLine not, setexLine, lineEnd, setextHeaderUnderline
	
	map: [ :_prefix :_predicates :_text :_nl :_underline |
		PPCMHeader new
			title: _text;
			level: _underline;
			yourself
	]
]

{ #category : 'headers' }
PPCommonMarkBlockParser >> setextHeaderUnderline [
	| equal minus |
	equal := '=' asParser plus ==> [:t | 1].
	minus := '-' asParser plus ==> [:t | 2].
	
	^ prefix, listItem not, linePrefix, ((equal / minus) trimRight: space), lineEnd ==> #fourth

]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> space [
	^ Character space asParser
]

{ #category : 'lists' }
PPCommonMarkBlockParser >> spaces: length [
	| retval |
	retval := ''.
	length timesRepeat: [ 
		retval := retval, ' '.
	].
	^ retval
]

{ #category : 'document' }
PPCommonMarkBlockParser >> start [
	^ document >=> [ :context :cc |
		| retval |
		retval := cc value.
		retval isPetitFailure ifFalse: [ 
			context links do: [ :link | 
				retval addChildFirst: link.
			]
		].
		retval
	]
]

{ #category : 'initialization' }
PPCommonMarkBlockParser >> utils [
	^ PPCommonMarkUtils instance
]

{ #category : 'lines and whitespace' }
PPCommonMarkBlockParser >> whitespace [
	^ #space asParser
]