Squeak-dev September 2022

squeak-dev@lists.squeakfoundation.org

29 participants
158 discussions

The Trunk: JSON-avi.24.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-avi.24.mcz ==================== Summary ==================== Name: JSON-avi.24 Author: avi Time: 10 May 2008, 2:22:12 pm UUID: 9aab0844-667d-4c58-a7be-ba8994f25d0f Ancestors: JSON-avi.22 adding to the dip repo ==================== 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 := JsonObject 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 ! Object subclass: #JsonObject instanceVariableNames: 'properties' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonObject>>at:ifAbsent: (in category 'as yet unclassified') ----- at: key ifAbsent: aBlock ^ (properties detect: [:ea | ea key = key] ifNone: [^ aBlock value]) value! ----- Method: JsonObject>>at:put: (in category 'as yet unclassified') ----- at: key put: value properties add: key -> value! ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key | key := aMessage selector. key isUnary ifTrue: [^ self at: key ifAbsent: [super doesNotUnderstand: aMessage]]. ^ (key isKeyword and: [(key occurrencesOf: $:) = 1]) ifTrue: [key := key allButLast asSymbol. self at: key put: aMessage arguments first] ifFalse: [super doesNotUnderstand: aMessage] ! ----- Method: JsonObject>>initialize (in category 'as yet unclassified') ----- initialize properties := OrderedCollection new! ----- Method: JsonObject>>jsonWriteOn: (in category 'as yet unclassified') ----- jsonWriteOn: aStream aStream nextPut: ${. properties do: [:ea | ea key asString jsonWriteOn: aStream. aStream nextPutAll: ': '. ea value jsonWriteOn: aStream] separatedBy: [aStream nextPutAll: ', ']. aStream nextPut: $}.! ----- Method: JsonObject>>properties (in category 'as yet unclassified') ----- properties ^ properties! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: self asString.! ----- 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: WriteStream>>jsonPrint: (in category '*json-printing') ----- jsonPrint: anObject anObject jsonWriteOn: self! ----- Method: Text>>jsonWriteOn: (in category '*json-printing') ----- jsonWriteOn: aStream self string jsonWriteOn: aStream! ----- 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: $". ! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: Collection>>jsonWriteOn: (in category '*json') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. 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 ! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonSyntaxError! ----- 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.25.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.25.mcz ==================== Summary ==================== Name: JSON-tonyg.25 Author: tonyg Time: 21 August 2009, 11:00:03 pm UUID: 45705127-0bf3-4f62-8652-83d3ef15bf33 Ancestors: JSON-avi.24, JSON-ul.15 Merge avi.24 with ul.15, fix the tests, rudimentary (and possibly incorrect?) support for non-ASCII characters in strings, Improvements to JsonObject to get it past the tests, ==================== 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 ] ifFalse: [ ^ '\u', ((c asciiValue bitAnd: 16rFFFF) printStringBase: 16) ]! ----- 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 := JsonObject 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 ! Object subclass: #JsonObject instanceVariableNames: 'properties' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonObject class>>newFrom: (in category 'as yet unclassified') ----- newFrom: aDict | result p | result := self new. p := result properties. aDict associationsDo: [:a | p add: a]. ^ result! ----- Method: JsonObject>>= (in category 'as yet unclassified') ----- = anObject (anObject isKindOf: JsonObject) ifTrue: [^ properties = anObject properties] ifFalse: [^ properties = anObject]! ----- Method: JsonObject>>associationsDo: (in category 'as yet unclassified') ----- associationsDo: aBlock ^ properties associationsDo: aBlock! ----- Method: JsonObject>>at: (in category 'as yet unclassified') ----- at: key ^ self at: key ifAbsent: [self error: 'key not found'] ! ----- Method: JsonObject>>at:ifAbsent: (in category 'as yet unclassified') ----- at: key ifAbsent: aBlock ^ (properties detect: [:ea | ea key = key] ifNone: [^ aBlock value]) value! ----- Method: JsonObject>>at:put: (in category 'as yet unclassified') ----- at: key put: value properties associationsDo: [:a | a key = key ifTrue: [a value: value. ^ value]]. properties add: key -> value! ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key | key := aMessage selector. key isUnary ifTrue: [^ self at: key ifAbsent: [super doesNotUnderstand: aMessage]]. ^ (key isKeyword and: [(key occurrencesOf: $:) = 1]) ifTrue: [key := key allButLast asSymbol. self at: key put: aMessage arguments first] ifFalse: [super doesNotUnderstand: aMessage] ! ----- Method: JsonObject>>initialize (in category 'as yet unclassified') ----- initialize properties := OrderedCollection new! ----- Method: JsonObject>>jsonWriteOn: (in category 'as yet unclassified') ----- jsonWriteOn: aStream aStream nextPut: ${. properties do: [:ea | ea key asString jsonWriteOn: aStream. aStream nextPut: $:. ea value jsonWriteOn: aStream] separatedBy: [aStream nextPut: $,]. aStream nextPut: $}.! ----- Method: JsonObject>>properties (in category 'as yet unclassified') ----- properties ^ properties! ----- 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: 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: WriteStream>>jsonPrint: (in category '*json-printing') ----- jsonPrint: anObject anObject jsonWriteOn: self! ----- Method: Text>>jsonWriteOn: (in category '*json-printing') ----- jsonWriteOn: aStream self string jsonWriteOn: aStream! ----- 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)! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: Collection>>jsonWriteOn: (in category '*json') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPut: $, ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. 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: ''. self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String). self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).! ----- 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: (JsonObject new). self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: ({'a'->'b'. 'b'->'a'} as: JsonObject).! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self should: [self readFrom: '@Missing[]'] raise: JsonSyntaxError ! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonSyntaxError! ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') ----- testStringWithUnicode self json: '"\u263A"' equals: (Unicode value: 16r263A) asString. self render: (Unicode value: 16r263A) asString equals: '"\u263A"'.! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'. self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

