Squeak-dev September 2022

squeak-dev@lists.squeakfoundation.org

29 participants
158 discussions

The Trunk: JSON-matthias.berth.26.mcz
by commits＠source.squeak.org 08 Sep '22

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-matthias.berth.26.mcz ==================== Summary ==================== Name: JSON-matthias.berth.26 Author: matthias.berth Time: 19 November 2009, 6:03:27 pm UUID: 7c715040-c8a1-485f-a5e8-6517ca2c3d56 Ancestors: JSON-tonyg.25 Added Association>>jsonWriteOn: This makes it easier to write key-value pairs, for example: {#date -> document date asString. #author -> document author name. #title -> document tile} do: [:each | each jsonWriteOn: aStream] separatedBy: [aStream nextPutAll: ', ']. The association's key will be converted to a string (using #asString), the value must understand #jsonWriteOn: . =============== Diff against JSON-tonyg.25 =============== Item was added: + ----- Method: Association>>jsonWriteOn: (in category '*JSON-writing') ----- + jsonWriteOn: aStream + self key asString jsonWriteOn: aStream. + aStream nextPut: $:; space. + self value jsonWriteOn: aStream.! Item was added: + ----- 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'. + + + !

1 0

The Trunk: JSON-AliceCengal.1.mcz
by commits＠source.squeak.org 08 Sep '22

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-AliceCengal.1.mcz ==================== Summary ==================== Name: JSON-AliceCengal.1 Author: AliceCengal Time: 1 June 2013, 7:23:35.114 pm UUID: 347fedb7-465b-4e26-b6ae-578b950c95e0 Ancestors: empty log message ==================== Snapshot ==================== SystemOrganization addCategory: #JSON!

1 0

The Trunk: JSON-tonyg.5.mcz
by commits＠source.squeak.org 08 Sep '22

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-tonyg.5.mcz ==================== Summary ==================== Name: JSON-tonyg.5 Author: tonyg Time: 17 August 2005, 9:11:25 am UUID: 816e300c-0ef6-11da-8a34-000a95e87d06 Ancestors: JSON-tonyg.4 Support exponents in numeric syntax. ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! Object subclass: #Json instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !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.! ----- 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 stream: aStream; readAny.! ----- Method: Json class>>render: (in category 'as yet unclassified') ----- render: anObject | s | s := WriteStream on: String new. anObject jsonWriteOn: s. ^ s contents.! ----- 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>>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.! ----- 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]. (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>>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>>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! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: self asString.! ----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. aStream nextPut: $].! ----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma _ false. aStream nextPut: ${. self keysAndValuesDo: [:k :v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma _ true ]. k asString jsonWriteOn: aStream. aStream nextPutAll: ': '. v 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 aStream nextPut: $". self do: [:ch | (ch == $" or: [ch == $\]) ifTrue: [ aStream nextPut: $\; nextPut: ch ] ifFalse: [ aStream nextPut: ch. "TODO: escape special chars (lf, cr, tab etc) properly" #tonyg. ] ]. aStream nextPut: $". ! 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 self assert: (Json readFrom: aString readStream) = aValue.! ----- 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>>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: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

The Trunk: JSON-tonyg.6.mcz
by commits＠source.squeak.org 08 Sep '22

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-tonyg.6.mcz ==================== Summary ==================== Name: JSON-tonyg.6 Author: tonyg Time: 17 August 2005, 4:25:56 pm UUID: 34fdb8f6-0f33-11da-b78c-000a95e87d06 Ancestors: JSON-tonyg.5 Deal with characters requiring escaping in strings being encoded to JSON. ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! Object subclass: #Json instanceVariableNames: 'stream' classVariableNames: 'CharacterEscapeMap' poolDictionaries: '' category: 'JSON'! !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.! ----- Method: Json class>>escapeForCharacter: (in category 'as yet unclassified') ----- escapeForCharacter: c ^ CharacterEscapeMap at: c ifAbsent: [nil]! ----- Method: Json class>>initialize (in category 'as yet unclassified') ----- initialize "Json initialize." CharacterEscapeMap := Dictionary newFrom: { $" -> $". $\ -> $\. Character backspace -> $b. Character lf -> $n. Character newPage -> $f. Character cr -> $r. Character tab -> $t. }.! ----- 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 stream: aStream; readAny.! ----- Method: Json class>>render: (in category 'as yet unclassified') ----- render: anObject | s | s := WriteStream on: String new. anObject jsonWriteOn: s. ^ s contents.! ----- 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>>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.! ----- 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]. (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>>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>>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! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: self asString.! ----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. aStream nextPut: $].! ----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma _ false. aStream nextPut: ${. self keysAndValuesDo: [:k :v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma _ true ]. k asString jsonWriteOn: aStream. aStream nextPutAll: ': '. v 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. replacement ifNil: [ aStream nextPut: ch ] ifNotNil: [ aStream nextPut: $\; nextPut: replacement ]. ]. aStream nextPut: $". ! 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 self assert: (Json readFrom: aString readStream) = aValue.! ----- Method: JsonTests>>render:equals: (in category 'as yet unclassified') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- 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>>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>>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'!

1 0

The Trunk: JSON-tonyg.7.mcz
by commits＠source.squeak.org 08 Sep '22

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-tonyg.7.mcz ==================== Summary ==================== Name: JSON-tonyg.7 Author: tonyg Time: 24 August 2005, 8:22:45 pm UUID: 0d8c7028-3fb4-fe43-82f1-86c426569c62 Ancestors: JSON-tonyg.6 Add "mimeType" class method ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! Object subclass: #Json instanceVariableNames: 'stream' classVariableNames: 'CharacterEscapeMap' poolDictionaries: '' category: 'JSON'! !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.! ----- Method: Json class>>escapeForCharacter: (in category 'as yet unclassified') ----- escapeForCharacter: c ^ CharacterEscapeMap at: c ifAbsent: [nil]! ----- Method: Json class>>initialize (in category 'as yet unclassified') ----- initialize "Json initialize." CharacterEscapeMap := Dictionary newFrom: { $" -> $". $\ -> $\. Character backspace -> $b. Character lf -> $n. Character newPage -> $f. Character cr -> $r. Character tab -> $t. }.! ----- Method: Json class>>mimeType (in category 'as yet unclassified') ----- mimeType ^ 'application/x-json'! ----- 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 stream: aStream; readAny.! ----- Method: Json class>>render: (in category 'as yet unclassified') ----- render: anObject | s | s := WriteStream on: String new. anObject jsonWriteOn: s. ^ s contents.! ----- 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>>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.! ----- 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]. (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>>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>>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! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: self asString.! ----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. aStream nextPut: $].! ----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma _ false. aStream nextPut: ${. self keysAndValuesDo: [:k :v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma _ true ]. k asString jsonWriteOn: aStream. aStream nextPutAll: ': '. v 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. replacement ifNil: [ aStream nextPut: ch ] ifNotNil: [ aStream nextPut: $\; nextPut: replacement ]. ]. aStream nextPut: $". ! 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 self assert: (Json readFrom: aString readStream) = aValue.! ----- Method: JsonTests>>render:equals: (in category 'as yet unclassified') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- 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>>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>>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'!

1 0

The Trunk: JSON-tonyg.11.mcz
by commits＠source.squeak.org 08 Sep '22

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-tonyg.11.mcz ==================== Summary ==================== Name: JSON-tonyg.11 Author: tonyg Time: 30 November 2005, 4:42:51 pm UUID: 0150b3b0-5169-c049-9aa2-f59faca78bb7 Ancestors: JSON-tonyg.10 Simple bean-like instance-variable save utility. ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! Object subclass: #Json instanceVariableNames: 'stream ctorMap' classVariableNames: 'CharacterEscapeMap' poolDictionaries: '' category: 'JSON'! !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.! ----- Method: Json class>>escapeForCharacter: (in category 'as yet unclassified') ----- escapeForCharacter: c ^ CharacterEscapeMap at: c ifAbsent: [nil]! ----- Method: Json class>>initialize (in category 'as yet unclassified') ----- initialize "Json initialize." CharacterEscapeMap := Dictionary newFrom: { $" -> $". $\ -> $\. Character backspace -> $b. Character lf -> $n. Character newPage -> $f. Character cr -> $r. Character tab -> $t. }.! ----- 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.! ----- 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! 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: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: self asString.! ----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. aStream nextPut: $].! ----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma _ false. aStream nextPut: ${. self keysAndValuesDo: [:k :v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma _ true ]. k asString jsonWriteOn: aStream. aStream nextPutAll: ': '. v 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. replacement ifNil: [ aStream nextPut: ch ] ifNotNil: [ aStream nextPut: $\; nextPut: replacement ]. ]. aStream nextPut: $". ! 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'!

1 0

The Trunk: JSON-sp.12.mcz
by commits＠source.squeak.org 08 Sep '22

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-sp.12.mcz ==================== Summary ==================== Name: JSON-sp.12 Author: sp Time: 18 April 2006, 7:43:57 pm UUID: e9b5cbf9-cf02-11da-9c1d-000a95c90546 Ancestors: JSON-tonyg.11 empty log message ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! Object subclass: #Json instanceVariableNames: 'stream ctorMap' classVariableNames: 'CharacterEscapeMap' poolDictionaries: '' category: 'JSON'! !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.! ----- Method: Json class>>escapeForCharacter: (in category 'as yet unclassified') ----- escapeForCharacter: c ^ CharacterEscapeMap at: c ifAbsent: [nil]! ----- Method: Json class>>initialize (in category 'as yet unclassified') ----- initialize "Json initialize." CharacterEscapeMap := Dictionary newFrom: { $" -> $". $\ -> $\. Character backspace -> $b. Character lf -> $n. Character newPage -> $f. Character cr -> $r. Character tab -> $t. }.! ----- 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.! ----- 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! 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: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: self asString.! ----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. aStream nextPut: $].! ----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma _ false. aStream nextPut: ${. self keysAndValuesDo: [:k :v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma _ true ]. k asString jsonWriteOn: aStream. aStream nextPutAll: ': '. v 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. replacement ifNil: [ aStream nextPut: ch ] ifNotNil: [ aStream nextPut: $\; nextPut: replacement ]. ]. aStream nextPut: $". ! 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'!

1 0

The Trunk: JSON-aesp.13.mcz
by commits＠source.squeak.org 08 Sep '22

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-aesp.13.mcz ==================== Summary ==================== Name: JSON-aesp.13 Author: aesp Time: 5 July 2007, 1:22:52 pm UUID: 4ea4481a-2ad9-11dc-8583-00145127fcd4 Ancestors: JSON-sp.12 fixed bug with passed stream position over end, added simple unicode \uXXXX unescaping while reading json ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! Object subclass: #Json instanceVariableNames: 'stream ctorMap' classVariableNames: 'CharacterEscapeMap' poolDictionaries: '' category: 'JSON'! !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.! ----- Method: Json class>>escapeForCharacter: (in category 'as yet unclassified') ----- escapeForCharacter: c ^ CharacterEscapeMap at: c ifAbsent: [nil]! ----- Method: Json class>>initialize (in category 'as yet unclassified') ----- initialize "Json initialize." CharacterEscapeMap := Dictionary newFrom: { $" -> $". $\ -> $\. Character backspace -> $b. Character lf -> $n. Character newPage -> $f. Character cr -> $r. Character tab -> $t. }.! ----- 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 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: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: self asString.! ----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. aStream nextPut: $].! ----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma _ false. aStream nextPut: ${. self keysAndValuesDo: [:k :v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma _ true ]. k asString jsonWriteOn: aStream. aStream nextPutAll: ': '. v 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. replacement ifNil: [ aStream nextPut: ch ] ifNotNil: [ aStream nextPut: $\; nextPut: replacement ]. ]. aStream nextPut: $". ! 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'!

1 0

The Trunk: JSON-djr.14.mcz
by commits＠source.squeak.org 08 Sep '22

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-djr.14.mcz ==================== Summary ==================== Name: JSON-djr.14 Author: djr Time: 7 October 2007, 12:22:39 am UUID: bc2c89b8-c2c5-4c97-b0e0-f42d95680878 Ancestors: JSON-aesp.13 Only reset the stream after setting it if it responds to #reset ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! Object subclass: #Json instanceVariableNames: 'stream ctorMap' classVariableNames: 'CharacterEscapeMap' poolDictionaries: '' category: 'JSON'! !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.! ----- Method: Json class>>escapeForCharacter: (in category 'as yet unclassified') ----- escapeForCharacter: c ^ CharacterEscapeMap at: c ifAbsent: [nil]! ----- Method: Json class>>initialize (in category 'as yet unclassified') ----- initialize "Json initialize." CharacterEscapeMap := Dictionary newFrom: { $" -> $". $\ -> $\. Character backspace -> $b. Character lf -> $n. Character newPage -> $f. Character cr -> $r. Character tab -> $t. }.! ----- 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: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: self asString.! ----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. aStream nextPut: $].! ----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma _ false. aStream nextPut: ${. self keysAndValuesDo: [:k :v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma _ true ]. k asString jsonWriteOn: aStream. aStream nextPutAll: ': '. v 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. replacement ifNil: [ aStream nextPut: ch ] ifNotNil: [ aStream nextPut: $\; nextPut: replacement ]. ]. aStream nextPut: $". ! 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'!

1 0

The Trunk: JSON-ul.15.mcz
by commits＠source.squeak.org 08 Sep '22

08 Sep '22

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

1 0

← Newer
1
...
8
9
10
11
12
13
14
15
16
Older →

Jump to page: