[squeak-dev] The Inbox: JSON-ul.56.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jul 14 14:12:06 UTC 2022


A new version of JSON was added to project The Inbox:
http://source.squeak.org/inbox/JSON-ul.56.mcz

==================== Summary ====================

Name: JSON-ul.56
Author: ul
Time: 6 December 2020, 6:47:32.838453 pm
UUID: 6c5f17b1-830e-45ba-90b0-3cd6d40cd35e
Ancestors: JSON-ul.55

Implemented JsonObject >> #respondsTo: which returns true for all setters and getters of already defined fields. The code works the same way #doesNotUnderstand: does.

=============== Diff against JSON-tonyg.39 ===============

Item was changed:
  Object subclass: #Json
+ 	instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap dictionaryClass'
- 	instanceVariableNames: 'stream ctorMap'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'JSON'!
  Json class
+ 	instanceVariableNames: 'escapeArray escapeSet'!
- 	instanceVariableNames: 'escapeArray'!
  
+ !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0!
+ I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries.
+ The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects.
+ Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct.
+ 
+ Instance Variables
+ 	stream:				<PositionableStream>
+ 	currentCharacter:	<Character>
+ 	arrayBufferStream:	<WriteStream>
+ 	stringBufferStream: <ReadWriteStream>
+ 	numberParser: <ExtendedNumberParser>
+ 	ctorMap: <Dictionary>
+ 
+ For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream.
+ arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one.
+ stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this.
+ numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it.
+ ctorMap is the Dictionary holding the constructor classes by name.
+ 
+ arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time.
+ 
+ For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:.
+ !
- !Json commentStamp: '<historical>' prior: 0!
- This class reads and writes JSON format data - strings, numbers, boolean, nil, arrays and dictionaries. See http://www.crockford.com/JSON/index.html. It has been extended with syntax for invoking a prearranged list of constructors on read objects.!
  Json class
+ 	instanceVariableNames: 'escapeArray escapeSet'!
- 	instanceVariableNames: 'escapeArray'!

Item was changed:
+ ----- Method: Json class>>escapeForCharacter: (in category 'accessing') -----
- ----- Method: Json class>>escapeForCharacter: (in category 'as yet unclassified') -----
  escapeForCharacter: c
  	
  	| asciiValue |
  	(asciiValue := c asciiValue) < 128
  		ifTrue: [ ^escapeArray at: asciiValue + 1 ].
  	^nil!

Item was added:
+ ----- Method: Json class>>escapeSet (in category 'accessing') -----
+ escapeSet 
+ 
+ 	^escapeSet!

Item was changed:
+ ----- Method: Json class>>initialize (in category 'class initialization') -----
- ----- Method: Json class>>initialize (in category 'as yet unclassified') -----
  initialize
  	"Json initialize."
  	
+ 	| newEscapeArray newEscapeSet |
+ 	newEscapeArray := Array new: 128.
+ 	newEscapeSet := CharacterSet new.
- 	escapeArray := Array new: 128.
  	(0 to: 31), #(127) do: [ :each |
+ 		newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0).
+ 		newEscapeSet add: (Character value: each) ].
- 		escapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0) ].
  	{
  		$" -> '\"'.
  		$\ -> '\\'.
+ 		$/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>."
  		Character backspace -> '\b'.
  		Character lf -> '\n'.
  		Character newPage -> '\f'.
  		Character cr -> '\r'.
  		Character tab -> '\t'.
  	} do: [ :each |
+ 		newEscapeArray at: each key asciiValue + 1 put: each value.
+ 		newEscapeSet add: each key ].
+ 	escapeArray := newEscapeArray.
+ 	escapeSet := newEscapeSet!
- 		escapeArray at: each key asciiValue + 1 put: each value ].
- !

Item was changed:
+ ----- Method: Json class>>mimeType (in category 'accessing') -----
- ----- Method: Json class>>mimeType (in category 'as yet unclassified') -----
  mimeType
+ 
+ 	^'application/json'!
- 	^ 'application/x-json'!

Item was changed:
+ ----- Method: Json class>>newWithConstructors: (in category 'instance creation') -----
- ----- Method: Json class>>newWithConstructors: (in category 'as yet unclassified') -----
  newWithConstructors: aCollection
  	| m |
  	m := Dictionary new.
  	aCollection do: [:each |
  		(each isKindOf: Association)
  			ifTrue: [m add: each]
  			ifFalse: [m at: each name asString put: each]].
  	^ self new ctorMap: m; yourself.!

Item was removed:
- ----- Method: Json class>>numbersMayContain: (in category 'as yet unclassified') -----
- numbersMayContain: aChar
- 	^ aChar isDigit or: [#($- $+ $. $e $E) includes: aChar]!

Item was changed:
+ ----- Method: Json class>>readFrom: (in category 'instance creation') -----
- ----- Method: Json class>>readFrom: (in category 'as yet unclassified') -----
  readFrom: aStream
  	^ self new readFrom: aStream.!

Item was changed:
+ ----- Method: Json class>>render: (in category 'rendering') -----
- ----- Method: Json class>>render: (in category 'as yet unclassified') -----
  render: anObject
+ 
+ 	^String streamContents: [ :stream |
+ 		anObject jsonWriteOn: stream ]!
- 	| s |
- 	s := WriteStream on: String new.
- 	anObject jsonWriteOn: s.
- 	^ s contents.!

Item was changed:
+ ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') -----
- ----- Method: Json class>>render:withConstructor:on: (in category 'as yet unclassified') -----
  render: anObject withConstructor: aConstructorName on: aStream
  	aStream nextPutAll: '@', aConstructorName.
  	anObject jsonWriteOn: aStream.
  !

Item was changed:
+ ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') -----
- ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'as yet unclassified') -----
  renderInstanceVariables: aCollection of: anObject on: aStream
  	| map |
  	map := Dictionary new.
  	aCollection do: [:ivarName | map at: ivarName put: (anObject instVarNamed: ivarName)].
  	self render: map withConstructor: anObject class name asString on: aStream!

Item was added:
+ ----- Method: Json>>arrayBufferStream (in category 'private') -----
+ arrayBufferStream
+ 
+ 	^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]!