The Trunk: JSON-dkb.27.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-dkb.27.mcz ==================== Summary ==================== Name: JSON-dkb.27 Author: dkb Time: 25 December 2009, 3:10:53.044 am UUID: 62aae4be-7719-004b-bc41-1f81e89bf6b0 Ancestors: JSON-matthias.berth.26 Replace a number of _ assignments with := ==================== 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 ] ifFalse: [ ^ '\u', ((c asciiValue bitAnd: 16rFFFF) printStringBase: 16) ]! ----- 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 := JsonObject 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 ! Object subclass: #JsonObject instanceVariableNames: 'properties' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonObject class>>newFrom: (in category 'as yet unclassified') ----- newFrom: aDict | result p | result := self new. p := result properties. aDict associationsDo: [:a | p add: a]. ^ result! ----- Method: JsonObject>>= (in category 'as yet unclassified') ----- = anObject (anObject isKindOf: JsonObject) ifTrue: [^ properties = anObject properties] ifFalse: [^ properties = anObject]! ----- Method: JsonObject>>associationsDo: (in category 'as yet unclassified') ----- associationsDo: aBlock ^ properties associationsDo: aBlock! ----- Method: JsonObject>>at: (in category 'as yet unclassified') ----- at: key ^ self at: key ifAbsent: [self error: 'key not found'] ! ----- Method: JsonObject>>at:ifAbsent: (in category 'as yet unclassified') ----- at: key ifAbsent: aBlock ^ (properties detect: [:ea | ea key = key] ifNone: [^ aBlock value]) value! ----- Method: JsonObject>>at:put: (in category 'as yet unclassified') ----- at: key put: value properties associationsDo: [:a | a key = key ifTrue: [a value: value. ^ value]]. properties add: key -> value! ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key | key := aMessage selector. key isUnary ifTrue: [^ self at: key ifAbsent: [super doesNotUnderstand: aMessage]]. ^ (key isKeyword and: [(key occurrencesOf: $:) = 1]) ifTrue: [key := key allButLast asSymbol. self at: key put: aMessage arguments first] ifFalse: [super doesNotUnderstand: aMessage] ! ----- Method: JsonObject>>initialize (in category 'as yet unclassified') ----- initialize properties := OrderedCollection new! ----- Method: JsonObject>>jsonWriteOn: (in category 'as yet unclassified') ----- jsonWriteOn: aStream aStream nextPut: ${. properties do: [:ea | ea key asString jsonWriteOn: aStream. aStream nextPut: $:. ea value jsonWriteOn: aStream] separatedBy: [aStream nextPut: $,]. aStream nextPut: $}.! ----- Method: JsonObject>>properties (in category 'as yet unclassified') ----- properties ^ properties! 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: ''. self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String). self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).! ----- 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: (JsonObject new). self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: ({'a'->'b'. 'b'->'a'} as: JsonObject).! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self should: [self readFrom: '@Missing[]'] raise: JsonSyntaxError ! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonSyntaxError! ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') ----- testStringWithUnicode self json: '"\u263A"' equals: (Unicode value: 16r263A) asString. self render: (Unicode value: 16r263A) asString equals: '"\u263A"'.! ----- 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'. ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'. self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.! ----- 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: 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: WriteStream>>jsonPrint: (in category '*json-printing') ----- jsonPrint: anObject anObject jsonWriteOn: self! ----- Method: Text>>jsonWriteOn: (in category '*json-printing') ----- jsonWriteOn: aStream self string jsonWriteOn: aStream! ----- 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)! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: Collection>>jsonWriteOn: (in category '*json') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPut: $, ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. 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.! ----- Method: Association>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream self key asString jsonWriteOn: aStream. aStream nextPut: $:; space. self value jsonWriteOn: aStream.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

The Trunk: JSON-jrd.28.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-jrd.28.mcz ==================== Summary ==================== Name: JSON-jrd.28 Author: jrd Time: 30 December 2009, 4:20:16 pm UUID: 1e9bfd19-508b-4a14-b2ae-c3e826281cc5 Ancestors: JSON-dkb.27 Changed: - Fixed missed _ to := conversion ==================== 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 ] ifFalse: [ ^ '\u', ((c asciiValue bitAnd: 16rFFFF) printStringBase: 16) ]! ----- 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 := JsonObject 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 ! Object subclass: #JsonObject instanceVariableNames: 'properties' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonObject class>>newFrom: (in category 'as yet unclassified') ----- newFrom: aDict | result p | result := self new. p := result properties. aDict associationsDo: [:a | p add: a]. ^ result! ----- Method: JsonObject>>= (in category 'as yet unclassified') ----- = anObject (anObject isKindOf: JsonObject) ifTrue: [^ properties = anObject properties] ifFalse: [^ properties = anObject]! ----- Method: JsonObject>>associationsDo: (in category 'as yet unclassified') ----- associationsDo: aBlock ^ properties associationsDo: aBlock! ----- Method: JsonObject>>at: (in category 'as yet unclassified') ----- at: key ^ self at: key ifAbsent: [self error: 'key not found'] ! ----- Method: JsonObject>>at:ifAbsent: (in category 'as yet unclassified') ----- at: key ifAbsent: aBlock ^ (properties detect: [:ea | ea key = key] ifNone: [^ aBlock value]) value! ----- Method: JsonObject>>at:put: (in category 'as yet unclassified') ----- at: key put: value properties associationsDo: [:a | a key = key ifTrue: [a value: value. ^ value]]. properties add: key -> value! ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key | key := aMessage selector. key isUnary ifTrue: [^ self at: key ifAbsent: [super doesNotUnderstand: aMessage]]. ^ (key isKeyword and: [(key occurrencesOf: $:) = 1]) ifTrue: [key := key allButLast asSymbol. self at: key put: aMessage arguments first] ifFalse: [super doesNotUnderstand: aMessage] ! ----- Method: JsonObject>>initialize (in category 'as yet unclassified') ----- initialize properties := OrderedCollection new! ----- Method: JsonObject>>jsonWriteOn: (in category 'as yet unclassified') ----- jsonWriteOn: aStream aStream nextPut: ${. properties do: [:ea | ea key asString jsonWriteOn: aStream. aStream nextPut: $:. ea value jsonWriteOn: aStream] separatedBy: [aStream nextPut: $,]. aStream nextPut: $}.! ----- Method: JsonObject>>properties (in category 'as yet unclassified') ----- properties ^ properties! 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: ''. self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String). self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).! ----- 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: (JsonObject new). self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: ({'a'->'b'. 'b'->'a'} as: JsonObject).! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self should: [self readFrom: '@Missing[]'] raise: JsonSyntaxError ! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonSyntaxError! ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') ----- testStringWithUnicode self json: '"\u263A"' equals: (Unicode value: 16r263A) asString. self render: (Unicode value: 16r263A) asString equals: '"\u263A"'.! ----- 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'. ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'. self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.! ----- 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: 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: WriteStream>>jsonPrint: (in category '*json-printing') ----- jsonPrint: anObject anObject jsonWriteOn: self! ----- Method: Text>>jsonWriteOn: (in category '*json-printing') ----- jsonWriteOn: aStream self string jsonWriteOn: aStream! ----- 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)! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: Collection>>jsonWriteOn: (in category '*json') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPut: $, ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. 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.! ----- Method: Association>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream self key asString jsonWriteOn: aStream. aStream nextPut: $:; space. self value jsonWriteOn: aStream.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

The Trunk: JSON-hjh.32.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-hjh.32.mcz ==================== Summary ==================== Name: JSON-hjh.32 Author: hjh Time: 12 May 2010, 10:31:47.957 pm UUID: 1d34420c-06d5-4101-9f70-09cd4b0c4925 Ancestors: JSON-rh.31 In the project SCouchDB a copy of JSON is maintained. This merges part of the changes back, in particular SCouchDB project JSON-Igor.Stasenko.28 JSON-Igor.Stasenko.29 JSON-rh.30 JSON-rh.31 JsonObject is now a subclass of Dictionary instead of Object. So there is no need to implement the Dictionary interface. Fix for converting Unicode characters to \uNNNN format (missing padding to 4 characters) More details see wiki ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! 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: ''. self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String). self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).! ----- 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: (JsonObject new). self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: (JsonObject new add: 'a'->'b'; add: 'b'->'a';yourself).! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self should: [self readFrom: '@Missing[]'] raise: JsonSyntaxError ! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonSyntaxError! ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') ----- testStringWithUnicode self json: '"\u263A"' equals: (Unicode value: 16r263A) asString. self render: (Unicode value: 16r263A) asString equals: '"\u263A"'.! ----- 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'. ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'. self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.! 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 ] "THIS IS WROOONG!!!!!! unicode is not 16bit wide!!" ifFalse: [ ^ '\u', (((c asciiValue bitAnd: 16rFFFF) printStringBase: 16) padded: #left to: 4 with: $0) ]! ----- 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 := JsonObject 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: Object>>asJsonString (in category '*JSON') ----- asJsonString ^ String streamContents: [:str | self jsonWriteOn: str ]! ----- 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: 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 jsonWriteOn: aStream. aStream nextPut: $:. assoc value jsonWriteOn: aStream ]. aStream nextPut: $}.! Dictionary subclass: #JsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonObject class>>fromAssociations: (in category 'as yet unclassified') ----- fromAssociations: collectionOfAssociations | result | result := self new. collectionOfAssociations do: [:each | result at: each key put: each value ]. ^ result! ----- Method: JsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key | key := aMessage selector. key isUnary ifTrue: [^ self at: key ifAbsent: [nil]]. ^ (key isKeyword and: [(key occurrencesOf: $:) = 1]) ifTrue: [key := key allButLast asSymbol. self at: key put: aMessage arguments first] ifFalse: [super doesNotUnderstand: aMessage] ! ----- Method: JsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: JsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: WriteStream>>jsonPrint: (in category '*json-printing') ----- jsonPrint: anObject anObject jsonWriteOn: self! ----- Method: Text>>jsonWriteOn: (in category '*json-printing') ----- jsonWriteOn: aStream self string jsonWriteOn: aStream! ----- 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 ^ self printOn: aWriteStream base: 10 ! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: Collection>>jsonWriteOn: (in category '*json') ----- jsonWriteOn: aStream "By default, use array braces " aStream nextPut: $[. self do: [:each | each jsonWriteOn: aStream ] separatedBy: [ aStream nextPut: $, ]. 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.! ----- Method: Association>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream self key asString jsonWriteOn: aStream. aStream nextPut: $:; space. self value jsonWriteOn: aStream.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

