[squeak-dev] The Trunk: JSON-ul.15.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Sep 8 14:57:30 UTC 2022


Christoph Thiede uploaded a new version of JSON to project The Trunk:
http://source.squeak.org/trunk/JSON-ul.15.mcz

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

Name: JSON-ul.15
Author: ul
Time: 4 November 2008, 7:31:42 am
UUID: c5bb462e-3d57-aa44-b199-0a8bada56309
Ancestors: JSON-djr.14

- fix: Control characters are escaped.
- enh: rendering time decreased (especially for strings)
- unnecessary spaces after commas and columns are not rendered


==================== Snapshot ====================

SystemOrganization addCategory: #JSON!

----- Method: ArrayedCollection>>jsonWriteOn: (in category '*JSON-writing') -----
jsonWriteOn: aStream

	aStream nextPut: $[.
	self size > 0 ifTrue: [
		(self at: 1) jsonWriteOn: aStream.
		2 to: self size do: [ :index |
			aStream nextPut: $,.
			(self at: index) jsonWriteOn: aStream ] ].
	aStream nextPut: $]!

Object subclass: #Json
	instanceVariableNames: 'stream ctorMap'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'JSON'!
Json class
	instanceVariableNames: 'escapeArray'!

!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'!

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

----- Method: Json class>>initialize (in category 'as yet unclassified') -----
initialize
	"Json initialize."
	
	escapeArray := Array new: 128.
	(0 to: 31), #(127) do: [ :each |
		escapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0) ].
	{
		$" -> '\"'.
		$\ -> '\\'.
		Character backspace -> '\b'.
		Character lf -> '\n'.
		Character newPage -> '\f'.
		Character cr -> '\r'.
		Character tab -> '\t'.
	} do: [ :each |
		escapeArray at: each key asciiValue + 1 put: each value ].
!

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

----- 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.!

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

----- Method: Json class>>readFrom: (in category 'as yet unclassified') -----
readFrom: aStream
	^ self new readFrom: aStream.!

----- Method: Json class>>render: (in category 'as yet unclassified') -----
render: anObject
	| s |
	s := WriteStream on: String new.
	anObject jsonWriteOn: s.
	^ s contents.!

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

----- 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!

----- Method: Json>>consume:returning: (in category 'private') -----
consume: aString returning: anObject
	aString do: [:c | self next == c ifFalse: [JsonSyntaxError signal: 'Expected ''', aString, ''''] ].
	^ anObject!

----- Method: Json>>ctorMap (in category 'accessing') -----
ctorMap
	^ ctorMap!

----- Method: Json>>ctorMap: (in category 'accessing') -----
ctorMap: m
	ctorMap _ m!

----- Method: Json>>interpretStringEscape (in category 'private') -----
interpretStringEscape
	| c |
	c := self next.
	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.!

----- Method: Json>>next (in category 'private') -----
next
	^ self stream next!

----- Method: Json>>peek (in category 'private') -----
peek
	^ self stream peek!

----- 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.
	c := self peek asLowercase.
	c == ${ ifTrue: [self next. ^ self readDictionary].
	c == $[ ifTrue: [self next. ^ self readArray].
	c == $" ifTrue: [self 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: [self next. ^ self readConstructor].
	(Json numbersMayContain: c) ifTrue: [^ self readNumber].
	JsonSyntaxError signal: 'Unknown Json input'!

----- Method: Json>>readArray (in category 'private') -----
readArray
	| a needComma |
	a := OrderedCollection new.
	needComma _ false.
	[
		self skipWhitespace.
		self peek == $] ifTrue: [self next. ^ a asArray].
		needComma
			ifTrue: [self peek == $, ifFalse: [JsonSyntaxError signal: 'Missing comma'].
					self next.]
			ifFalse: [needComma _ true]. 
		a add: self readAny.
	] repeat.
!

----- Method: Json>>readConstructor (in category 'private') -----
readConstructor
	| s c v ctor |
	s := WriteStream on: ''.
	[
		c := self peek.
		c ifNil: [JsonSyntaxError signal: 'Premature EOF reading constructor name'].
		((c == $.) or: [c isLetter])
			ifTrue: [s nextPut: c. self next]
			ifFalse: [
				v := self readAny.
				s := s contents.
				ctor _ ctorMap ifNotNil: [ctor _ ctorMap at: s ifAbsent: [nil]].
				ctor ifNil: [JsonSyntaxError signal: 'Unknown ctor ', s].
				^ ctor constructFromJson: v]
	] repeat.
!

----- Method: Json>>readDictionary (in category 'private') -----
readDictionary
	| m k v needComma |
	m := Dictionary new.
	needComma _ false.
	[
		self skipWhitespace.
		self peek == $} ifTrue: [self next. ^ m].
		needComma
			ifTrue: [self peek == $, ifFalse: [JsonSyntaxError signal: 'Missing comma'].
					self next. self skipWhitespace]
			ifFalse: [needComma _ true.].
		self next == $" ifFalse: [JsonSyntaxError signal: 'Key in dictionary must be string'].
		k := self readString.
		self skipWhitespace.
		self peek == $: ifFalse: [JsonSyntaxError signal: 'Missing colon'].
		self next.
		v := self readAny.
		m at: k put: v.
	] repeat.
!

----- Method: Json>>readFrom: (in category 'parsing') -----
readFrom: aStream
	self stream: aStream.
	^ self readAny!

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

----- Method: Json>>readString (in category 'private') -----
readString
	| s c |
	s := WriteStream on: ''.
	[
		c := self next.
		c == $\
			ifTrue: [s nextPut: self interpretStringEscape.]
			ifFalse: [c == $" ifTrue: [^ s contents.].
					s nextPut: c]
	] repeat.!

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

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

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

----- Method: Json>>skipWhitespace (in category 'private') -----
skipWhitespace
	[self peek isSeparator] whileTrue: [self next].
	self skipComment.!

----- Method: Json>>stream (in category 'accessing') -----
stream
	"Answer the value of stream"

	^ stream!

----- Method: Json>>stream: (in category 'accessing') -----
stream: anObject
	"Set the value of stream"

	stream := anObject.
	(stream respondsTo: #reset) ifTrue: [
		stream reset.
	].
!

----- Method: Json>>unescapeUnicode (in category 'private') -----
unescapeUnicode
	|string|
	string := (String with: self next with: self next with: self next with: self next) asUppercase.
	^ Unicode value: (Number readFrom: '16r', string)!

Object subclass: #JsonDummyTestObject
	instanceVariableNames: 'a b c'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'JSON'!

----- Method: JsonDummyTestObject class>>constructFromJson: (in category 'as yet unclassified') -----
constructFromJson: j
	^ self new a: (j at: 'a'); b: (j at: 'b'); c: (j at: 'c'); yourself!

----- Method: JsonDummyTestObject>>= (in category 'as yet unclassified') -----
= other
	^ other class == self class and: [
		a = other a and: [
		b = other b and: [
		c = other c]]]!

----- Method: JsonDummyTestObject>>a (in category 'accessing') -----
a
	"Answer the value of a"

	^ a!

----- Method: JsonDummyTestObject>>a: (in category 'accessing') -----
a: anObject
	"Set the value of a"

	a _ anObject!

----- Method: JsonDummyTestObject>>b (in category 'accessing') -----
b
	"Answer the value of b"

	^ b!

----- Method: JsonDummyTestObject>>b: (in category 'accessing') -----
b: anObject
	"Set the value of b"

	b _ anObject!

----- Method: JsonDummyTestObject>>c (in category 'accessing') -----
c
	"Answer the value of c"

	^ c!

----- Method: JsonDummyTestObject>>c: (in category 'accessing') -----
c: anObject
	"Set the value of c"

	c _ anObject!

----- Method: JsonDummyTestObject>>jsonWriteOn: (in category 'as yet unclassified') -----
jsonWriteOn: s
	Json renderInstanceVariables: {#a. #b. #c} of: self on: s
!

----- Method: True>>jsonWriteOn: (in category '*JSON-writing') -----
jsonWriteOn: aStream
	aStream nextPutAll: 'true'!

----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') -----
jsonWriteOn: aWriteStream 

	self printOn: aWriteStream base: 10!

----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') -----
jsonWriteOn: aStream

	| needComma |
	needComma := false.
	aStream nextPut: $[.
	self do: [ :v |
		needComma
			ifTrue: [ aStream nextPut: $, ]
			ifFalse: [ needComma := true ].
		v jsonWriteOn: aStream ].
	aStream nextPut: $]!

----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') -----
jsonWriteOn: aStream

	| needComma |
	needComma := false.
	aStream nextPut: ${.
	self associationsDo: [ :assoc |
		needComma
			ifTrue: [ aStream nextPut: $, ]
			ifFalse: [ needComma := true ].
		assoc key asString jsonWriteOn: aStream.
		aStream nextPut: $:.
		assoc value jsonWriteOn: aStream ].
	aStream nextPut: $}.!

----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') -----
jsonWriteOn: aWriteStream 
	aWriteStream nextPutAll: 'null'!

----- Method: String>>jsonWriteOn: (in category '*JSON-writing') -----
jsonWriteOn: aStream

	| replacement |
	aStream nextPut: $".
	self do: [ :ch |
		(replacement := Json escapeForCharacter: ch)
			ifNil: [ aStream nextPut: ch ]
			ifNotNil: [ aStream nextPutAll: replacement ] ].
	aStream nextPut: $".
!

----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') -----
jsonWriteOn: aWriteStream
	
	aWriteStream nextPutAll: (self printStringBase: 10)!

Error subclass: #JsonSyntaxError
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'JSON'!

!JsonSyntaxError commentStamp: '<historical>' prior: 0!
Class Json signals instances of me when an input stream contains invalid JSON input.!

TestCase subclass: #JsonTests
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'JSON'!

!JsonTests commentStamp: '<historical>' prior: 0!
I provide a number of test cases for class Json.!

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

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

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

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

----- 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)).!

----- 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.
!

----- 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.
!

----- Method: JsonTests>>testAtomNumber (in category 'as yet unclassified') -----
testAtomNumber
	self json: '1' equals: 1.
	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).!

----- Method: JsonTests>>testAtomString (in category 'as yet unclassified') -----
testAtomString
	self json: '"hi"' equals: 'hi'.
	self json: '"\""' equals: '"'.
	self json: '"\\"' equals: '\'.
	self json: '""' equals: ''.!

----- 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.
!

----- 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.!

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

----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') -----
testMissingCtor
	self should: [self readFrom: '@Missing[]']
		raise: JsonSyntaxError
		whoseDescriptionIncludes: 'Unknown ctor'
		description: 'Unknown ctor'
!

----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') -----
testMissingCtorNoMap
	self should: [Json new readFrom: '@Missing[]' readStream]
		raise: JsonSyntaxError
		whoseDescriptionIncludes: 'Unknown ctor'
		description: 'Unknown ctor'
!

----- 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"'.!

----- Method: False>>jsonWriteOn: (in category '*JSON-writing') -----
jsonWriteOn: aStream
	aStream nextPutAll: 'false'!



More information about the Squeak-dev mailing list