Item was added:
+ ----- Method: Json>>consume: (in category 'private') -----
+ consume: aString
+ 
+ 	| message |
+ 	1 to: aString size do: [ :index |
+ 		(currentCharacter := stream next) == (aString at: index) ifFalse: [
+ 			message := 'Expected ', (aString at: index)  printString.
+ 			currentCharacter
+ 				ifNil: [ self incomplete: message ]
+ 				ifNotNil: [ self invalid: message ] ] ].
+ 	currentCharacter := stream next!

Item was removed:
- ----- Method: Json>>consume:returning: (in category 'private') -----
- consume: aString returning: anObject
- 	|v|
- 	aString do: [:c |
- 		v := stream next.
- 		v ifNil: [JsonIncompleteError signal: 'Incomplete ''', aString, ''' seen'].
- 		v == c ifFalse: [JsonInvalidError signal: 'Expected ''', aString, ''''] ].
- 	^ anObject!

Item was added:
+ ----- Method: Json>>dictionaryClass: (in category 'accessing') -----
+ dictionaryClass: aClass
+ 	"This method allows you to override the default dictionary class to be created while parsing a stream. Instances of aClass are expected to understand #at:put:."
+ 
+ 	dictionaryClass := aClass!

Item was added:
+ ----- Method: Json>>error: (in category 'error handling') -----
+ error: aString
+ 
+ 	(currentCharacter isNil and: [ stream atEnd ])
+ 		ifTrue: [ self incomplete: aString ]
+ 		ifFalse: [ self invalid: aString ]!

Item was added:
+ ----- Method: Json>>incomplete: (in category 'error handling') -----
+ incomplete: aString
+ 
+ 	JsonIncompleteError signal: aString!

Item was added:
+ ----- Method: Json>>initialize (in category 'initialize-release') -----
+ initialize
+ 	
+ 	dictionaryClass := JsonObject
+ 	!

Item was removed:
- ----- Method: Json>>interpretStringEscape (in category 'private') -----
- interpretStringEscape
- 	| c |
- 	c := stream next.
- 	c ifNil: [JsonIncompleteError signal: 'Expected character following ''\'' in string escape'].
- 	c == $b ifTrue: [^ Character backspace].
- 	c == $n ifTrue: [^ Character lf].
- 	c == $f ifTrue: [^ Character newPage].
- 	c == $r ifTrue: [^ Character cr].
- 	c == $t ifTrue: [^ Character tab].
- 	c == $u ifTrue: [^ self unescapeUnicode].
- 	^ c.!

Item was added:
+ ----- Method: Json>>interpretStringEscape: (in category 'private') -----
+ interpretStringEscape: aCharacter
+ 
+ 	aCharacter == $b ifTrue: [ ^Character backspace ].
+ 	aCharacter == $n ifTrue: [ ^Character lf ].
+ 	aCharacter == $f ifTrue: [ ^Character newPage ].
+ 	aCharacter == $r ifTrue: [ ^Character cr ].
+ 	aCharacter == $t ifTrue: [ ^Character tab ].
+ 	aCharacter == $u ifTrue: [ ^self unescapeUnicode ].
+ 	aCharacter == $" ifTrue: [ ^aCharacter ].
+ 	aCharacter == $\ ifTrue: [ ^aCharacter ].
+ 	aCharacter == $/ ifTrue: [ ^aCharacter ].
+ 	self error: 'Unexpected escaped character: ', aCharacter asString
+ !

Item was added:
+ ----- Method: Json>>invalid: (in category 'error handling') -----
+ invalid: aString
+ 
+ 	JsonInvalidError signal: aString!

Item was removed:
- ----- Method: Json>>nextHexDigit (in category 'private') -----
- nextHexDigit
- 	| c |
- 	c := stream next.
- 	c ifNil: [JsonIncompleteError signal: 'Expecting hex digit'].
- 	c := c asUppercase.
- 	(c isDigit or: [c >= $A and: [c <= $F]]) ifTrue: [^ c].
- 	JsonInvalidError signal: 'Expected hex digit'.!

Item was changed:
+ ----- Method: Json>>readAny (in category 'private') -----
- ----- Method: Json>>readAny (in category 'parsing') -----
  readAny
+ 
- 	"This is the main entry point for the JSON parser. See also readFrom: on the class side."
- 	| c |
  	self skipWhitespace.
+ 	currentCharacter == ${ ifTrue: [ ^self readDictionary ].
+ 	currentCharacter == $[ ifTrue: [ ^self readArray ].
+ 	currentCharacter == $" ifTrue: [ ^self readString ].
+ 	currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ].
+ 	currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ].
+ 	currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ].
+ 	currentCharacter == $- ifTrue: [ ^self readNumber: true ].
+ 	(#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [
+ 		^self readNumber: false ].
+ 	currentCharacter == $@ ifTrue: [ ^self readConstructor ].
+ 	self invalid: 'Unknown Json input'!
- 	c := stream peek asLowercase.
- 	c == ${ ifTrue: [stream next. ^ self readDictionary].
- 	c == $[ ifTrue: [stream next. ^ self readArray].
- 	c == $" ifTrue: [stream next. ^ self readString].
- 	c == $t ifTrue: [^ self consume: 'true' returning: true].
- 	c == $f ifTrue: [^ self consume: 'false' returning: false].
- 	c == $n ifTrue: [^ self consume: 'null' returning: nil].
- 	c == $@ ifTrue: [stream next. ^ self readConstructor].
- 	(Json numbersMayContain: c) ifTrue: [^ self readNumber].
- 	JsonInvalidError signal: 'Unknown Json input'!

Item was changed:
  ----- Method: Json>>readArray (in category 'private') -----
  readArray
+ 
+ 	| initialPosition |
+ 	currentCharacter := stream next.
- 	| a |
  	self skipWhitespace.
+ 	currentCharacter == $] ifTrue: [
+ 		currentCharacter := stream next.
+ 		^#() ].
+ 	initialPosition := self arrayBufferStream position.
- 	(stream peekFor: $]) ifTrue: [ ^ #() ].	
- 	a := OrderedCollection new.
  	[
+ 		arrayBufferStream nextPut: self readAny.
- 		a add: self readAny.
  		self skipWhitespace.
+ 		currentCharacter == $] ifTrue: [ 
+ 			|  result |
+ 			result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position.
+ 			arrayBufferStream position: initialPosition.
+ 			currentCharacter := stream next.
+ 			^result ].
+ 		currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ].
+ 		currentCharacter := stream next ] repeat.
- 		(stream peekFor: $]) ifTrue: [ ^ a asArray].
- 		(stream peekFor: $, ) ifFalse: [JsonInvalidError signal: 'Missing comma'].
- 	] repeat.
  !

Item was changed:
  ----- Method: Json>>readConstructor (in category 'private') -----
  readConstructor
+ 
+ 	ctorMap ifNil: [ ^self error: 'No constructors were declared.' ].
+ 	self resetStringBufferStream.
+ 	[ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [
+ 		stringBufferStream nextPut: currentCharacter ].
+ 	(ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor |
+ 		^constructor constructFromJson: self readAny ].	
+ 	self error: 'Unknown constructor: ', stringBufferStream contents!
- 	| s c v ctor |
- 	s := WriteStream on: ''.
- 	[
- 		c := stream peek.
- 		c ifNil: [JsonIncompleteError signal: 'Premature EOF reading constructor name'].
- 		((c == $.) or: [c isLetter])
- 			ifTrue: [s nextPut: c. stream next]
- 			ifFalse: [
- 				v := self readAny.
- 				s := s contents.
- 				ctor := ctorMap ifNotNil: [ctor := ctorMap at: s ifAbsent: [nil]].
- 				ctor ifNil: [JsonInvalidError signal: 'Unknown ctor ', s].
- 				^ ctor constructFromJson: v]
- 	] repeat.
- !

Item was changed:
  ----- Method: Json>>readDictionary (in category 'private') -----
  readDictionary
+ 
+ 	| result key commaNeeded |
+ 	result := dictionaryClass new.
+ 	commaNeeded := false.
+ 	currentCharacter := stream next.
- 	| m k v needComma |
- 	m := JsonObject new.
- 	needComma := false.
  	[
  		self skipWhitespace.
+ 		currentCharacter == $} ifTrue: [ 
+ 			currentCharacter := stream next.
+ 			^result ].
+ 		commaNeeded
+ 			ifFalse: [ commaNeeded := true ]
+ 			ifTrue: [ 
+ 				currentCharacter == $, ifFalse: [ self error: 'Missing comma' ].
+ 				currentCharacter := stream next.
+ 				self skipWhitespace ].
+ 		currentCharacter == $" ifFalse: [  self error: 'Key in dictionary must be string' ].
+ 		key := self readString.
- 		(stream peekFor: $}) ifTrue: [ ^ m].
- 		needComma
- 			ifTrue: [ (stream peekFor: $,) ifFalse: [JsonInvalidError signal: 'Missing comma'].
- 					self skipWhitespace]
- 			ifFalse: [needComma := true].
- "		k := self readAny. "
- 		(stream peekFor: $") ifFalse: [JsonInvalidError signal: 'Key in dictionary must be string'].
- 		k := self readString.
  		self skipWhitespace.
+ 		currentCharacter == $: ifFalse: [ self error: 'Missing colon' ].
+ 		currentCharacter := stream next.
+ 		result at: key put: self readAny ] repeat!
- 		(stream peekFor: $:) ifFalse: [JsonInvalidError signal: 'Missing colon'].
- 		v := self readAny.
- 		m at: k put: v.
- 	] repeat.
- !

Item was changed:
  ----- Method: Json>>readFrom: (in category 'parsing') -----
  readFrom: aStream
+ 
+ 	| result |
+ 	stream := aStream.
+ 	numberParser ifNotNil: [ numberParser on: stream ].
+ 	currentCharacter := stream next.
+ 	result := self readAny.
+ 	currentCharacter ifNotNil: [ stream skip: -1 ]. "Undo prereading."
+ 	^result!
- 	self stream: aStream.
- 	^ self readAny!

Item was removed:
- ----- Method: Json>>readNumber (in category 'private') -----
- readNumber
- 	| acc c |
- 	acc := WriteStream on: ''.
- 	[
- 		c := stream peek.
- 		(c isNil not and: [Json numbersMayContain: c]) ifFalse: [
- 			[^ acc contents asNumber] on: Error do: [JsonInvalidError signal: 'Invalid number']].
- 		acc nextPut: c.
- 		stream next.
- 	] repeat.!

Item was added:
+ ----- Method: Json>>readNumber: (in category 'private') -----
+ readNumber: negative
+ 
+ 	| result |
+ 	negative ifFalse: [ stream skip: -1 ].
+ 	result := (numberParser ifNil: [
+ 		numberParser := JsonNumberParser new
+ 			on: stream;
+ 			failBlock: [ self error: 'Invalid number.' ];
+ 			yourself ])
+ 		nextNumber: negative.
+ 	currentCharacter := stream next.
+ 	^result
+ 	!

Item was changed:
  ----- Method: Json>>readString (in category 'private') -----
  readString
+ 
+ 	self resetStringBufferStream.
- 	| s c |
- 	s := WriteStream on: ''.
  	[
+ 		currentCharacter := stream next ifNil: [self incomplete: 'Unexpected end of string' ].
+ 		currentCharacter == $" ifTrue: [ 
+ 			currentCharacter := stream next.
+ 			^stringBufferStream contents ].
+ 		currentCharacter == $\
+ 			ifTrue: [ 
+ 				stringBufferStream nextPut: (self interpretStringEscape: (stream next ifNil: [
+ 					self incomplete: 'Unexpected end of string' ])) ]
+ 			ifFalse: [ stringBufferStream nextPut: currentCharacter ] ] repeat!
- 		c := stream next.
- 		c ifNil: [JsonIncompleteError signal: 'Incomplete read of JSON string'].
- 		c == $\
- 			ifTrue: [s nextPut: self interpretStringEscape.]
- 			ifFalse: [c == $" ifTrue: [^ s contents.].
- 					s nextPut: c]
- 	] repeat.!

Item was added:
+ ----- Method: Json>>resetStringBufferStream (in category 'private') -----
+ resetStringBufferStream
+ 
+ 	stringBufferStream 
+ 		ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ]
+ 		ifNotNil: [ stringBufferStream resetToStart ]!

Item was removed:
- ----- Method: Json>>skipComment (in category 'private') -----
- skipComment
- 	stream peek == $/ ifTrue: [
- 		stream next.
- 		stream peek == $/
- 			ifTrue: [self skipToEndOfLine]
- 			ifFalse: [stream peek == $*
- 						ifTrue: [stream next. self skipCommentBody]
- 						ifFalse: [JsonInvalidError signal: 'Invalid comment syntax']]]
- !

Item was removed:
- ----- Method: Json>>skipCommentBody (in category 'private') -----
- skipCommentBody
- 	[
- 		[stream next == $*] whileFalse.
- 		stream peek == $/
- 	] whileFalse.
- 	stream next. "skip that last slash"
- 	self skipWhitespace.!

Item was removed:
- ----- Method: Json>>skipToEndOfLine (in category 'private') -----
- skipToEndOfLine
- 	| cr lf |
- 	cr := Character cr. lf := Character lf.
- 	[ | c | (c := stream peek) == cr or: [ c == lf]] whileFalse: [stream next].
- 	self skipWhitespace!

Item was changed:
  ----- Method: Json>>skipWhitespace (in category 'private') -----
  skipWhitespace
+ 
+ 	currentCharacter ifNil: [
+ 		self incomplete: 'Input stream is empty' ].
+ 	[ currentCharacter isSeparator ] whileTrue: [
+ 		currentCharacter := stream next ifNil: [
+ 			self incomplete: 'Input stream is empty' ]. ]!
- 	|c|
- 	[
- 		c := stream peek.
- 		c ifNil: [JsonIncompleteError signal: 'Expected JSON input'].
- 		c isSeparator
- 	] whileTrue: [stream next].
- 	self skipComment.!

Item was changed:
+ ----- Method: Json>>stream: (in category 'private') -----
+ stream: aStream
+ 	"For testing purposes only"
- ----- Method: Json>>stream: (in category 'accessing') -----
- stream: anObject
- 	"Set the value of stream"
  
+ 	stream := aStream.
+ 	numberParser ifNotNil: [ numberParser on: stream ].
+ 	currentCharacter := stream next!
- 	stream := anObject.
- 	(stream respondsTo: #reset) ifTrue: [
- 		stream reset.
- 	].
- !

Item was changed:
  ----- Method: Json>>unescapeUnicode (in category 'private') -----
  unescapeUnicode
+ 
+ 	| code digitValue lowSurrogateCode |
+ 	code := 0.
+ 	1 to: 4 do: [ :index |
+ 		(digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [
+ 			self invalid: 'Invalid hexadecimal digit' ].
+ 		digitValue < 16
+ 			ifTrue: [ code := code * 16 + digitValue ]
+ 			ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ].
+ 	code < 16rD800 ifTrue: [ ^code asCharacter ].
+ 	code > 16rDFFF ifTrue: [ ^code asCharacter ].
+ 	code <= 16rDBFF ifFalse: [ self invalid: 'High surrogate value expected' ].
+ 	"Parse the escaped low surrogate"
+ 	(stream next ifNil: [ self incomplete: 'Unexpected end of string' ]) == $\ 
+ 		ifFalse: [ self invalid: 'Escaped low surrogate expected.' ].
+ 	(stream next ifNil: [ self incomplete: 'Unexpected end of string' ]) == $u
+ 		ifFalse: [ self invalid: 'Escaped low surrogate expected.' ].
+ 	lowSurrogateCode := 0.
+ 	1 to: 4 do: [ :index |
+ 		(digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [
+ 			self invalid: 'Invalid hexadecimal digit' ].
+ 		digitValue < 16
+ 			ifTrue: [ lowSurrogateCode := lowSurrogateCode * 16 + digitValue ]
+ 			ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ].
+ 	(lowSurrogateCode >= 16rDC00 and: [ lowSurrogateCode <= 16rDFFF ]) 
+ 		ifFalse: [ ^self invalid: 'Escaped low surrogate expected.' ].
+ 	^((code - 16rD800 bitShift: 10) + lowSurrogateCode + '16r2400') asCharacter!
- 	|string a b c d|
- 	a := self nextHexDigit.
- 	b := self nextHexDigit.
- 	c := self nextHexDigit.
- 	d := self nextHexDigit.
- 	string := String with: a with: b with: c with: d.
- 	^ Unicode value: (Integer readFrom: string readStream base: 16)!

Item was added:
+ NumberParser subclass: #JsonNumberParser
+ 	instanceVariableNames: 'fraction leadingZeroesAllowed'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'JSON'!

Item was added:
+ ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') -----
+ allowPlusSign
+ 
+ 	^false!

Item was added:
+ ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') -----
+ allowPlusSignInExponent
+ 
+ 	^true!

Item was added:
+ ----- Method: JsonNumberParser>>error: (in category 'error') -----
+ error: aString
+ 
+ 	JsonSyntaxError signal: aString!

Item was added:
+ ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') -----
+ exponentLetters
+ 
+ 	^'eE'!

Item was added:
+ ----- Method: JsonNumberParser>>fiveRaisedTo: (in category 'parsing-private') -----
+ fiveRaisedTo: anInteger
+ 
+ 	anInteger >= 0 ifFalse: [ ^1 / (self fiveRaisedTo: 0 - anInteger) ].
+ 	anInteger >= 28 ifTrue: [ ^5 raisedToInteger: anInteger ].
+ 	^#(1 5 25 125 625 3125 15625 78125 390625 1953125 9765625 48828125 244140625 1220703125 6103515625 30517578125 152587890625 762939453125 3814697265625 19073486328125 95367431640625 476837158203125 2384185791015625 11920928955078125 59604644775390625 298023223876953125 1490116119384765625 7450580596923828125) at: anInteger + 1!

Item was added:
+ ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') -----
+ initialize
+ 
+ 	super initialize.
+ 	base := 10.
+ 	fraction := Fraction numerator: 0 denominator: 1.
+ 	leadingZeroesAllowed := false!

Item was added:
+ ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') -----
+ makeFloatFromMantissa: mantissa exponent: exponent
+ 	"Return a Float equal to mantissa * 10 ^ exponent."
+ 
+ 	exponent = 0 ifTrue: [ ^mantissa asFloat ].
+ 	exponent > 0 ifTrue: [
+ 		exponent <= 22 "Can 5 raisedToInteger: exponent be represented exactly as a Float? ((1 << Float precision - 1) log: 5) floor => 22"
+ 			ifFalse: [ 
+ 				exponent > 324 ifTrue: [ "(Float emax + Float precision * (2 log: 10)) ceiling => 324"
+ 					mantissa isZero ifTrue: [ ^0.0 ].
+ 					mantissa positive ifTrue: [ ^Float infinity ].
+ 					^Float negativeInfinity ].
+ 				^(mantissa * (self fiveRaisedTo: exponent)) asFloat timesTwoPower: exponent ]
+ 			ifTrue: [
+ 				mantissa highBitOfMagnitude <= Float precision ifTrue: [ "Mantissa can also be represented as an exact Float. Float >> #* should be exact."
+ 					^mantissa asFloat * (self fiveRaisedTo: exponent) asFloat timesTwoPower: exponent ] ].
+ 		^(mantissa * (self fiveRaisedTo: exponent)) asFloat timesTwoPower: exponent ].
+ 	"exponent < 0"
+ 	exponent >= -22 "Can 5 raisedToInteger: 0 - exponent be represented exactly as a Float?"
+ 		ifTrue: [
+ 			mantissa highBitOfMagnitude <= Float precision ifTrue: [ "Mantissa can also be represented as an exact Float. Float >> #/ should be exact."
+ 				^mantissa asFloat / (self fiveRaisedTo: 0 - exponent) asFloat timesTwoPower: exponent ] ]
+ 		ifFalse: [
+ 			exponent < -324 ifTrue: [ "-1 * (Float precision - Float emin * (2 log: 10)) ceiling => -324"
+ 				mantissa positive ifTrue: [ ^0.0 ].
+ 				^-0.0 ] ].
+ 	"No luck. Let Fraction >> #asFloat do the heavy lifting."
+ 	^(fraction setNumerator: mantissa denominator: ((self fiveRaisedTo: 0 - exponent) bitShift: 0 - exponent)) asFloat "Can't use #timesTwoPower: here. No #reduced here, because there's none in NumberParser either"!

Item was added:
+ ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') -----
+ nextElementaryLargeInteger
+ 	"Form an unsigned integer with incoming digits from sourceStream.
+ 	Return this integer, or zero if no digits found.
+ 	Stop reading if end of digits or if a LargeInteger is formed.
+ 	Count the number of digits and the position of lastNonZero digit and store them in instVar."
+ 
+ 	| digit value |
+ 	value := 0.
+ 	nDigits := 0.
+ 	lastNonZero := 0.
+ 	[
+ 		value isLarge ifTrue: [ ^value ].
+ 		((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 
+ 			or: [ digit >= 10 ]) ifTrue: [
+ 			sourceStream skip: -1.
+ 			^value ].
+ 		nDigits := nDigits + 1.
+ 		digit = 0
+ 			ifFalse: [
+ 				(lastNonZero = 0 and: [ nDigits > 1 and: [ leadingZeroesAllowed not ] ]) ifTrue: [ self error: 'Leading zeroes are not allowed.' ].
+ 				lastNonZero := nDigits.
+ 				value := value * 10 + digit ]
+ 			ifTrue: [ value := value * 10 ] ] repeat!

Item was added:
+ ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') -----
+ nextNumber: negative
+ 
+ 	| numberOfTrailingZeroInIntegerPart oldLeadingZeroesAllowed numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value |
+ 	integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ].
+ 	numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero.
+ 	(sourceStream peekFor: $.) ifFalse: [ "No fraction part"
+ 		negative ifTrue: [ integerPart := integerPart negated ].
+ 		self readExponent ifFalse: [ ^integerPart ].
+ 		exponent > 0 ifTrue: [ ^integerPart * (self fiveRaisedTo: exponent) bitShift: exponent ].
+ 		^self makeFloatFromMantissa: integerPart exponent: exponent ].
+ 	oldLeadingZeroesAllowed := leadingZeroesAllowed.
+ 	leadingZeroesAllowed := true.
+ 	fractionPart := self nextUnsignedIntegerOrNil.
+ 	leadingZeroesAllowed := oldLeadingZeroesAllowed.
+ 	fractionPart ifNil: [ self error: 'Missing fraction part!!' ].
+ 	fractionPart isZero ifTrue: [
+ 		self readExponent ifFalse: [
+ 			negative ifTrue: [
+ 				integerPart isZero ifTrue: [ ^Float negativeZero ].
+ 				^integerPart negated ].
+ 			^integerPart ].
+ 		exponent >= 0 ifTrue: [ 
+ 			negative ifTrue: [ integerPart := integerPart negated ].
+ 			^integerPart * (self fiveRaisedTo: exponent) bitShift: exponent ].
+ 		value := self makeFloatFromMantissa: integerPart exponent: exponent.
+ 		negative ifTrue: [ ^value negated ].
+ 		^value ].
+ 	numberOfTrailingZeroInFractionPart := nDigits - lastNonZero.
+ 	numberOfNonZeroFractionDigits := lastNonZero.
+ 	self readExponent.
+ 	exponent := exponent - numberOfNonZeroFractionDigits.
+ 	mantissa := (integerPart * (self fiveRaisedTo: numberOfNonZeroFractionDigits) bitShift: numberOfNonZeroFractionDigits) + (fractionPart // (self fiveRaisedTo: numberOfTrailingZeroInFractionPart) bitShift: 0 - numberOfTrailingZeroInFractionPart).
+ 	value := self makeFloatFromMantissa: mantissa exponent: exponent.
+ 	negative ifTrue: [ ^value negated ].
+ 	^value!

Item was added:
+ ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') -----
+ nextUnsignedIntegerOrNil
+ 	"Form an unsigned integer with incoming digits from sourceStream.
+ 	Answer this integer, or nil if no digit found.
+ 	Count the number of digits and the position of lastNonZero digit and store them in instVar"
+ 	
+ 	| nPackets high nDigitsHigh lastNonZeroHigh low |
+ 	"read no more digits than one elementary LargeInteger"
+ 	high := self nextElementaryLargeInteger.
+ 	nDigits = 0 ifTrue: [^nil].
+ 	
+ 	"Not enough digits to form a LargeInteger, stop iteration"
+ 	high isLarge ifFalse: [^high].
+ 
+ 	"We now have to engage arithmetic with LargeInteger
+ 	Decompose the integer in a high and low packets of growing size:"
+ 	nPackets := 1.
+ 	nDigitsHigh := nDigits.
+ 	lastNonZeroHigh := lastNonZero.
+ 	[
+ 	low := self nextLargeIntegerBase: 10 nPackets: nPackets .
+ 	high := (high * (self fiveRaisedTo: nDigits) bitShift: nDigits) + low.
+ 	lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh].
+ 	nDigitsHigh := nDigitsHigh + nDigits.
+ 	low isLarge]
+ 		whileTrue: [nPackets := nPackets * 2].
+ 
+ 	nDigits := nDigitsHigh.
+ 	lastNonZero := lastNonZeroHigh.
+ 	^high!

Item was added:
+ ----- Method: JsonObject>>at:put: (in category 'accessing') -----
+ at: aString put: anObject
+ 
+ 	aString isString ifFalse: [ self error: 'String expected' ].
+ 	super at: aString put: anObject.
+ 	^self!

Item was changed:
+ ----- Method: JsonObject>>doesNotUnderstand: (in category 'error handling') -----
- ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') -----
  doesNotUnderstand: aMessage
+ 
+ 	| key precedence |
- 	| key |
  	key := aMessage selector.
+ 	(precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ].
+ 	(precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [
+ 		^self
+ 			at: key allButLast asSymbol
+ 			put: aMessage arguments first ].
+ 	^super doesNotUnderstand: aMessage!
- 	key isUnary ifTrue: [^ self at: key ifAbsent: [nil]].
- 	^ (key isKeyword and: [(key occurrencesOf: $:) = 1])
- 		ifTrue: [key := key allButLast asSymbol.
- 				self at: key put: aMessage arguments first]
- 		ifFalse: [super doesNotUnderstand: aMessage]
- 				
- 	!

Item was added:
+ ----- Method: JsonObject>>respondsTo: (in category 'error handling') -----
+ respondsTo: aSymbol
+ 
+ 	| precedence |
+ 	(super respondsTo: aSymbol) ifTrue: [ ^true ].
+ 	(precedence := aSymbol precedence) = 1 ifTrue: [ 
+ 		^self includesKey: aSymbol ].
+ 	(precedence = 3 and: [ (aSymbol indexOf: $:) = aSymbol size ]) ifTrue: [
+ 		^self includesKey: aSymbol allButLast ].
+ 	^false!

Item was changed:
+ ----- Method: JsonTests>>assertIncompleteJson: (in category 'helpers') -----
- ----- Method: JsonTests>>assertIncompleteJson: (in category 'as yet unclassified') -----
  assertIncompleteJson: aString
  	self should: [self readFrom: aString] raise: JsonIncompleteError!

Item was changed:
+ ----- Method: JsonTests>>assertInvalidJson: (in category 'helpers') -----
- ----- Method: JsonTests>>assertInvalidJson: (in category 'as yet unclassified') -----
  assertInvalidJson: aString
  	self should: [self readFrom: aString] raise: JsonInvalidError!

Item was changed:
+ ----- Method: JsonTests>>json:equals: (in category 'helpers') -----
- ----- Method: JsonTests>>json:equals: (in category 'as yet unclassified') -----
  json: aString equals: aValue
  	| readValue |
  	readValue := self readFrom: aString.
+ 	self assert: aValue equals: readValue!
- 	self assert: readValue = aValue.!

Item was changed:
+ ----- Method: JsonTests>>readFrom: (in category 'helpers') -----
- ----- Method: JsonTests>>readFrom: (in category 'as yet unclassified') -----
  readFrom: aString
  	^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream
  !

Item was changed:
+ ----- Method: JsonTests>>render:equals: (in category 'helpers') -----
- ----- Method: JsonTests>>render:equals: (in category 'as yet unclassified') -----
  render: anObject equals: aString
  	self assert: (Json render: anObject) = aString!

Item was changed:
+ ----- Method: JsonTests>>simpleDummyObject (in category 'helpers') -----
- ----- Method: JsonTests>>simpleDummyObject (in category 'as yet unclassified') -----
  simpleDummyObject
  	^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself!

Item was changed:
+ ----- Method: JsonTests>>testArray (in category 'tests') -----
- ----- Method: JsonTests>>testArray (in category 'as yet unclassified') -----
  testArray
  	self json: '[]' equals: #().
  	self json: '[[]]' equals: #(#()).
  	self json: '[[], []]' equals: #(#() #()).
  	self json: '["hi", "there"]' equals: #('hi' 'there').
  	self json: '[["a", "b", null]]' equals: #(('a' 'b' nil)).!

Item was changed:
+ ----- Method: JsonTests>>testAtomFalse (in category 'tests') -----
- ----- Method: JsonTests>>testAtomFalse (in category 'as yet unclassified') -----
  testAtomFalse
  	self json: 'false' equals: false.
  	self json: '  false' equals: false.
  	self json: 'false  ' equals: false.
  	self json: '  false  ' equals: false.
  !

Item was changed:
+ ----- Method: JsonTests>>testAtomNull (in category 'tests') -----
- ----- Method: JsonTests>>testAtomNull (in category 'as yet unclassified') -----
  testAtomNull
  	self json: 'null' equals: nil.
  	self json: '  null' equals: nil.
  	self json: 'null  ' equals: nil.
  	self json: '  null  ' equals: nil.
  !

Item was changed:
+ ----- Method: JsonTests>>testAtomNumber (in category 'tests') -----
- ----- Method: JsonTests>>testAtomNumber (in category 'as yet unclassified') -----
  testAtomNumber
  	self json: '1' equals: 1.
+ 	self json: '123' equals: 123.
+ 	self should: [ self json: '0123' equals: 123 ] raise: JsonSyntaxError. "No leading zeroes."
- 	self json: '0123' equals: 123.
  	self json: '1.23e2' equals: 123.
  	self json: '-1' equals: -1.
  	self json: '-0' equals: 0.
  	self json: '[-1.2]' equals: #(-1.2).!

Item was changed:
+ ----- Method: JsonTests>>testAtomString (in category 'tests') -----
- ----- Method: JsonTests>>testAtomString (in category 'as yet unclassified') -----
  testAtomString
+ 
  	self json: '"hi"' equals: 'hi'.
  	self json: '"\""' equals: '"'.
  	self json: '"\\"' equals: '\'.
  	self json: '""' equals: ''.
  	self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String).
+ 	self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).
+ 	self json: '"a\uD834\uDD1Eb"' equals: ({$a. Character value: 16r1D11E. $b} as: String).
+ 	!
- 	self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).!

Item was changed:
+ ----- Method: JsonTests>>testAtomTrue (in category 'tests') -----
- ----- Method: JsonTests>>testAtomTrue (in category 'as yet unclassified') -----
  testAtomTrue
  	self json: 'true' equals: true.
  	self json: '  true' equals: true.
  	self json: 'true  ' equals: true.
  	self json: '  true  ' equals: true.
  !

Item was changed:
+ ----- Method: JsonTests>>testCtor (in category 'tests') -----
- ----- Method: JsonTests>>testCtor (in category 'as yet unclassified') -----
  testCtor
  	self json: '@JsonDummyTestObject {"a": 1, "b": 2, "c": 3}' equals: self simpleDummyObject.
  	self json: (Json render: self simpleDummyObject) equals: self simpleDummyObject.!

Item was changed:
+ ----- Method: JsonTests>>testDictionary (in category 'tests') -----
- ----- Method: JsonTests>>testDictionary (in category 'as yet unclassified') -----
  testDictionary
  	self json: '{}' equals: (JsonObject new).
  	self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself).
  	self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself).
  	self json: '{"a":"b", "b":"a"}' equals: (JsonObject new add: 'a'->'b'; add: 'b'->'a';yourself).!

Item was added:
+ ----- Method: JsonTests>>testDictionaryClass (in category 'tests') -----
+ testDictionaryClass
+ 
+ 	| parser |
+ 	parser := Json new.
+ 	self assert: (parser readFrom: '{}' readStream) class == JsonObject.
+ 	parser dictionaryClass: OrderedJsonObject.
+ 	self assert: (parser readFrom: '{}' readStream) class == OrderedJsonObject.
+ 	self assert: (parser readFrom: '{"x":{"y":{}}}' readStream) x y class == OrderedJsonObject!

Item was changed:
+ ----- Method: JsonTests>>testIncomplete (in category 'tests') -----
- ----- Method: JsonTests>>testIncomplete (in category 'as yet unclassified') -----
  testIncomplete
  	self assertIncompleteJson: ''.
  	self assertIncompleteJson: '  '.
  	self assertIncompleteJson: '  tr'.
  	self assertIncompleteJson: 'tru'.
  	self assertIncompleteJson: '['.
  	self assertIncompleteJson: '[true'.
  	self assertIncompleteJson: '[true,'.
  	self assertIncompleteJson: '{'.
  	self assertIncompleteJson: '{"hi"'.
  	self assertIncompleteJson: '{"hi":'.
  	self assertIncompleteJson: '{"hi":true'.
  	self assertIncompleteJson: '{"hi":true,'.
  	self assertIncompleteJson: '{"hi":true,"'.
  	self assertIncompleteJson: '"hello'.
  	self assertIncompleteJson: '"hello '.
  	self assertIncompleteJson: '"hello\'.
  	self assertIncompleteJson: '"\u26'.!

Item was changed:
+ ----- Method: JsonTests>>testInvalid (in category 'tests') -----
- ----- Method: JsonTests>>testInvalid (in category 'as yet unclassified') -----
  testInvalid
  	self assertInvalidJson: 'x'.
  	self assertInvalidJson: '  x'.
  	self assertInvalidJson: '  trx'.
  	self assertInvalidJson: 'trux'.
  	self assertInvalidJson: '.'.
  	self assertInvalidJson: ':'.
  	self assertInvalidJson: ','.
  	self assertInvalidJson: ']'.
  	self assertInvalidJson: '}'.
  	self assertInvalidJson: '[x'.
  	self assertInvalidJson: '[true t'.
  	self assertInvalidJson: '[true,]'.
  	self assertInvalidJson: '{]'.
  	self assertInvalidJson: '{,'.
  	self assertInvalidJson: '{"hi",'.
  	self assertInvalidJson: '{"hi":x'.
  	self assertInvalidJson: '{"hi":,'.
  	self assertInvalidJson: '{"hi":true "'.
  	self assertInvalidJson: '{"hi":true,}'.
  	self assertInvalidJson: '\u263A'.!

Item was changed:
+ ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'tests') -----
- ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'as yet unclassified') -----
  testInvalidUnicodeEscapes
  	self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong."
  	self assertInvalidJson: '"\u2Z"'.
  	self assertInvalidJson: '"\u2Z44"'.!

Item was added:
+ ----- Method: JsonTests>>testJsonObjectAtPutReturnsTheObject (in category 'tests') -----
+ testJsonObjectAtPutReturnsTheObject
+ 
+ 	{ JsonObject. OrderedJsonObject } do: [ :jsonObjectClass |
+ 		| json |
+ 		json := 	jsonObjectClass new.
+ 		self assert: (json at: 'foo' put: 1) == json.
+ 		self assert: (json foo: 1) == json ]!

Item was changed:
+ ----- Method: JsonTests>>testMissingCtor (in category 'tests') -----
- ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') -----
  testMissingCtor
  	self assertInvalidJson: '@Missing[]'!

Item was changed:
+ ----- Method: JsonTests>>testMissingCtorNoMap (in category 'tests') -----
- ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') -----
  testMissingCtorNoMap
  	self 
  		should: [Json new readFrom: '@Missing[]' readStream]
  		raise: JsonInvalidError!

Item was added:
+ ----- Method: JsonTests>>testNonStringKeysRaiseError (in category 'tests') -----
+ testNonStringKeysRaiseError
+ 
+ 	{ JsonObject. OrderedJsonObject } do: [ :jsonObjectClass |
+ 		| json |
+ 		json := 	jsonObjectClass new.
+ 		self should: [ json at: 1 put: 1 ] raise: Error.
+ 		self assert: json isEmpty.
+ 		json at: '1' put: 1.
+ 		self assert: 1 equals: (json at: '1') ]!

Item was changed:
+ ----- Method: JsonTests>>testStreaming (in category 'tests') -----
- ----- Method: JsonTests>>testStreaming (in category 'as yet unclassified') -----
  testStreaming
  	| j |
  	j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream.
  	self assert: j readAny equals: true.
  	self assert: j readAny equals: false.
  	self assert: j readAny equals: true.
  	self assert: j readAny equals: #().
  	self assert: j readAny equals: JsonObject new.
  	self assert: j readAny equals: 1.234.
  	self assert: j readAny equals: 5.678.
  	self assert: j readAny equals: 'A'.
  	self assert: j readAny equals: 'B'.
  	self assert: j readAny equals: nil.
  	self assert: j readAny equals: nil.!

Item was changed:
+ ----- Method: JsonTests>>testStringWithUnicode (in category 'tests') -----
- ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') -----
  testStringWithUnicode
  
  	| unicodeString |
  	unicodeString := (Unicode value: 16r263A) asString.
  	self json: '"\u263A"' equals:unicodeString.
  	self json: '"\u263a"' equals:unicodeString.
  	self json: '"', unicodeString, '"' equals: unicodeString.
  	self render: unicodeString equals: '"', unicodeString, '"'.!

Item was changed:
+ ----- Method: JsonTests>>testWriteAssociation (in category 'tests') -----
- ----- Method: JsonTests>>testWriteAssociation (in category 'as yet unclassified') -----
  testWriteAssociation
  	self render: 'key' -> 'value' equals: '"key": "value"'.
  	self render: 'key' -> 2 equals: '"key": 2'.
  	"keys should be strings"
  	self render: 42 -> 2 equals: '"42": 2'.
  	"try to do _something_ for more complex keys"
  	self render: #(42 43 44) -> 2 equals:  '"#(42 43 44)": 2'.
  	
  	
  	!

Item was changed:
+ ----- Method: JsonTests>>testWriteString (in category 'tests') -----
- ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') -----
  testWriteString
  	self render: '"' equals: '"\""'.
  	self render: '\' equals: '"\\"'.
  	self render: 'hi' equals: '"hi"'.
  	self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'.
  	self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.!

Item was added:
+ OrderedDictionary subclass: #OrderedJsonObject
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'JSON'!

Item was added:
+ ----- Method: OrderedJsonObject class>>fromAssociations: (in category 'as yet unclassified') -----
+ fromAssociations: collectionOfAssociations
+ 
+ 	| result |
+ 	result := self new.
+ 	
+ 	collectionOfAssociations do: [:each |
+ 		result at: each key put: each value ].
+ 	^ result!

Item was added:
+ ----- Method: OrderedJsonObject>>at: (in category 'accessing') -----
+ at: aKey
+ 
+ 	"make it work more like javascript objects"
+ 	^ self at: aKey ifAbsent: [nil]!

Item was added:
+ ----- Method: OrderedJsonObject>>at:put: (in category 'accessing') -----
+ at: aString put: anObject
+ 
+ 	aString isString ifFalse: [ self error: 'String expected' ].
+ 	super at: aString put: anObject.
+ 	^self!

Item was added:
+ ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'error handling') -----
+ doesNotUnderstand: aMessage
+ 
+ 	| key precedence |
+ 	key := aMessage selector.
+ 	(precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ].
+ 	(precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [
+ 		^self
+ 			at: key allButLast asSymbol
+ 			put: aMessage arguments first ].
+ 	^super doesNotUnderstand: aMessage!

Item was added:
+ ----- Method: OrderedJsonObject>>name (in category 'accessing') -----
+ name
+ "override 'cause Object defines this"
+ 	^self at: 'name'!

Item was added:
+ ----- Method: OrderedJsonObject>>value (in category 'accessing') -----
+ value
+ "override 'cause Object defines this"
+ 	^self at: 'value'!

Item was added:
+ ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') -----
+ jsonWriteOn: stream
+ 
+ 	self printOn: stream showingDecimalPlaces: scale!

Item was added:
+ Object subclass: #SerializedJson
+ 	instanceVariableNames: 'jsonString'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'JSON'!

Item was added:
+ ----- Method: SerializedJson class>>on: (in category 'instance creation') -----
+ on: aString
+ 
+ 	^self new
+ 		jsonString: aString;
+ 		yourself!

Item was added:
+ ----- Method: SerializedJson>>jsonString (in category 'accessing') -----
+ jsonString
+ 	
+ 	^jsonString
+ !

Item was added:
+ ----- Method: SerializedJson>>jsonString: (in category 'accessing') -----
+ jsonString: aString
+ 	
+ 	jsonString := aString
+ !

Item was added:
+ ----- Method: SerializedJson>>jsonWriteOn: (in category 'json-writing') -----
+ jsonWriteOn: stream
+ 
+ 	stream nextPutAll: jsonString!

Item was added:
+ ----- Method: String>>asSerializedJson (in category '*JSON') -----
+ asSerializedJson
+ 	" Assume that the receiver is a valid serialized json string.
+ 	Return an object that understands #jsonWriteOn: and will
+ 	write this string on its argument. "
+ 
+ 	^SerializedJson on: self!

Item was changed:
  ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') -----
  jsonWriteOn: aStream
  
+ 	| index start |
  	aStream nextPut: $".
+ 	start := 1.
+ 	[ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [
+ 		aStream next: index - start putAll: self startingAt: start.
+ 		aStream nextPutAll: (Json escapeForCharacter: (self at: index)).
+ 		start := index + 1 ].
+ 	start <= self size ifTrue: [
+ 		aStream next: self size + 1 - start putAll: self startingAt: start ].
- 	self do: [ :ch |
- 		(Json escapeForCharacter: ch)
- 			ifNil: [ aStream nextPut: ch ]
- 			ifNotNil: [ :replacement |
- 				aStream nextPutAll: replacement ] ].
  	aStream nextPut: $".
  !

Item was added:
+ ----- Method: String>>parseAsJson (in category '*JSON') -----
+ parseAsJson
+ 	"Convenience"
+ 
+ 	^Json readFrom: self readStream!

Item was added:
+ ----- Method: String>>parseAsOrderedJson (in category '*JSON') -----
+ parseAsOrderedJson
+ 	"Convenience"
+ 
+ 	^Json new
+ 		dictionaryClass: OrderedJsonObject;
+ 		readFrom: self readStream!

Item was added:
+ ----- Method: Time>>jsonWriteOn: (in category '*JSON') -----
+ jsonWriteOn: stream
+ 
+ 	stream nextPut: $".
+ 	self print24: true showSeconds: true on: stream.
+ 	stream nextPut: $"!




More information about the Squeak-dev mailing list