The Trunk: JSON-hjh.34.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-hjh.34.mcz ==================== Summary ==================== Name: JSON-hjh.34 Author: hjh Time: 13 May 2010, 1:48:26.373 am UUID: 4d75614b-aec0-4cca-8016-9a40eac2ac3e Ancestors: JSON-hjh.33 Speed enhancement by replacing self peek with stream peek Credit: Igor Stasenko ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! 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: ''. self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String). self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).! ----- 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: (JsonObject new). self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: (JsonObject new add: 'a'->'b'; add: 'b'->'a';yourself).! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self should: [self readFrom: '@Missing[]'] raise: JsonSyntaxError ! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonSyntaxError! ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') ----- testStringWithUnicode self json: '"\u263A"' equals: (Unicode value: 16r263A) asString. self render: (Unicode value: 16r263A) asString equals: '"\u263A"'.! ----- 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'. ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'. self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.! 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 ] "THIS IS WROOONG!!!!!! unicode is not 16bit wide!!" ifFalse: [ ^ '\u', (((c asciiValue bitAnd: 16rFFFF) printStringBase: 16) padded: #left to: 4 with: $0) ]! ----- 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 | stream 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 := stream 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>>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 := stream peek asLowercase. c == ${ ifTrue: [stream next. ^ self readDictionary]. c == $[ ifTrue: [stream next. ^ self readArray]. c == $" ifTrue: [stream next. ^ self readString]. c == $t ifTrue: [^ self consume: 'true' returning: true]. c == $f ifTrue: [^ self consume: 'false' returning: false]. c == $n ifTrue: [^ self consume: 'null' returning: nil]. c == $@ ifTrue: [stream next. ^ self readConstructor]. (Json numbersMayContain: c) ifTrue: [^ self readNumber]. JsonSyntaxError signal: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | a | a := OrderedCollection new. self skipWhitespace. (stream peekFor: $]) ifTrue: [ ^ #() ]. [ a add: self readAny. self skipWhitespace. (stream peekFor: $]) ifTrue: [ ^ a asArray]. (stream peekFor: $, ) ifFalse: [JsonSyntaxError signal: 'Missing comma']. ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor | s c v ctor | s := WriteStream on: ''. [ c := stream peek. c ifNil: [JsonSyntaxError signal: 'Premature EOF reading constructor name']. ((c == $.) or: [c isLetter]) ifTrue: [s nextPut: c. stream next] ifFalse: [ v := self readAny. s := s contents. ctor := ctorMap ifNotNil: [ctor := ctorMap at: s ifAbsent: [nil]]. ctor ifNil: [JsonSyntaxError signal: 'Unknown ctor ', s]. ^ ctor constructFromJson: v] ] repeat. ! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | m k v needComma | m := JsonObject new. needComma := false. [ self skipWhitespace. (stream peekFor: $}) ifTrue: [ ^ m]. needComma ifTrue: [ (stream peekFor: $,) ifFalse: [JsonSyntaxError signal: 'Missing comma']. self skipWhitespace] ifFalse: [needComma := true]. " k := self readAny. " (stream peekFor: $") ifFalse: [JsonSyntaxError signal: 'Key in dictionary must be string']. k := self readString. self skipWhitespace. (stream peekFor: $:) ifFalse: [JsonSyntaxError signal: 'Missing colon']. 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 := stream peek. (c isNil not and: [Json numbersMayContain: c]) ifFalse: [ [^ acc contents asNumber] on: Error do: [JsonSyntaxError signal: 'Invalid number']]. acc nextPut: c. stream next. ] repeat.! ----- Method: Json>>readString (in category 'private') ----- readString | s c | s := WriteStream on: ''. [ c := stream next. c == $\ ifTrue: [s nextPut: self interpretStringEscape.] ifFalse: [c == $" ifTrue: [^ s contents.]. s nextPut: c] ] repeat.! ----- Method: Json>>skipComment (in category 'private') ----- skipComment stream peek == $/ ifTrue: [ stream next. stream peek == $/ ifTrue: [self skipToEndOfLine] ifFalse: [stream peek == $* ifTrue: [stream next. self skipCommentBody] ifFalse: [JsonSyntaxError signal: 'Invalid comment syntax']]] ! ----- Method: Json>>skipCommentBody (in category 'private') ----- skipCommentBody [ [stream next == $*] whileFalse. stream peek == $/ ] whileFalse. stream next. "skip that last slash" self skipWhitespace.! ----- Method: Json>>skipToEndOfLine (in category 'private') ----- skipToEndOfLine | cr lf | cr := Character cr. lf := Character lf. [ | c | (c := stream peek) == cr or: [ c == lf]] whileFalse: [stream next]. self skipWhitespace! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace [stream peek isSeparator] whileTrue: [stream 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: stream next with: stream next with: stream next with: stream next) asUppercase. ^ Unicode value: (Integer readFrom: string readStream base: 16)! 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: Object>>asJsonString (in category '*JSON') ----- asJsonString ^ String streamContents: [:str | self jsonWriteOn: str ]! ----- 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: 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 jsonWriteOn: aStream. aStream nextPut: $:. assoc value jsonWriteOn: aStream ]. aStream nextPut: $}.! Dictionary subclass: #JsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonObject class>>fromAssociations: (in category 'as yet unclassified') ----- fromAssociations: collectionOfAssociations | result | result := self new. collectionOfAssociations do: [:each | result at: each key put: each value ]. ^ result! ----- Method: JsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key | key := aMessage selector. key isUnary ifTrue: [^ self at: key ifAbsent: [nil]]. ^ (key isKeyword and: [(key occurrencesOf: $:) = 1]) ifTrue: [key := key allButLast asSymbol. self at: key put: aMessage arguments first] ifFalse: [super doesNotUnderstand: aMessage] ! ----- Method: JsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: JsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: WriteStream>>jsonPrint: (in category '*json-printing') ----- jsonPrint: anObject anObject jsonWriteOn: self! ----- Method: Text>>jsonWriteOn: (in category '*json-printing') ----- jsonWriteOn: aStream self string jsonWriteOn: aStream! ----- 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 ^ self printOn: aWriteStream base: 10 ! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: Collection>>jsonWriteOn: (in category '*json') ----- jsonWriteOn: aStream "By default, use array braces " aStream nextPut: $[. self do: [:each | each jsonWriteOn: aStream ] separatedBy: [ aStream nextPut: $, ]. 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.! ----- Method: Association>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream self key asString jsonWriteOn: aStream. aStream nextPut: $:; space. self value jsonWriteOn: aStream.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

The Trunk: JSON-ul.35.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.35.mcz ==================== Summary ==================== Name: JSON-ul.35 Author: ul Time: 9 November 2010, 4:30:48.748 am UUID: 79d55347-8eb5-bc40-b68c-0df315a87e85 Ancestors: JSON-hjh.34 - fix: string encoding conforms to the spec. This was fixed once already, so please don't break it again. Thanks. ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! 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: ''. self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String). self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).! ----- 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: (JsonObject new). self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: (JsonObject new add: 'a'->'b'; add: 'b'->'a';yourself).! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self should: [self readFrom: '@Missing[]'] raise: JsonSyntaxError ! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonSyntaxError! ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- 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'. ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'. self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.! 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 | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^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 | stream 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 := stream 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>>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 := stream peek asLowercase. c == ${ ifTrue: [stream next. ^ self readDictionary]. c == $[ ifTrue: [stream next. ^ self readArray]. c == $" ifTrue: [stream next. ^ self readString]. c == $t ifTrue: [^ self consume: 'true' returning: true]. c == $f ifTrue: [^ self consume: 'false' returning: false]. c == $n ifTrue: [^ self consume: 'null' returning: nil]. c == $@ ifTrue: [stream next. ^ self readConstructor]. (Json numbersMayContain: c) ifTrue: [^ self readNumber]. JsonSyntaxError signal: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | a | a := OrderedCollection new. self skipWhitespace. (stream peekFor: $]) ifTrue: [ ^ #() ]. [ a add: self readAny. self skipWhitespace. (stream peekFor: $]) ifTrue: [ ^ a asArray]. (stream peekFor: $, ) ifFalse: [JsonSyntaxError signal: 'Missing comma']. ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor | s c v ctor | s := WriteStream on: ''. [ c := stream peek. c ifNil: [JsonSyntaxError signal: 'Premature EOF reading constructor name']. ((c == $.) or: [c isLetter]) ifTrue: [s nextPut: c. stream next] ifFalse: [ v := self readAny. s := s contents. ctor := ctorMap ifNotNil: [ctor := ctorMap at: s ifAbsent: [nil]]. ctor ifNil: [JsonSyntaxError signal: 'Unknown ctor ', s]. ^ ctor constructFromJson: v] ] repeat. ! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | m k v needComma | m := JsonObject new. needComma := false. [ self skipWhitespace. (stream peekFor: $}) ifTrue: [ ^ m]. needComma ifTrue: [ (stream peekFor: $,) ifFalse: [JsonSyntaxError signal: 'Missing comma']. self skipWhitespace] ifFalse: [needComma := true]. " k := self readAny. " (stream peekFor: $") ifFalse: [JsonSyntaxError signal: 'Key in dictionary must be string']. k := self readString. self skipWhitespace. (stream peekFor: $:) ifFalse: [JsonSyntaxError signal: 'Missing colon']. 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 := stream peek. (c isNil not and: [Json numbersMayContain: c]) ifFalse: [ [^ acc contents asNumber] on: Error do: [JsonSyntaxError signal: 'Invalid number']]. acc nextPut: c. stream next. ] repeat.! ----- Method: Json>>readString (in category 'private') ----- readString | s c | s := WriteStream on: ''. [ c := stream next. c == $\ ifTrue: [s nextPut: self interpretStringEscape.] ifFalse: [c == $" ifTrue: [^ s contents.]. s nextPut: c] ] repeat.! ----- Method: Json>>skipComment (in category 'private') ----- skipComment stream peek == $/ ifTrue: [ stream next. stream peek == $/ ifTrue: [self skipToEndOfLine] ifFalse: [stream peek == $* ifTrue: [stream next. self skipCommentBody] ifFalse: [JsonSyntaxError signal: 'Invalid comment syntax']]] ! ----- Method: Json>>skipCommentBody (in category 'private') ----- skipCommentBody [ [stream next == $*] whileFalse. stream peek == $/ ] whileFalse. stream next. "skip that last slash" self skipWhitespace.! ----- Method: Json>>skipToEndOfLine (in category 'private') ----- skipToEndOfLine | cr lf | cr := Character cr. lf := Character lf. [ | c | (c := stream peek) == cr or: [ c == lf]] whileFalse: [stream next]. self skipWhitespace! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace [stream peek isSeparator] whileTrue: [stream 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: stream next with: stream next with: stream next with: stream next) asUppercase. ^ Unicode value: (Integer readFrom: string readStream base: 16)! 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: Object>>asJsonString (in category '*JSON') ----- asJsonString ^ String streamContents: [:str | self jsonWriteOn: str ]! ----- 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: 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 jsonWriteOn: aStream. aStream nextPut: $:. assoc value jsonWriteOn: aStream ]. aStream nextPut: $}.! Dictionary subclass: #JsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonObject class>>fromAssociations: (in category 'as yet unclassified') ----- fromAssociations: collectionOfAssociations | result | result := self new. collectionOfAssociations do: [:each | result at: each key put: each value ]. ^ result! ----- Method: JsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key | key := aMessage selector. key isUnary ifTrue: [^ self at: key ifAbsent: [nil]]. ^ (key isKeyword and: [(key occurrencesOf: $:) = 1]) ifTrue: [key := key allButLast asSymbol. self at: key put: aMessage arguments first] ifFalse: [super doesNotUnderstand: aMessage] ! ----- Method: JsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: JsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: WriteStream>>jsonPrint: (in category '*json-printing') ----- jsonPrint: anObject anObject jsonWriteOn: self! ----- Method: Text>>jsonWriteOn: (in category '*json-printing') ----- jsonWriteOn: aStream self string jsonWriteOn: aStream! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPut: $". self do: [ :ch | (Json escapeForCharacter: ch) ifNil: [ aStream nextPut: ch ] ifNotNil: [ :replacement | aStream nextPutAll: replacement ] ]. aStream nextPut: $". ! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: Collection>>jsonWriteOn: (in category '*json') ----- jsonWriteOn: aStream "By default, use array braces " aStream nextPut: $[. self do: [:each | each jsonWriteOn: aStream ] separatedBy: [ aStream nextPut: $, ]. 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.! ----- Method: Association>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream self key asString jsonWriteOn: aStream. aStream nextPut: $:; space. self value jsonWriteOn: aStream.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

