From d50935998a3325d0555eda4bfdfe135c17d8e95a Mon Sep 17 00:00:00 2001
From: Sean DeNigris <code@clipperadams.com>
Date: Sat, 28 Nov 2020 23:43:35 -0500
Subject: [PATCH] PP2FlexiblePredicateSequenceNode

Matches input against a predicate block, like PP2PredicateSequenceNode, but for an unknown/variable length.

For example, whereas for fixed-length matches you can already do:
	parser := PP2PredicateSequenceNode
		on: [ :value | value first isUppercase ]
		message: 'uppercase 3 letter words'
		size: 3.
	(parser parse: 'Abc') isPetitFailure not.

Now you can do:
	parser := PP2FlexiblePredicateSequenceNode
		on: [ :value | Object new respondsTo: value asSymbol  ]
		message: 'message to an object'
		while: [ :e | e ~= Character space ].

		(parser parse: 'hash ijk') isPetitFailure not.
		(parser parse: '99 ijk') isPetitFailure.
---
 .../PP2FlexiblePredicateTest.class.st         | 17 +++++
 .../PP2FlexiblePredicateSequence.class.st     | 17 +++++
 .../PP2FlexiblePredicateSequenceNode.class.st | 64 +++++++++++++++++++
 3 files changed, 98 insertions(+)
 create mode 100644 PetitParser2-Tests/PP2FlexiblePredicateTest.class.st
 create mode 100644 PetitParser2/PP2FlexiblePredicateSequence.class.st
 create mode 100644 PetitParser2/PP2FlexiblePredicateSequenceNode.class.st

diff --git a/PetitParser2-Tests/PP2FlexiblePredicateTest.class.st b/PetitParser2-Tests/PP2FlexiblePredicateTest.class.st
new file mode 100644
index 00000000..19002625
--- /dev/null
+++ b/PetitParser2-Tests/PP2FlexiblePredicateTest.class.st
@@ -0,0 +1,17 @@
+Class {
+	#name : #PP2FlexiblePredicateTest,
+	#superclass : #TestCase,
+	#category : #'PetitParser2-Tests-Nodes'
+}
+
+{ #category : #tests }
+PP2FlexiblePredicateTest >> test1 [
+	| parser |
+	parser := PP2FlexiblePredicateSequenceNode
+		on: [ :value | Object new respondsTo: value asSymbol ]
+		message: 'message to an object'
+		while: [ :e | e ~= Character space ].
+	
+	self assert: (parser parse: 'hash ijk') isPetit2Failure not.
+	self assert: (parser parse: '99 ijk') isPetit2Failure
+]
diff --git a/PetitParser2/PP2FlexiblePredicateSequence.class.st b/PetitParser2/PP2FlexiblePredicateSequence.class.st
new file mode 100644
index 00000000..fa6e2a1e
--- /dev/null
+++ b/PetitParser2/PP2FlexiblePredicateSequence.class.st
@@ -0,0 +1,17 @@
+Class {
+	#name : #PP2FlexiblePredicateSequence,
+	#superclass : #PP2Strategy,
+	#category : #'PetitParser2-Strategies'
+}
+
+{ #category : #parsing }
+PP2FlexiblePredicateSequence >> parseOn: aPP2Context [
+	| position result |
+	position := aPP2Context position.
+	result := String streamContents: [ :out |
+		[ node condition value: aPP2Context peek ] whileTrue: [ out nextPut: aPP2Context next ] ].
+	(node predicate value: result)
+		ifTrue: [ ^ result ].
+	aPP2Context position: position.
+	^ PP2Failure message: node predicateMessage context: aPP2Context
+]
diff --git a/PetitParser2/PP2FlexiblePredicateSequenceNode.class.st b/PetitParser2/PP2FlexiblePredicateSequenceNode.class.st
new file mode 100644
index 00000000..9605a5ec
--- /dev/null
+++ b/PetitParser2/PP2FlexiblePredicateSequenceNode.class.st
@@ -0,0 +1,64 @@
+"
+I match input against a predicate block, like PP2PredicateSequenceNode, but for an unknown/variable length. 
+
+For example, whereas for fixed-length matches you can already do: 
+	parser := PP2PredicateSequenceNode 
+		on: [ :value | value first isUppercase ] 
+		message: 'uppercase 3 letter words' 
+		size: 3. 
+	(parser parse: 'Abc') isPetitFailure not. 
+
+Now you can do: 
+	parser := PP2FlexiblePredicateSequenceNode 
+		on: [ :value | Object new respondsTo: value asSymbol  ] 
+		message: 'message to an object' 
+		while: [ :e | e ~= Character space ]. 
+                
+		(parser parse: 'hash ijk') isPetitFailure not. 
+		(parser parse: '99 ijk') isPetitFailure. 
+"
+Class {
+	#name : #PP2FlexiblePredicateSequenceNode,
+	#superclass : #PP2PredicateNode,
+	#instVars : [
+		'condition'
+	],
+	#category : #'PetitParser2-Nodes'
+}
+
+{ #category : #'instance creation' }
+PP2FlexiblePredicateSequenceNode class >> on: predicateBlock message: aString while: conditionBlock [
+
+	^ (self on: predicateBlock message: aString)
+		condition: conditionBlock;
+		yourself
+]
+
+{ #category : #visiting }
+PP2FlexiblePredicateSequenceNode >> accept: aPP2Visitor [
+	^ aPP2Visitor visitFlexiblePredicateSequence: self
+]
+
+{ #category : #accessing }
+PP2FlexiblePredicateSequenceNode >> condition [
+	^ condition
+]
+
+{ #category : #accessing }
+PP2FlexiblePredicateSequenceNode >> condition: anObject [
+	condition := anObject
+]
+
+{ #category : #operators }
+PP2FlexiblePredicateSequenceNode >> negate [
+	"Answer a parser that is the negation of the receiving predicate parser."
+	
+	^ super negate
+		condition: self condition;
+		yourself
+]
+
+{ #category : #initialization }
+PP2FlexiblePredicateSequenceNode >> resetStrategy [
+	strategy := PP2FlexiblePredicateSequence on: self
+]