"{ Package: 'stx:goodies/petitparser' }"
PPPredicateParser subclass:#PPPredicateObjectParser
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'PetitParser-Parsers'
!
!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
^ '$Header: /cvs/stx/stx/goodies/petitparser/PPPredicateObjectParser.st,v 1.3 2012-05-04 22:05:48 vrany Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/goodies/petitparser/PPPredicateObjectParser.st,v 1.3 2012-05-04 22:05:48 vrany Exp $'
!
version_SVN
^ '§Id: PPPredicateObjectParser.st 2 2010-12-17 18:44:23Z vranyj1 §'
! !