The Trunk: JSON-tonyg.36.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.36.mcz ==================== Summary ==================== Name: JSON-tonyg.36 Author: tonyg Time: 29 April 2016, 11:40:18.188 am UUID: 7cc3900d-ed09-47bc-9524-ebd92be779ba Ancestors: JSON-ul.35 Distinguish JsonIncompleteError from JsonInvalidError (both subtypes of JsonSyntaxError), and ensure support for streaming reading of multiple JSON values from a single input stream. ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! 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>>assertIncompleteJson: (in category 'as yet unclassified') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'as yet unclassified') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- 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: ''. self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String). self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).! ----- 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: (JsonObject new). self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: (JsonObject new add: 'a'->'b'; add: 'b'->'a';yourself).! ----- Method: JsonTests>>testIncomplete (in category 'as yet unclassified') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'as yet unclassified') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'as yet unclassified') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testStreaming (in category 'as yet unclassified') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: Dictionary new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- 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'. ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'. self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.! 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 | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^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 |v| aString do: [:c | v := stream next. v ifNil: [JsonIncompleteError signal: 'Incomplete ''', aString, ''' seen']. v == c ifFalse: [JsonInvalidError 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 := stream next. c ifNil: [JsonIncompleteError signal: 'Expected character following ''\'' in string escape']. c == $b ifTrue: [^ Character backspace]. c == $n ifTrue: [^ Character lf]. c == $f ifTrue: [^ Character newPage]. c == $r ifTrue: [^ Character cr]. c == $t ifTrue: [^ Character tab]. c == $u ifTrue: [^ self unescapeUnicode]. ^ c.! ----- Method: Json>>nextHexDigit (in category 'private') ----- nextHexDigit | c | c := stream next. c ifNil: [JsonIncompleteError signal: 'Expecting hex digit']. c := c asUppercase. (c isDigit or: [c >= $A and: [c <= $F]]) ifTrue: [^ c]. JsonInvalidError signal: 'Expected hex digit'.! ----- 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 := stream peek asLowercase. c == ${ ifTrue: [stream next. ^ self readDictionary]. c == $[ ifTrue: [stream next. ^ self readArray]. c == $" ifTrue: [stream next. ^ self readString]. c == $t ifTrue: [^ self consume: 'true' returning: true]. c == $f ifTrue: [^ self consume: 'false' returning: false]. c == $n ifTrue: [^ self consume: 'null' returning: nil]. c == $@ ifTrue: [stream next. ^ self readConstructor]. (Json numbersMayContain: c) ifTrue: [^ self readNumber]. JsonInvalidError signal: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | a | self skipWhitespace. (stream peekFor: $]) ifTrue: [ ^ #() ]. a := OrderedCollection new. [ a add: self readAny. self skipWhitespace. (stream peekFor: $]) ifTrue: [ ^ a asArray]. (stream peekFor: $, ) ifFalse: [JsonInvalidError signal: 'Missing comma']. ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor | s c v ctor | s := WriteStream on: ''. [ c := stream peek. c ifNil: [JsonIncompleteError signal: 'Premature EOF reading constructor name']. ((c == $.) or: [c isLetter]) ifTrue: [s nextPut: c. stream next] ifFalse: [ v := self readAny. s := s contents. ctor := ctorMap ifNotNil: [ctor := ctorMap at: s ifAbsent: [nil]]. ctor ifNil: [JsonInvalidError signal: 'Unknown ctor ', s]. ^ ctor constructFromJson: v] ] repeat. ! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | m k v needComma | m := JsonObject new. needComma := false. [ self skipWhitespace. (stream peekFor: $}) ifTrue: [ ^ m]. needComma ifTrue: [ (stream peekFor: $,) ifFalse: [JsonInvalidError signal: 'Missing comma']. self skipWhitespace] ifFalse: [needComma := true]. " k := self readAny. " (stream peekFor: $") ifFalse: [JsonInvalidError signal: 'Key in dictionary must be string']. k := self readString. self skipWhitespace. (stream peekFor: $:) ifFalse: [JsonInvalidError signal: 'Missing colon']. 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 := stream peek. (c isNil not and: [Json numbersMayContain: c]) ifFalse: [ [^ acc contents asNumber] on: Error do: [JsonInvalidError signal: 'Invalid number']]. acc nextPut: c. stream next. ] repeat.! ----- Method: Json>>readString (in category 'private') ----- readString | s c | s := WriteStream on: ''. [ c := stream next. c ifNil: [JsonIncompleteError signal: 'Incomplete read of JSON string']. c == $\ ifTrue: [s nextPut: self interpretStringEscape.] ifFalse: [c == $" ifTrue: [^ s contents.]. s nextPut: c] ] repeat.! ----- Method: Json>>skipComment (in category 'private') ----- skipComment stream peek == $/ ifTrue: [ stream next. stream peek == $/ ifTrue: [self skipToEndOfLine] ifFalse: [stream peek == $* ifTrue: [stream next. self skipCommentBody] ifFalse: [JsonInvalidError signal: 'Invalid comment syntax']]] ! ----- Method: Json>>skipCommentBody (in category 'private') ----- skipCommentBody [ [stream next == $*] whileFalse. stream peek == $/ ] whileFalse. stream next. "skip that last slash" self skipWhitespace.! ----- Method: Json>>skipToEndOfLine (in category 'private') ----- skipToEndOfLine | cr lf | cr := Character cr. lf := Character lf. [ | c | (c := stream peek) == cr or: [ c == lf]] whileFalse: [stream next]. self skipWhitespace! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace |c| [ c := stream peek. c ifNil: [JsonIncompleteError signal: 'Expected JSON input']. c isSeparator ] whileTrue: [stream 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 a b c d| a := self nextHexDigit. b := self nextHexDigit. c := self nextHexDigit. d := self nextHexDigit. string := String with: a with: b with: c with: d. ^ Unicode value: (Integer readFrom: string readStream base: 16)! 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: Object>>asJsonString (in category '*JSON') ----- asJsonString ^ String streamContents: [:str | self jsonWriteOn: str ]! ----- 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: 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 jsonWriteOn: aStream. aStream nextPut: $:. assoc value jsonWriteOn: aStream ]. aStream nextPut: $}.! Dictionary subclass: #JsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonObject class>>fromAssociations: (in category 'as yet unclassified') ----- fromAssociations: collectionOfAssociations | result | result := self new. collectionOfAssociations do: [:each | result at: each key put: each value ]. ^ result! ----- Method: JsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key | key := aMessage selector. key isUnary ifTrue: [^ self at: key ifAbsent: [nil]]. ^ (key isKeyword and: [(key occurrencesOf: $:) = 1]) ifTrue: [key := key allButLast asSymbol. self at: key put: aMessage arguments first] ifFalse: [super doesNotUnderstand: aMessage] ! ----- Method: JsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: JsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: WriteStream>>jsonPrint: (in category '*json-printing') ----- jsonPrint: anObject anObject jsonWriteOn: self! ----- Method: Text>>jsonWriteOn: (in category '*json-printing') ----- jsonWriteOn: aStream self string jsonWriteOn: aStream! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPut: $". self do: [ :ch | (Json escapeForCharacter: ch) ifNil: [ aStream nextPut: ch ] ifNotNil: [ :replacement | aStream nextPutAll: replacement ] ]. aStream nextPut: $". ! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: Collection>>jsonWriteOn: (in category '*json') ----- jsonWriteOn: aStream "By default, use array braces " aStream nextPut: $[. self do: [:each | each jsonWriteOn: aStream ] separatedBy: [ aStream nextPut: $, ]. aStream nextPut: $]! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: Association>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream self key asString jsonWriteOn: aStream. aStream nextPut: $:; space. self value jsonWriteOn: aStream.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

The Trunk: JSON-tonyg.37.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.37.mcz ==================== Summary ==================== Name: JSON-tonyg.37 Author: tonyg Time: 29 April 2016, 11:47:17.129 am UUID: 63e50a8f-d436-4128-952c-3c0c8c12e120 Ancestors: JSON-tonyg.36, JSON-jrd.28 Merge jrd.28. The change it made has already been incorporated in different form to the mainline of the package, so this commit doesn't actually change any code wrt tonyg.36. ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! 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>>assertIncompleteJson: (in category 'as yet unclassified') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'as yet unclassified') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- 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: ''. self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String). self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).! ----- 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: (JsonObject new). self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: (JsonObject new add: 'a'->'b'; add: 'b'->'a';yourself).! ----- Method: JsonTests>>testIncomplete (in category 'as yet unclassified') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'as yet unclassified') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'as yet unclassified') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testStreaming (in category 'as yet unclassified') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: Dictionary new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- 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'. ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'. self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.! 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 | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^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 |v| aString do: [:c | v := stream next. v ifNil: [JsonIncompleteError signal: 'Incomplete ''', aString, ''' seen']. v == c ifFalse: [JsonInvalidError 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 := stream next. c ifNil: [JsonIncompleteError signal: 'Expected character following ''\'' in string escape']. c == $b ifTrue: [^ Character backspace]. c == $n ifTrue: [^ Character lf]. c == $f ifTrue: [^ Character newPage]. c == $r ifTrue: [^ Character cr]. c == $t ifTrue: [^ Character tab]. c == $u ifTrue: [^ self unescapeUnicode]. ^ c.! ----- Method: Json>>nextHexDigit (in category 'private') ----- nextHexDigit | c | c := stream next. c ifNil: [JsonIncompleteError signal: 'Expecting hex digit']. c := c asUppercase. (c isDigit or: [c >= $A and: [c <= $F]]) ifTrue: [^ c]. JsonInvalidError signal: 'Expected hex digit'.! ----- 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 := stream peek asLowercase. c == ${ ifTrue: [stream next. ^ self readDictionary]. c == $[ ifTrue: [stream next. ^ self readArray]. c == $" ifTrue: [stream next. ^ self readString]. c == $t ifTrue: [^ self consume: 'true' returning: true]. c == $f ifTrue: [^ self consume: 'false' returning: false]. c == $n ifTrue: [^ self consume: 'null' returning: nil]. c == $@ ifTrue: [stream next. ^ self readConstructor]. (Json numbersMayContain: c) ifTrue: [^ self readNumber]. JsonInvalidError signal: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | a | self skipWhitespace. (stream peekFor: $]) ifTrue: [ ^ #() ]. a := OrderedCollection new. [ a add: self readAny. self skipWhitespace. (stream peekFor: $]) ifTrue: [ ^ a asArray]. (stream peekFor: $, ) ifFalse: [JsonInvalidError signal: 'Missing comma']. ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor | s c v ctor | s := WriteStream on: ''. [ c := stream peek. c ifNil: [JsonIncompleteError signal: 'Premature EOF reading constructor name']. ((c == $.) or: [c isLetter]) ifTrue: [s nextPut: c. stream next] ifFalse: [ v := self readAny. s := s contents. ctor := ctorMap ifNotNil: [ctor := ctorMap at: s ifAbsent: [nil]]. ctor ifNil: [JsonInvalidError signal: 'Unknown ctor ', s]. ^ ctor constructFromJson: v] ] repeat. ! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | m k v needComma | m := JsonObject new. needComma := false. [ self skipWhitespace. (stream peekFor: $}) ifTrue: [ ^ m]. needComma ifTrue: [ (stream peekFor: $,) ifFalse: [JsonInvalidError signal: 'Missing comma']. self skipWhitespace] ifFalse: [needComma := true]. " k := self readAny. " (stream peekFor: $") ifFalse: [JsonInvalidError signal: 'Key in dictionary must be string']. k := self readString. self skipWhitespace. (stream peekFor: $:) ifFalse: [JsonInvalidError signal: 'Missing colon']. 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 := stream peek. (c isNil not and: [Json numbersMayContain: c]) ifFalse: [ [^ acc contents asNumber] on: Error do: [JsonInvalidError signal: 'Invalid number']]. acc nextPut: c. stream next. ] repeat.! ----- Method: Json>>readString (in category 'private') ----- readString | s c | s := WriteStream on: ''. [ c := stream next. c ifNil: [JsonIncompleteError signal: 'Incomplete read of JSON string']. c == $\ ifTrue: [s nextPut: self interpretStringEscape.] ifFalse: [c == $" ifTrue: [^ s contents.]. s nextPut: c] ] repeat.! ----- Method: Json>>skipComment (in category 'private') ----- skipComment stream peek == $/ ifTrue: [ stream next. stream peek == $/ ifTrue: [self skipToEndOfLine] ifFalse: [stream peek == $* ifTrue: [stream next. self skipCommentBody] ifFalse: [JsonInvalidError signal: 'Invalid comment syntax']]] ! ----- Method: Json>>skipCommentBody (in category 'private') ----- skipCommentBody [ [stream next == $*] whileFalse. stream peek == $/ ] whileFalse. stream next. "skip that last slash" self skipWhitespace.! ----- Method: Json>>skipToEndOfLine (in category 'private') ----- skipToEndOfLine | cr lf | cr := Character cr. lf := Character lf. [ | c | (c := stream peek) == cr or: [ c == lf]] whileFalse: [stream next]. self skipWhitespace! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace |c| [ c := stream peek. c ifNil: [JsonIncompleteError signal: 'Expected JSON input']. c isSeparator ] whileTrue: [stream 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 a b c d| a := self nextHexDigit. b := self nextHexDigit. c := self nextHexDigit. d := self nextHexDigit. string := String with: a with: b with: c with: d. ^ Unicode value: (Integer readFrom: string readStream base: 16)! 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: Object>>asJsonString (in category '*JSON') ----- asJsonString ^ String streamContents: [:str | self jsonWriteOn: str ]! ----- 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: 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 jsonWriteOn: aStream. aStream nextPut: $:. assoc value jsonWriteOn: aStream ]. aStream nextPut: $}.! Dictionary subclass: #JsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonObject class>>fromAssociations: (in category 'as yet unclassified') ----- fromAssociations: collectionOfAssociations | result | result := self new. collectionOfAssociations do: [:each | result at: each key put: each value ]. ^ result! ----- Method: JsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key | key := aMessage selector. key isUnary ifTrue: [^ self at: key ifAbsent: [nil]]. ^ (key isKeyword and: [(key occurrencesOf: $:) = 1]) ifTrue: [key := key allButLast asSymbol. self at: key put: aMessage arguments first] ifFalse: [super doesNotUnderstand: aMessage] ! ----- Method: JsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: JsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: WriteStream>>jsonPrint: (in category '*json-printing') ----- jsonPrint: anObject anObject jsonWriteOn: self! ----- Method: Text>>jsonWriteOn: (in category '*json-printing') ----- jsonWriteOn: aStream self string jsonWriteOn: aStream! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPut: $". self do: [ :ch | (Json escapeForCharacter: ch) ifNil: [ aStream nextPut: ch ] ifNotNil: [ :replacement | aStream nextPutAll: replacement ] ]. aStream nextPut: $". ! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: Collection>>jsonWriteOn: (in category '*json') ----- jsonWriteOn: aStream "By default, use array braces " aStream nextPut: $[. self do: [:each | each jsonWriteOn: aStream ] separatedBy: [ aStream nextPut: $, ]. aStream nextPut: $]! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: Association>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream self key asString jsonWriteOn: aStream. aStream nextPut: $:; space. self value jsonWriteOn: aStream.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

The Trunk: JSON-FabN.38.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-FabN.38.mcz ==================== Summary ==================== Name: JSON-FabN.38 Author: FabN Time: 17 August 2016, 7:32:28.37 pm UUID: 9b27fd7e-4754-436d-b6f5-2348b49f5b63 Ancestors: JSON-tonyg.37 Make JsonTests>>testStreaming compatible with Squeak-5.1. Related thread: http://forum.world.st/Testing-JSON-in-Squeak-5-1beta-1-failure-td4911583.ht… ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! 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>>assertIncompleteJson: (in category 'as yet unclassified') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'as yet unclassified') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- 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: ''. self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String). self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).! ----- 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: (JsonObject new). self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: (JsonObject new add: 'a'->'b'; add: 'b'->'a';yourself).! ----- Method: JsonTests>>testIncomplete (in category 'as yet unclassified') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'as yet unclassified') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'as yet unclassified') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testStreaming (in category 'as yet unclassified') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny isDictionary. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- 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'. ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'. self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.! 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 | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^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 |v| aString do: [:c | v := stream next. v ifNil: [JsonIncompleteError signal: 'Incomplete ''', aString, ''' seen']. v == c ifFalse: [JsonInvalidError 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 := stream next. c ifNil: [JsonIncompleteError signal: 'Expected character following ''\'' in string escape']. c == $b ifTrue: [^ Character backspace]. c == $n ifTrue: [^ Character lf]. c == $f ifTrue: [^ Character newPage]. c == $r ifTrue: [^ Character cr]. c == $t ifTrue: [^ Character tab]. c == $u ifTrue: [^ self unescapeUnicode]. ^ c.! ----- Method: Json>>nextHexDigit (in category 'private') ----- nextHexDigit | c | c := stream next. c ifNil: [JsonIncompleteError signal: 'Expecting hex digit']. c := c asUppercase. (c isDigit or: [c >= $A and: [c <= $F]]) ifTrue: [^ c]. JsonInvalidError signal: 'Expected hex digit'.! ----- 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 := stream peek asLowercase. c == ${ ifTrue: [stream next. ^ self readDictionary]. c == $[ ifTrue: [stream next. ^ self readArray]. c == $" ifTrue: [stream next. ^ self readString]. c == $t ifTrue: [^ self consume: 'true' returning: true]. c == $f ifTrue: [^ self consume: 'false' returning: false]. c == $n ifTrue: [^ self consume: 'null' returning: nil]. c == $@ ifTrue: [stream next. ^ self readConstructor]. (Json numbersMayContain: c) ifTrue: [^ self readNumber]. JsonInvalidError signal: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | a | self skipWhitespace. (stream peekFor: $]) ifTrue: [ ^ #() ]. a := OrderedCollection new. [ a add: self readAny. self skipWhitespace. (stream peekFor: $]) ifTrue: [ ^ a asArray]. (stream peekFor: $, ) ifFalse: [JsonInvalidError signal: 'Missing comma']. ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor | s c v ctor | s := WriteStream on: ''. [ c := stream peek. c ifNil: [JsonIncompleteError signal: 'Premature EOF reading constructor name']. ((c == $.) or: [c isLetter]) ifTrue: [s nextPut: c. stream next] ifFalse: [ v := self readAny. s := s contents. ctor := ctorMap ifNotNil: [ctor := ctorMap at: s ifAbsent: [nil]]. ctor ifNil: [JsonInvalidError signal: 'Unknown ctor ', s]. ^ ctor constructFromJson: v] ] repeat. ! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | m k v needComma | m := JsonObject new. needComma := false. [ self skipWhitespace. (stream peekFor: $}) ifTrue: [ ^ m]. needComma ifTrue: [ (stream peekFor: $,) ifFalse: [JsonInvalidError signal: 'Missing comma']. self skipWhitespace] ifFalse: [needComma := true]. " k := self readAny. " (stream peekFor: $") ifFalse: [JsonInvalidError signal: 'Key in dictionary must be string']. k := self readString. self skipWhitespace. (stream peekFor: $:) ifFalse: [JsonInvalidError signal: 'Missing colon']. 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 := stream peek. (c isNil not and: [Json numbersMayContain: c]) ifFalse: [ [^ acc contents asNumber] on: Error do: [JsonInvalidError signal: 'Invalid number']]. acc nextPut: c. stream next. ] repeat.! ----- Method: Json>>readString (in category 'private') ----- readString | s c | s := WriteStream on: ''. [ c := stream next. c ifNil: [JsonIncompleteError signal: 'Incomplete read of JSON string']. c == $\ ifTrue: [s nextPut: self interpretStringEscape.] ifFalse: [c == $" ifTrue: [^ s contents.]. s nextPut: c] ] repeat.! ----- Method: Json>>skipComment (in category 'private') ----- skipComment stream peek == $/ ifTrue: [ stream next. stream peek == $/ ifTrue: [self skipToEndOfLine] ifFalse: [stream peek == $* ifTrue: [stream next. self skipCommentBody] ifFalse: [JsonInvalidError signal: 'Invalid comment syntax']]] ! ----- Method: Json>>skipCommentBody (in category 'private') ----- skipCommentBody [ [stream next == $*] whileFalse. stream peek == $/ ] whileFalse. stream next. "skip that last slash" self skipWhitespace.! ----- Method: Json>>skipToEndOfLine (in category 'private') ----- skipToEndOfLine | cr lf | cr := Character cr. lf := Character lf. [ | c | (c := stream peek) == cr or: [ c == lf]] whileFalse: [stream next]. self skipWhitespace! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace |c| [ c := stream peek. c ifNil: [JsonIncompleteError signal: 'Expected JSON input']. c isSeparator ] whileTrue: [stream 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 a b c d| a := self nextHexDigit. b := self nextHexDigit. c := self nextHexDigit. d := self nextHexDigit. string := String with: a with: b with: c with: d. ^ Unicode value: (Integer readFrom: string readStream base: 16)! 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: Object>>asJsonString (in category '*JSON') ----- asJsonString ^ String streamContents: [:str | self jsonWriteOn: str ]! ----- 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: 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 jsonWriteOn: aStream. aStream nextPut: $:. assoc value jsonWriteOn: aStream ]. aStream nextPut: $}.! Dictionary subclass: #JsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonObject class>>fromAssociations: (in category 'as yet unclassified') ----- fromAssociations: collectionOfAssociations | result | result := self new. collectionOfAssociations do: [:each | result at: each key put: each value ]. ^ result! ----- Method: JsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: JsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key | key := aMessage selector. key isUnary ifTrue: [^ self at: key ifAbsent: [nil]]. ^ (key isKeyword and: [(key occurrencesOf: $:) = 1]) ifTrue: [key := key allButLast asSymbol. self at: key put: aMessage arguments first] ifFalse: [super doesNotUnderstand: aMessage] ! ----- Method: JsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: JsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: WriteStream>>jsonPrint: (in category '*json-printing') ----- jsonPrint: anObject anObject jsonWriteOn: self! ----- Method: Text>>jsonWriteOn: (in category '*json-printing') ----- jsonWriteOn: aStream self string jsonWriteOn: aStream! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPut: $". self do: [ :ch | (Json escapeForCharacter: ch) ifNil: [ aStream nextPut: ch ] ifNotNil: [ :replacement | aStream nextPutAll: replacement ] ]. aStream nextPut: $". ! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: Collection>>jsonWriteOn: (in category '*json') ----- jsonWriteOn: aStream "By default, use array braces " aStream nextPut: $[. self do: [:each | each jsonWriteOn: aStream ] separatedBy: [ aStream nextPut: $, ]. aStream nextPut: $]! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: Association>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream self key asString jsonWriteOn: aStream. aStream nextPut: $:; space. self value jsonWriteOn: aStream.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

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

Jump to page: