PetitCommonMark/software/PetitMarkdown/PPCommonMarkInlinesParser.class.st

Class {
	#name : 'PPCommonMarkInlinesParser',
	#superclass : 'PPCompositeParser',
	#instVars : [
		'starDelimiterRun',
		'underscoreDelimiterRun',
		'space',
		'newline',
		'leftDelimiterRun',
		'rightDelimiterRun',
		'emphasize',
		'link',
		'inlineCode',
		'punctuation',
		'emphasisR1',
		'emphasisR2',
		'strongR1',
		'strongR2',
		'delimiterRunSpace',
		'delimiterRun',
		'preceedingDelimiterRunSpace',
		'followingDelimiterRunSpace',
		'escaped',
		'hexadecimalEntity',
		'decimalEntity',
		'namedEntity',
		'lt',
		'gt',
		'quot',
		'copyEntity',
		'nbsp',
		'aelig',
		'ouml',
		'dcaron',
		'amp',
		'linkRef',
		'hardBreak',
		'entity',
		'linkLabel',
		'linkDestination',
		'linkTitle',
		'lineEnd',
		'inlines',
		'linkInLabel',
		'linkLabelContent',
		'lineStart',
		'emptyLine',
		'inlineCodeStart',
		'inlineCodeEnd',
		'documentEnd',
		'line',
		'linkRefDefs',
		'softBreak',
		'autolink',
		'escapedCharacter',
		'emailAutolink',
		'normalAutolink',
		'rawHtml',
		'rawHtmlAttribute',
		'autolinkScheme',
		'openTag',
		'closeTag',
		'rawHtmlComment',
		'processingInstruction',
		'htmlDeclaration',
		'cdata'
	],
	#category : 'PetitMarkdown-Parser'
}

{ #category : 'as yet unclassified' }
PPCommonMarkInlinesParser class >> ignoredNames [
	^ super ignoredNames , #('linkRefDefs')
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> aelig [
	^ 'Æ' asParser
	
	map: [ :r |
		PPCMText new
			text: 'Æ'
			yourself
	]
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> amp [
	^ '&' asParser / '&' asParser / '\&' asParser
	
	map: [ :r |
		PPCMText new
			text: '&'
			yourself
	]
]

{ #category : 'autolinks' }
PPCommonMarkInlinesParser >> autolink [
	^ normalAutolink / emailAutolink
]

{ #category : 'autolinks' }
PPCommonMarkInlinesParser >> autolinkScheme [
	^ 	'http' asParser /
		'irc' asParser / 
		'mailto' asParser /
		'MAILTO' asParser
]

{ #category : 'raw html' }
PPCommonMarkInlinesParser >> cdata [
	^ ('<![CDATA' asParser, (']]>' asParser negate star), ']]>' asParser) flatten
	
	map: [ :_html | 
		PPCMHtml new
			text: _html
			yourself
	]
]

{ #category : 'raw html' }
PPCommonMarkInlinesParser >> closeTag [
	^ ($< asParser, 
		$/ asParser,
			#letter asParser,
			(($> asParser) whileFalse: (#word asParser)), 
		(space optional), $> asParser) flatten
	
	map: [ :_html | 
		PPCMHtml new
			text: _html
			yourself
	]
]

{ #category : 'links' }
PPCommonMarkInlinesParser >> codeInLabel [
	| brackets  |
	brackets := PPDelegateParser new
		name: 'brackets';
		yourself.
		
	brackets setParser: 
		(escaped not, $[ asParser, 
			((inlineCode / (escaped not, $] asParser)) whileFalse: (brackets / #any asParser)), 
		$] asParser optional).

	"while there is no link or ]  -> consume brackets or any"
	^ (brackets, inlineCode) and.
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> copyEntity [
	^ '&copy;' asParser
	
	map: [ :r |
		PPCMText new
			text: '©'
			yourself
	]
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> dcaron [
	^ '&Dcaron;' asParser
	
	map: [ :r |
		PPCMText new
			text: 'Ď'
			yourself
	]
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> decimalEntity [
	^ '&#' asParser, #digit asParser plus flatten, $; asParser
	
	map: [ :_prefix :_number :_end |
		PPCMText new
			text: (Character codePoint: _number asNumber) asString;
			yourself
	]
]

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

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> delimiterRun [
	^ starDelimiterRun / underscoreDelimiterRun
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> delimiterRunSpace [
	^ space / newline
]

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

{ #category : 'autolinks' }
PPCommonMarkInlinesParser >> emailAutolink [
	^ $< asParser, 
		(	($> asParser / space / $\ asParser / $@ asParser) negate plus,
			$@ asParser,
			($> asParser / space / $\ asParser) negate plus
		) flatten,
	$> asParser
	
	map: [ :start :content :end | 
		| label |
		label := PPCMText new 
			text: (self encodeEntities: content); 
			yourself.
			
		PPCMLink new
			destination: 'mailto:', (self escapeUrl: content);
			label: label;
			yourself
	]
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> emphasisR1 [
	| start stop text children |
	start := (leftDelimiterRun and, $* asParser, $* asParser not) wrapped name: 'start'; yourself.
	stop := (rightDelimiterRun and, $* asParser, $* asParser not) wrapped name: 'stop'; yourself.
	
	text := (stop / emphasize / link / inlineCode / hardBreak) negate plus flatten asPPCMText. 
	children := (text / emphasize / link / inlineCode / hardBreak) star.
	
	
	^ start, children, stop
	map: [ :_start :_children :_stop |
		PPCMEmphasize new
			addChildren: _children;
			yourself
	]
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> emphasisR2 [
	| start stop text children |
	start := (leftDelimiterRun and, 
				((rightDelimiterRun not) / (punctuation preceeds, rightDelimiterRun) and), 
				$_ asParser, $_ asParser not) wrapped name: 'start'; yourself.
	stop := (rightDelimiterRun and,
				((leftDelimiterRun not) / (leftDelimiterRun, punctuation) and),
				$_ asParser, $_ asParser not) wrapped name: 'stop'; yourself.

	text := (stop / emphasize / entity) negate plus flatten asPPCMText. 
	children := (text / emphasize / entity) star.
	
	
	^ start, children, stop
	map: [ :_start :_children :_stop |
		PPCMEmphasize new
			addChildren: _children;
			yourself
	]
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> emphasize [
	^ 	emphasisR1 /
		emphasisR2 /
		strongR1 /
		strongR2
]

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

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

{ #category : 'entities' }
PPCommonMarkInlinesParser >> entity [
	^ hexadecimalEntity / decimalEntity / namedEntity
]

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

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

{ #category : 'lines and whitespace' }
PPCommonMarkInlinesParser >> escaped [
"	^ ('\\' asParser preceeds: 2) not, '\' asParser preceeds"
	
	"Might be a bit faster version:"
	^	[ :context |
			(context position == 0) ifTrue: [ PPFailure new ] ifFalse: [ 
				context skip: -1.
				context peek == $\ ifFalse: [ context skip: 1. PPFailure new ]
				ifTrue: [ 
					(context position == 0) ifTrue: [ context skip: 1. #escaped ] ifFalse: [ 
						context skip: -1.
						context peek == $\ ifTrue: [ context skip: 2. PPFailure new ]
						ifFalse: [ context skip: 2. #escaped ]
					]
				]
			]
		] asParser
]

{ #category : 'lines and whitespace' }
PPCommonMarkInlinesParser >> escapedCharacter [
	^ $\ asParser, (
		$\ asParser /
		$[ asParser / 
		$! asParser /
		$# asParser /
		$$ asParser / 
		$% asParser /
		$' asParser /
		$( asParser /
		$) asParser /
		$* asParser /
		$+ asParser /
		$, asParser /
		$+ asParser /
		$- asParser /
		$. asParser /
		$/ asParser /
		$: asParser /
		$; asParser /
		$= asParser /
		$? asParser /
		$@ asParser /
		$^ asParser /
		$_ asParser /
		$` asParser /
		${ asParser /
		$| asParser /
		$} asParser /
		$~ asParser /
		$] asParser
	) map: [ :_escape :_char |
		PPCMText new
			text: _char asString;
			yourself
	]
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> followingDelimiterRunSpace [
	^ delimiterRunSpace and / #eof asParser

]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> gt [
	^ '>' asParser / '\>' asParser / '&gt;' asParser
	
	map: [ :r |
		PPCMText new
			text: '&gt;'
			yourself
	]
]

{ #category : 'newlines' }
PPCommonMarkInlinesParser >> hardBreak [
	^ ($\ asParser, newline and) / ((space min: 2), newline and)
	==> [ :e | PPCMHardBreak new ]
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> hexadecimalEntity [
	^ '&#x' asParser, (#hex asParser) plus flatten, $; asParser
	
	map: [ :_prefix :_number :_end |
		| text char |
		char := Character codePoint: (Number readFrom: _number base: 16).
		text :=  (char = $") ifTrue: [ '&quot;' ] ifFalse: [ char asString ].
		
		PPCMText new
			text: text;
			yourself
	]
]

{ #category : 'raw html' }
PPCommonMarkInlinesParser >> htmlDeclaration [
	^ ('<!' asParser, '--' asParser not, ('>' asParser negate star), '>' asParser) flatten
	
	map: [ :_html | 
		PPCMHtml new
			text: _html
			yourself
	]
]

{ #category : 'intialization' }
PPCommonMarkInlinesParser >> initialize [
	super initialize.
	linkRefDefs := IdentityDictionary new.
]

{ #category : 'code' }
PPCommonMarkInlinesParser >> inlineCode [	
	^ inlineCodeStart, inlineCodeEnd negate star flatten, inlineCodeEnd
	
	map: [ :_begin :_content :_end |
		PPCMInlinedCode new
			code: (self encodeEntities: _content);
			yourself
	]
]

{ #category : 'code' }
PPCommonMarkInlinesParser >> inlineCodeEnd [
	^ [ :context |
		context inlineCodeEnd parseOn: context
	] asParser
]

{ #category : 'code' }
PPCommonMarkInlinesParser >> inlineCodeStart [
	^ ((escaped / $` asParser preceeds) not, ($` asParser plus)) flatten >=> [ :context :cc |
		| result |
		result := cc value.
		result isPetitFailure ifFalse: [ 
			context inlineCodeEnd: (($` asParser preceeds) not, result asParser, $` asParser not).
		].
		result
	]
]

{ #category : 'lines and whitespace' }
PPCommonMarkInlinesParser >> inlines [
	^ emphasize / inlineCode / rawHtml / autolink / link / linkRef / hardBreak / softBreak / entity / escapedCharacter
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> leftDelimiterRun [
	| a |
	a := delimiterRun, delimiterRunSpace not, #any asParser and.
	
	^ (a, punctuation not) / ((preceedingDelimiterRunSpace / punctuation preceeds), a)
]

{ #category : 'as yet unclassified' }
PPCommonMarkInlinesParser >> line [
	| text |
	text := inlines negate plus flatten asPPCMText.
	^ (inlines / text) star
]

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

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

{ #category : 'links' }
PPCommonMarkInlinesParser >> link [
	^ linkLabel, $( asParser, linkDestination optional trimSpaces, linkTitle optional trim, $) asParser
	
	map: [ :_label :_open :_destination :_title :_close |
		PPCMLink new
			label: _label;
			destination: _destination;
			title: _title;
			yourself
	]
]

{ #category : 'links' }
PPCommonMarkInlinesParser >> linkDestination [
	| parens escapedParen |
	
	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' }
PPCommonMarkInlinesParser >> linkInLabel [
	| brackets  |
	brackets := PPDelegateParser new
		name: 'brackets';
		yourself.
		
	brackets setParser: 
		(escaped not, $[ asParser, 
			((link / (escaped not, $] asParser)) whileFalse: (brackets / #any asParser)), 
		$] asParser optional).

	"while there is no link or ]  -> consume brackets or any"
	^ ((link / $] asParser) whileFalse: (brackets / #any asParser)),
		 link and.
]

{ #category : 'links' }
PPCommonMarkInlinesParser >> linkInLinkLabel [
	| brackets  |
	brackets := PPDelegateParser new
		name: 'brackets';
		yourself.
		
	brackets setParser: 
		(escaped not, $[ asParser, 
			((link / (escaped not, $] asParser)) whileFalse: (brackets / #any asParser)), 
		$] asParser optional).

	"while there is no link or ]  -> consume brackets or any"
	^ (link / $] asParser) whileFalse: (brackets / #any asParser),
		link and.
]

{ #category : 'links' }
PPCommonMarkInlinesParser >> linkLabel [
	| brackets labelText |
	brackets := PPDelegateParser new
		name: 'brackets';
		yourself.
		
	brackets setParser: 
		(escaped not, $[ asParser, 
			((escaped not, $] asParser) not, (brackets / #any asParser)) plus, 
		$] asParser) flatten asPPCMText.

	labelText := (inlines / brackets / (escaped not, $] asParser)) negate plus flatten asPPCMText.

	^ ((escaped not, $[ asParser) wrapped, (linkInLabel not), 
		(inlines / brackets / labelText) plus,
	$] asParser 
		

	map: [ :_open :_pred :_content :_close |
		| retval |
		retval := PPCMLine new
			addChildren: _content;
			yourself.
	]) "limitedBy: linkLabelContent"
]

{ #category : 'links' }
PPCommonMarkInlinesParser >> linkLabelContent [
	| brackets  |
	brackets := PPDelegateParser new
		name: 'brackets';
		yourself.
		
	brackets setParser: 
		(escaped not, $[ asParser, 
			((escaped not, $] asParser) not, (brackets / #any asParser)) plus, 
		$] asParser).

	^ brackets
]

{ #category : 'links' }
PPCommonMarkInlinesParser >> linkRef [
	^ linkLabel >=> [ :context :cc |
		| retval memento |
		memento := context position.

		retval := cc value.
		retval isPetitFailure ifFalse: [ 
			(linkRefDefs includesKey: retval text asString asLowercase asSymbol) ifTrue: [ 
				retval := PPCMLinkRef new
					label: retval;
					yourself
			] ifFalse: [ 
				context position: memento.
				retval := PPFailure message: 'label not registered!' context: context
			]
		].
		retval
	]	

]

{ #category : 'links' }
PPCommonMarkInlinesParser >> linkTitle [
	^ ((space preceeds / lineStart),   
		(($" asParser, 
			((escaped not, $" asParser) / (lineEnd, emptyLine)) negate plus flatten, 
		  $" asParser ==> #second) /
	    ($' asParser, 
			((escaped not, $' asParser) / (lineEnd, emptyLine)) negate plus flatten, 
		  $' asParser ==> #second) /
	    ($( asParser, 
			($) asParser / (lineEnd, emptyLine)) negate plus flatten, 
		  $) asParser ==> #second)))
	
	==> [ :e | self decodeEntities: (self escape: (e second)) ]
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> lt [
	^ '<' asParser / '\<' asParser / '&lt;' asParser
	
	map: [ :r |
		PPCMText new
			text: '&lt;'
			yourself
	]
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> namedEntity [
	^ lt / gt / quot / copyEntity / nbsp / aelig / ouml / dcaron / amp
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> nbsp [
	^ '&nbsp;' asParser
	
	map: [ :r |
		PPCMText new
			text: ' '
			yourself
	]
]

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

{ #category : 'autolinks' }
PPCommonMarkInlinesParser >> normalAutolink [
	^ 
	$< asParser, 
		(autolinkScheme, $: asParser, 
		($> asParser / space) negate plus) flatten, 
	$> asParser
	
	map: [ :start :content :end | 
		| label |
		label := PPCMText new 
			text: (self encodeEntities: content); 
			yourself.
			
		PPCMLink new
			destination: (self escapeUrl: content);
			label: label;
			yourself
	]
]

{ #category : 'raw html' }
PPCommonMarkInlinesParser >> openTag [
	^ ($< asParser, 
		#letter asParser,
		(($> asParser) whileFalse: (#word asParser / 
											space / 
											newline / 
											$= asParser / 
											$_ asParser / 
											$: asParser / 
											rawHtmlAttribute)), 
	($/ asParser optional), $> asParser) flatten
	
	map: [ :_html | 
		PPCMHtml new
			text: _html
			yourself
	]
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> ouml [
	^ '&ouml;' asParser 

	map: [ :r |
		PPCMText new
			text: 'ö'
			yourself
	]
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> preceedingDelimiterRunSpace [
	^ 
	delimiterRunSpace preceeds / 
	[:context | context position == 0 ifFalse: [ 
		PPFailure message: 'start of file not found' ]
		ifTrue: [ #startOfFile ] 
	] asParser
]

{ #category : 'raw html' }
PPCommonMarkInlinesParser >> processingInstruction [
	^ ('<?' asParser, ('?>' asParser negate star), '?>' asParser) flatten
	
	map: [ :_html | 
		PPCMHtml new
			text: _html
			yourself
	]
]

{ #category : 'lines and whitespace' }
PPCommonMarkInlinesParser >> punctuation [
	^ 	$. asParser /
	  	$" asParser /
	  	$, asParser /
		$- asParser /
		$( asParser /
		$) asParser /
		$] asParser
]

{ #category : 'entities' }
PPCommonMarkInlinesParser >> quot [
	^ '"' asParser / '\"' asParser / '&quot;' asParser
	
	map: [ :r |
		PPCMText new
			text: '&quot;'
			yourself
	]
]

{ #category : 'raw html' }
PPCommonMarkInlinesParser >> rawHtml [
	^ closeTag / openTag / rawHtmlComment / processingInstruction / cdata / htmlDeclaration
]

{ #category : 'raw html' }
PPCommonMarkInlinesParser >> rawHtmlAttribute [
	| pairedBrackets |
	pairedBrackets := PPDelegateParser new name: 'brackets'; yourself.
	pairedBrackets setParser: (	$< asParser, 
											($> asParser whileFalse: pairedBrackets / #any asParser), 
										$> asParser).	

	^ 
	(
		($' asParser, ($' asParser whileFalse: (pairedBrackets / #any asParser)), $' asParser) /
		($" asParser, ($" asParser whileFalse: (pairedBrackets / #any asParser)), $" asParser)
	),
	(($> asParser / space / newline) and )

]

{ #category : 'raw html' }
PPCommonMarkInlinesParser >> rawHtmlComment [
	^ ('<!--' asParser, $> asParser not, ('--' asParser negate star), '-->' asParser) flatten
	
	map: [ :_html | 
		PPCMHtml new
			text: _html
			yourself
	]
]

{ #category : 'links' }
PPCommonMarkInlinesParser >> registerLinkRefDef: node [
	linkRefDefs at: node label asString asLowercase asSymbol
				   put: node
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> rightDelimiterRun [
	| a |
	a := (preceedingDelimiterRunSpace not), delimiterRun.
		
	^ (punctuation preceeds not, a) / (a, (punctuation and / followingDelimiterRunSpace))
]

{ #category : 'newlines' }
PPCommonMarkInlinesParser >> softBreak [
	^ space optional, Character cr asParser ==> [ :e |
		PPCMSoftBreak new
	]
]

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

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> starDelimiterRun [
	^ ($* asParser preceeds / escaped) not, $* asParser plus
]

{ #category : 'as yet unclassified' }
PPCommonMarkInlinesParser >> start [
	^ line
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> strongR1 [
	| start stop text children |
	start := (leftDelimiterRun and, ($* asParser, $* asParser), $* asParser not) wrapped name: 'start'; yourself.
	stop := (rightDelimiterRun and, ($* asParser, $* asParser), $* asParser not) wrapped name: 'stop'; yourself.
	
	text := (stop / emphasize / entity) negate plus flatten asPPCMText. 
	children := (text / emphasize / entity) star.
	
	
	^ start, children, stop
	map: [ :_start :_children :_stop |
		PPCMStrong new
			addChildren: _children;
			yourself
	]
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> strongR2 [
	| start stop text children |
	start := (leftDelimiterRun and, 
				((rightDelimiterRun not) / (punctuation preceeds, rightDelimiterRun) and), 
				($_ asParser, $_ asParser), $_ asParser not) wrapped name: 'start'; yourself.
	stop := (rightDelimiterRun and, 
				((leftDelimiterRun not) / (leftDelimiterRun, punctuation) and),
				($_ asParser, $_ asParser), $_ asParser not) wrapped name: 'stop'; yourself.
	
	text := (stop / emphasize) negate plus flatten asPPCMText. 
	children := (text / emphasize) star.
	
	
	^ start, children, stop
	map: [ :_start :_children :_stop |
		PPCMStrong new
			addChildren: _children;
			yourself
	]
]

{ #category : 'emphasis' }
PPCommonMarkInlinesParser >> underscoreDelimiterRun [
	^ ($_ asParser preceeds / escaped not), $_ asParser plus
]

{ #category : 'support' }
PPCommonMarkInlinesParser >> utils [
	^ PPCommonMarkUtils instance
]