"{ Package: 'squeak:petitparser' }"

PPPredicateParser subclass:#PPPredicateObjectParser

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'PetitParser-Parsers'

!

PPPredicateObjectParser comment:'A parser that accepts if a given predicate on one element of the input sequence holds.'

!

!PPPredicateObjectParser class methodsFor:'instance creation'!

on: aBlock message: aString

	^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString

!

on: aBlock message: aString negated: aNegatedBlock message: aNegatedString

	^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString

! !

!PPPredicateObjectParser class methodsFor:'factory-chars'!

blank

	^ self chars: (String with: Character space with: Character tab) message: 'blank expected'

!

char: aCharacter

	^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , ' expected'

!

char: aCharacter message: aString

	^ self expect: aCharacter message: aString

!

chars: aCollection message: aString

	^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString

!

cr

	^ self char: Character cr message: 'carriage return expected'

!

digit

	^ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: 'digit expected'

!

hex

	^ self 

		on: (PPCharSetPredicate on: [ :char | 

			(char between: $0 and: $9) 

				or: [ (char between: $a and: $f) 

				or: [ (char between: $A and: $F) ] ] ])

		message: 'hex digit expected'

!

letter

	^ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: 'letter expected'

!

lf

	^ self char: Character lf

!

lowercase

	^ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: 'lowercase letter expected'

!

newline

	^ self chars: (String with: Character cr with: Character lf) message: 'newline expected'

!

punctuation

	^ self chars: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~' message: 'punctuation expected'

!

space

	^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator expected'

!

tab

	^ self char: Character tab message: 'tab expected'

!

uppercase

	^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter expected'

!

word

	^ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: 'letter or digit expected'

! !

!PPPredicateObjectParser class methodsFor:'factory-objects'!

any

	^ self

		on: [ :each | true ] message: 'input expected'

		negated: [ :each | false ] message: 'no input expected'

!

anyExceptAnyOf: aCollectionOfChars

	^ self

		on: [ :each | (aCollectionOfChars includes: each) not ] message: 'any except ' , aCollectionOfChars printString , ' expected'

		negated: [ :each | aCollectionOfChars includes: each ] message: aCollectionOfChars printString ,  ' not expected'

!

anyOf: anArray

	^ self

		on: [ :each | anArray includes: each ] message: 'any of ' , anArray printString , ' expected'

		negated: [ :each | (anArray includes: each) not ] message: 'none of ' , anArray printString ,  'expected'

!

between: min and: max

	^ self

		on: [ :each | each >= min and: [ each <= max ] ] message: min printString , '..' , max printString , ' expected'

		negated: [ :each | each < min or: [ each > max ] ] message: min printString , '..' , max printString , ' not expected'

!

expect: anObject

	^ self expect: anObject message: anObject printString , ' expected'

!

expect: anObject message: aString

	^ self 

		on: [ :each | each = anObject ] message: aString

		negated: [ :each | each ~= anObject ] message: 'no ' , aString

! !

!PPPredicateObjectParser methodsFor:'initialization'!

initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString

	predicate := aBlock.

	predicateMessage := aString.

	negated := aNegatedBlock.

	negatedMessage := aNegatedString

! !

!PPPredicateObjectParser methodsFor:'operators'!

negate

	"Answer a parser that is the negation of the receiving predicate parser."

	^ self class 

		on: negated message: negatedMessage 

		negated: predicate message: predicateMessage

! !

!PPPredicateObjectParser methodsFor:'parsing'!

parseOn: aStream

	^ (aStream atEnd not and: [ predicate value: aStream uncheckedPeek ])

		ifFalse: [ PPFailure message: predicateMessage at: aStream position ]

		ifTrue: [ aStream next ]

! !

!PPPredicateObjectParser class methodsFor:'documentation'!

version_SVN

    ^ '$Id: PPPredicateObjectParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'

! !