Packages September 2022

packages@lists.squeakfoundation.org

1 participants
90 discussions

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

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-aesp.13.mcz ==================== Summary ==================== Name: JSON-aesp.13 Author: aesp Time: 5 July 2007, 1:22:52 pm UUID: 4ea4481a-2ad9-11dc-8583-00145127fcd4 Ancestors: JSON-sp.12 fixed bug with passed stream position over end, added simple unicode \uXXXX unescaping while reading json ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! Object subclass: #Json instanceVariableNames: 'stream ctorMap' classVariableNames: 'CharacterEscapeMap' poolDictionaries: '' category: 'JSON'! !Json commentStamp: '<historical>' prior: 0! This class reads and writes JSON format data - strings, numbers, boolean, nil, arrays and dictionaries. See http://www.crockford.com/JSON/index.html. It has been extended with syntax for invoking a prearranged list of constructors on read objects.! ----- Method: Json class>>escapeForCharacter: (in category 'as yet unclassified') ----- escapeForCharacter: c ^ CharacterEscapeMap at: c ifAbsent: [nil]! ----- Method: Json class>>initialize (in category 'as yet unclassified') ----- initialize "Json initialize." CharacterEscapeMap := Dictionary newFrom: { $" -> $". $\ -> $\. Character backspace -> $b. Character lf -> $n. Character newPage -> $f. Character cr -> $r. Character tab -> $t. }.! ----- Method: Json class>>mimeType (in category 'as yet unclassified') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'as yet unclassified') ----- newWithConstructors: aCollection | m | m _ Dictionary new. aCollection do: [:each | (each isKindOf: Association) ifTrue: [m add: each] ifFalse: [m at: each name asString put: each]]. ^ self new ctorMap: m; yourself.! ----- Method: Json class>>numbersMayContain: (in category 'as yet unclassified') ----- numbersMayContain: aChar ^ aChar isDigit or: [#($- $+ $. $e $E) includes: aChar]! ----- Method: Json class>>readFrom: (in category 'as yet unclassified') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'as yet unclassified') ----- render: anObject | s | s := WriteStream on: String new. anObject jsonWriteOn: s. ^ s contents.! ----- Method: Json class>>render:withConstructor:on: (in category 'as yet unclassified') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'as yet unclassified') ----- renderInstanceVariables: aCollection of: anObject on: aStream | map | map _ Dictionary new. aCollection do: [:ivarName | map at: ivarName put: (anObject instVarNamed: ivarName)]. self render: map withConstructor: anObject class name asString on: aStream! ----- Method: Json>>consume:returning: (in category 'private') ----- consume: aString returning: anObject aString do: [:c | self next == c ifFalse: [JsonSyntaxError signal: 'Expected ''', aString, ''''] ]. ^ anObject! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap _ m! ----- Method: Json>>interpretStringEscape (in category 'private') ----- interpretStringEscape | c | c := self next. c == $b ifTrue: [^ Character backspace]. c == $n ifTrue: [^ Character lf]. c == $f ifTrue: [^ Character newPage]. c == $r ifTrue: [^ Character cr]. c == $t ifTrue: [^ Character tab]. c == $u ifTrue: [^ self unescapeUnicode]. ^ c.! ----- Method: Json>>next (in category 'private') ----- next ^ self stream next! ----- Method: Json>>peek (in category 'private') ----- peek ^ self stream peek! ----- Method: Json>>readAny (in category 'parsing') ----- readAny "This is the main entry point for the JSON parser. See also readFrom: on the class side." | c | self skipWhitespace. c := self peek asLowercase. c == ${ ifTrue: [self next. ^ self readDictionary]. c == $[ ifTrue: [self next. ^ self readArray]. c == $" ifTrue: [self next. ^ self readString]. c == $t ifTrue: [^ self consume: 'true' returning: true]. c == $f ifTrue: [^ self consume: 'false' returning: false]. c == $n ifTrue: [^ self consume: 'null' returning: nil]. c == $@ ifTrue: [self next. ^ self readConstructor]. (Json numbersMayContain: c) ifTrue: [^ self readNumber]. JsonSyntaxError signal: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | a needComma | a := OrderedCollection new. needComma _ false. [ self skipWhitespace. self peek == $] ifTrue: [self next. ^ a asArray]. needComma ifTrue: [self peek == $, ifFalse: [JsonSyntaxError signal: 'Missing comma']. self next.] ifFalse: [needComma _ true]. a add: self readAny. ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor | s c v ctor | s := WriteStream on: ''. [ c := self peek. c ifNil: [JsonSyntaxError signal: 'Premature EOF reading constructor name']. ((c == $.) or: [c isLetter]) ifTrue: [s nextPut: c. self next] ifFalse: [ v := self readAny. s := s contents. ctor _ ctorMap ifNotNil: [ctor _ ctorMap at: s ifAbsent: [nil]]. ctor ifNil: [JsonSyntaxError signal: 'Unknown ctor ', s]. ^ ctor constructFromJson: v] ] repeat. ! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | m k v needComma | m := Dictionary new. needComma _ false. [ self skipWhitespace. self peek == $} ifTrue: [self next. ^ m]. needComma ifTrue: [self peek == $, ifFalse: [JsonSyntaxError signal: 'Missing comma']. self next. self skipWhitespace] ifFalse: [needComma _ true.]. self next == $" ifFalse: [JsonSyntaxError signal: 'Key in dictionary must be string']. k := self readString. self skipWhitespace. self peek == $: ifFalse: [JsonSyntaxError signal: 'Missing colon']. self next. v := self readAny. m at: k put: v. ] repeat. ! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream self stream: aStream. ^ self readAny! ----- Method: Json>>readNumber (in category 'private') ----- readNumber | acc c | acc := WriteStream on: ''. [ c := self peek. (c isNil not and: [Json numbersMayContain: c]) ifFalse: [ [^ acc contents asNumber] on: Error do: [JsonSyntaxError signal: 'Invalid number']]. acc nextPut: c. self next. ] repeat.! ----- Method: Json>>readString (in category 'private') ----- readString | s c | s := WriteStream on: ''. [ c := self next. c == $\ ifTrue: [s nextPut: self interpretStringEscape.] ifFalse: [c == $" ifTrue: [^ s contents.]. s nextPut: c] ] repeat.! ----- Method: Json>>skipComment (in category 'private') ----- skipComment self peek == $/ ifTrue: [ self next. self peek == $/ ifTrue: [self skipToEndOfLine] ifFalse: [self peek == $* ifTrue: [self next. self skipCommentBody] ifFalse: [JsonSyntaxError signal: 'Invalid comment syntax']]] ! ----- Method: Json>>skipCommentBody (in category 'private') ----- skipCommentBody [ [self next == $*] whileFalse. self peek == $/ ] whileFalse. self next. "skip that last slash" self skipWhitespace.! ----- Method: Json>>skipToEndOfLine (in category 'private') ----- skipToEndOfLine [self peek == Character cr or: [self peek == Character lf]] whileFalse: [self next]. self skipWhitespace! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace [self peek isSeparator] whileTrue: [self next]. self skipComment.! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'accessing') ----- stream: anObject "Set the value of stream" stream := anObject. stream reset.! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode |string| string := (String with: self next with: self next with: self next with: self next) asUppercase. ^ Unicode value: (Number readFrom: '16r', string)! Object subclass: #JsonDummyTestObject instanceVariableNames: 'a b c' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonDummyTestObject class>>constructFromJson: (in category 'as yet unclassified') ----- constructFromJson: j ^ self new a: (j at: 'a'); b: (j at: 'b'); c: (j at: 'c'); yourself! ----- Method: JsonDummyTestObject>>= (in category 'as yet unclassified') ----- = other ^ other class == self class and: [ a = other a and: [ b = other b and: [ c = other c]]]! ----- Method: JsonDummyTestObject>>a (in category 'accessing') ----- a "Answer the value of a" ^ a! ----- Method: JsonDummyTestObject>>a: (in category 'accessing') ----- a: anObject "Set the value of a" a _ anObject! ----- Method: JsonDummyTestObject>>b (in category 'accessing') ----- b "Answer the value of b" ^ b! ----- Method: JsonDummyTestObject>>b: (in category 'accessing') ----- b: anObject "Set the value of b" b _ anObject! ----- Method: JsonDummyTestObject>>c (in category 'accessing') ----- c "Answer the value of c" ^ c! ----- Method: JsonDummyTestObject>>c: (in category 'accessing') ----- c: anObject "Set the value of c" c _ anObject! ----- Method: JsonDummyTestObject>>jsonWriteOn: (in category 'as yet unclassified') ----- jsonWriteOn: s Json renderInstanceVariables: {#a. #b. #c} of: self on: s ! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: self asString.! ----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. aStream nextPut: $].! ----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma _ false. aStream nextPut: ${. self keysAndValuesDo: [:k :v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma _ true ]. k asString jsonWriteOn: aStream. aStream nextPutAll: ': '. v jsonWriteOn: aStream. ]. aStream nextPut: $}.! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | replacement | aStream nextPut: $". self do: [:ch | replacement _ Json escapeForCharacter: ch. replacement ifNil: [ aStream nextPut: ch ] ifNotNil: [ aStream nextPut: $\; nextPut: replacement ]. ]. aStream nextPut: $". ! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: '<historical>' prior: 0! Class Json signals instances of me when an input stream contains invalid JSON input.! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>json:equals: (in category 'as yet unclassified') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'as yet unclassified') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'as yet unclassified') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'as yet unclassified') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'as yet unclassified') ----- testArray self json: '[]' equals: #(). self json: '[[]]' equals: #(#()). self json: '[[], []]' equals: #(#() #()). self json: '["hi", "there"]' equals: #('hi' 'there'). self json: '[["a", "b", null]]' equals: #(('a' 'b' nil)).! ----- Method: JsonTests>>testAtomFalse (in category 'as yet unclassified') ----- testAtomFalse self json: 'false' equals: false. self json: ' false' equals: false. self json: 'false ' equals: false. self json: ' false ' equals: false. ! ----- Method: JsonTests>>testAtomNull (in category 'as yet unclassified') ----- testAtomNull self json: 'null' equals: nil. self json: ' null' equals: nil. self json: 'null ' equals: nil. self json: ' null ' equals: nil. ! ----- Method: JsonTests>>testAtomNumber (in category 'as yet unclassified') ----- testAtomNumber self json: '1' equals: 1. self json: '0123' equals: 123. self json: '1.23e2' equals: 123. self json: '-1' equals: -1. self json: '-0' equals: 0. self json: '[-1.2]' equals: #(-1.2).! ----- Method: JsonTests>>testAtomString (in category 'as yet unclassified') ----- testAtomString self json: '"hi"' equals: 'hi'. self json: '"\""' equals: '"'. self json: '"\\"' equals: '\'. self json: '""' equals: ''.! ----- Method: JsonTests>>testAtomTrue (in category 'as yet unclassified') ----- testAtomTrue self json: 'true' equals: true. self json: ' true' equals: true. self json: 'true ' equals: true. self json: ' true ' equals: true. ! ----- Method: JsonTests>>testCtor (in category 'as yet unclassified') ----- testCtor self json: '@JsonDummyTestObject {"a": 1, "b": 2, "c": 3}' equals: self simpleDummyObject. self json: (Json render: self simpleDummyObject) equals: self simpleDummyObject.! ----- Method: JsonTests>>testDictionary (in category 'as yet unclassified') ----- testDictionary self json: '{}' equals: (Dictionary new). self json: '{"a": "a"}' equals: (Dictionary new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (Dictionary new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: ({'a'->'b'. 'b'->'a'} as: Dictionary).! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self should: [self readFrom: '@Missing[]'] raise: JsonSyntaxError whoseDescriptionIncludes: 'Unknown ctor' description: 'Unknown ctor' ! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonSyntaxError whoseDescriptionIncludes: 'Unknown ctor' description: 'Unknown ctor' ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

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

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-djr.14.mcz ==================== Summary ==================== Name: JSON-djr.14 Author: djr Time: 7 October 2007, 12:22:39 am UUID: bc2c89b8-c2c5-4c97-b0e0-f42d95680878 Ancestors: JSON-aesp.13 Only reset the stream after setting it if it responds to #reset ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! Object subclass: #Json instanceVariableNames: 'stream ctorMap' classVariableNames: 'CharacterEscapeMap' poolDictionaries: '' category: 'JSON'! !Json commentStamp: '<historical>' prior: 0! This class reads and writes JSON format data - strings, numbers, boolean, nil, arrays and dictionaries. See http://www.crockford.com/JSON/index.html. It has been extended with syntax for invoking a prearranged list of constructors on read objects.! ----- Method: Json class>>escapeForCharacter: (in category 'as yet unclassified') ----- escapeForCharacter: c ^ CharacterEscapeMap at: c ifAbsent: [nil]! ----- Method: Json class>>initialize (in category 'as yet unclassified') ----- initialize "Json initialize." CharacterEscapeMap := Dictionary newFrom: { $" -> $". $\ -> $\. Character backspace -> $b. Character lf -> $n. Character newPage -> $f. Character cr -> $r. Character tab -> $t. }.! ----- Method: Json class>>mimeType (in category 'as yet unclassified') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'as yet unclassified') ----- newWithConstructors: aCollection | m | m _ Dictionary new. aCollection do: [:each | (each isKindOf: Association) ifTrue: [m add: each] ifFalse: [m at: each name asString put: each]]. ^ self new ctorMap: m; yourself.! ----- Method: Json class>>numbersMayContain: (in category 'as yet unclassified') ----- numbersMayContain: aChar ^ aChar isDigit or: [#($- $+ $. $e $E) includes: aChar]! ----- Method: Json class>>readFrom: (in category 'as yet unclassified') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'as yet unclassified') ----- render: anObject | s | s := WriteStream on: String new. anObject jsonWriteOn: s. ^ s contents.! ----- Method: Json class>>render:withConstructor:on: (in category 'as yet unclassified') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'as yet unclassified') ----- renderInstanceVariables: aCollection of: anObject on: aStream | map | map _ Dictionary new. aCollection do: [:ivarName | map at: ivarName put: (anObject instVarNamed: ivarName)]. self render: map withConstructor: anObject class name asString on: aStream! ----- Method: Json>>consume:returning: (in category 'private') ----- consume: aString returning: anObject aString do: [:c | self next == c ifFalse: [JsonSyntaxError signal: 'Expected ''', aString, ''''] ]. ^ anObject! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap _ m! ----- Method: Json>>interpretStringEscape (in category 'private') ----- interpretStringEscape | c | c := self next. c == $b ifTrue: [^ Character backspace]. c == $n ifTrue: [^ Character lf]. c == $f ifTrue: [^ Character newPage]. c == $r ifTrue: [^ Character cr]. c == $t ifTrue: [^ Character tab]. c == $u ifTrue: [^ self unescapeUnicode]. ^ c.! ----- Method: Json>>next (in category 'private') ----- next ^ self stream next! ----- Method: Json>>peek (in category 'private') ----- peek ^ self stream peek! ----- Method: Json>>readAny (in category 'parsing') ----- readAny "This is the main entry point for the JSON parser. See also readFrom: on the class side." | c | self skipWhitespace. c := self peek asLowercase. c == ${ ifTrue: [self next. ^ self readDictionary]. c == $[ ifTrue: [self next. ^ self readArray]. c == $" ifTrue: [self next. ^ self readString]. c == $t ifTrue: [^ self consume: 'true' returning: true]. c == $f ifTrue: [^ self consume: 'false' returning: false]. c == $n ifTrue: [^ self consume: 'null' returning: nil]. c == $@ ifTrue: [self next. ^ self readConstructor]. (Json numbersMayContain: c) ifTrue: [^ self readNumber]. JsonSyntaxError signal: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | a needComma | a := OrderedCollection new. needComma _ false. [ self skipWhitespace. self peek == $] ifTrue: [self next. ^ a asArray]. needComma ifTrue: [self peek == $, ifFalse: [JsonSyntaxError signal: 'Missing comma']. self next.] ifFalse: [needComma _ true]. a add: self readAny. ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor | s c v ctor | s := WriteStream on: ''. [ c := self peek. c ifNil: [JsonSyntaxError signal: 'Premature EOF reading constructor name']. ((c == $.) or: [c isLetter]) ifTrue: [s nextPut: c. self next] ifFalse: [ v := self readAny. s := s contents. ctor _ ctorMap ifNotNil: [ctor _ ctorMap at: s ifAbsent: [nil]]. ctor ifNil: [JsonSyntaxError signal: 'Unknown ctor ', s]. ^ ctor constructFromJson: v] ] repeat. ! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | m k v needComma | m := Dictionary new. needComma _ false. [ self skipWhitespace. self peek == $} ifTrue: [self next. ^ m]. needComma ifTrue: [self peek == $, ifFalse: [JsonSyntaxError signal: 'Missing comma']. self next. self skipWhitespace] ifFalse: [needComma _ true.]. self next == $" ifFalse: [JsonSyntaxError signal: 'Key in dictionary must be string']. k := self readString. self skipWhitespace. self peek == $: ifFalse: [JsonSyntaxError signal: 'Missing colon']. self next. v := self readAny. m at: k put: v. ] repeat. ! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream self stream: aStream. ^ self readAny! ----- Method: Json>>readNumber (in category 'private') ----- readNumber | acc c | acc := WriteStream on: ''. [ c := self peek. (c isNil not and: [Json numbersMayContain: c]) ifFalse: [ [^ acc contents asNumber] on: Error do: [JsonSyntaxError signal: 'Invalid number']]. acc nextPut: c. self next. ] repeat.! ----- Method: Json>>readString (in category 'private') ----- readString | s c | s := WriteStream on: ''. [ c := self next. c == $\ ifTrue: [s nextPut: self interpretStringEscape.] ifFalse: [c == $" ifTrue: [^ s contents.]. s nextPut: c] ] repeat.! ----- Method: Json>>skipComment (in category 'private') ----- skipComment self peek == $/ ifTrue: [ self next. self peek == $/ ifTrue: [self skipToEndOfLine] ifFalse: [self peek == $* ifTrue: [self next. self skipCommentBody] ifFalse: [JsonSyntaxError signal: 'Invalid comment syntax']]] ! ----- Method: Json>>skipCommentBody (in category 'private') ----- skipCommentBody [ [self next == $*] whileFalse. self peek == $/ ] whileFalse. self next. "skip that last slash" self skipWhitespace.! ----- Method: Json>>skipToEndOfLine (in category 'private') ----- skipToEndOfLine [self peek == Character cr or: [self peek == Character lf]] whileFalse: [self next]. self skipWhitespace! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace [self peek isSeparator] whileTrue: [self next]. self skipComment.! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'accessing') ----- stream: anObject "Set the value of stream" stream := anObject. (stream respondsTo: #reset) ifTrue: [ stream reset. ]. ! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode |string| string := (String with: self next with: self next with: self next with: self next) asUppercase. ^ Unicode value: (Number readFrom: '16r', string)! Object subclass: #JsonDummyTestObject instanceVariableNames: 'a b c' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonDummyTestObject class>>constructFromJson: (in category 'as yet unclassified') ----- constructFromJson: j ^ self new a: (j at: 'a'); b: (j at: 'b'); c: (j at: 'c'); yourself! ----- Method: JsonDummyTestObject>>= (in category 'as yet unclassified') ----- = other ^ other class == self class and: [ a = other a and: [ b = other b and: [ c = other c]]]! ----- Method: JsonDummyTestObject>>a (in category 'accessing') ----- a "Answer the value of a" ^ a! ----- Method: JsonDummyTestObject>>a: (in category 'accessing') ----- a: anObject "Set the value of a" a _ anObject! ----- Method: JsonDummyTestObject>>b (in category 'accessing') ----- b "Answer the value of b" ^ b! ----- Method: JsonDummyTestObject>>b: (in category 'accessing') ----- b: anObject "Set the value of b" b _ anObject! ----- Method: JsonDummyTestObject>>c (in category 'accessing') ----- c "Answer the value of c" ^ c! ----- Method: JsonDummyTestObject>>c: (in category 'accessing') ----- c: anObject "Set the value of c" c _ anObject! ----- Method: JsonDummyTestObject>>jsonWriteOn: (in category 'as yet unclassified') ----- jsonWriteOn: s Json renderInstanceVariables: {#a. #b. #c} of: self on: s ! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: self asString.! ----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [:v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream. ]. aStream nextPut: $].! ----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma _ false. aStream nextPut: ${. self keysAndValuesDo: [:k :v | needComma ifTrue: [ aStream nextPutAll: ', ' ] ifFalse: [ needComma _ true ]. k asString jsonWriteOn: aStream. aStream nextPutAll: ': '. v jsonWriteOn: aStream. ]. aStream nextPut: $}.! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | replacement | aStream nextPut: $". self do: [:ch | replacement _ Json escapeForCharacter: ch. replacement ifNil: [ aStream nextPut: ch ] ifNotNil: [ aStream nextPut: $\; nextPut: replacement ]. ]. aStream nextPut: $". ! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: '<historical>' prior: 0! Class Json signals instances of me when an input stream contains invalid JSON input.! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>json:equals: (in category 'as yet unclassified') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'as yet unclassified') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'as yet unclassified') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'as yet unclassified') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'as yet unclassified') ----- testArray self json: '[]' equals: #(). self json: '[[]]' equals: #(#()). self json: '[[], []]' equals: #(#() #()). self json: '["hi", "there"]' equals: #('hi' 'there'). self json: '[["a", "b", null]]' equals: #(('a' 'b' nil)).! ----- Method: JsonTests>>testAtomFalse (in category 'as yet unclassified') ----- testAtomFalse self json: 'false' equals: false. self json: ' false' equals: false. self json: 'false ' equals: false. self json: ' false ' equals: false. ! ----- Method: JsonTests>>testAtomNull (in category 'as yet unclassified') ----- testAtomNull self json: 'null' equals: nil. self json: ' null' equals: nil. self json: 'null ' equals: nil. self json: ' null ' equals: nil. ! ----- Method: JsonTests>>testAtomNumber (in category 'as yet unclassified') ----- testAtomNumber self json: '1' equals: 1. self json: '0123' equals: 123. self json: '1.23e2' equals: 123. self json: '-1' equals: -1. self json: '-0' equals: 0. self json: '[-1.2]' equals: #(-1.2).! ----- Method: JsonTests>>testAtomString (in category 'as yet unclassified') ----- testAtomString self json: '"hi"' equals: 'hi'. self json: '"\""' equals: '"'. self json: '"\\"' equals: '\'. self json: '""' equals: ''.! ----- Method: JsonTests>>testAtomTrue (in category 'as yet unclassified') ----- testAtomTrue self json: 'true' equals: true. self json: ' true' equals: true. self json: 'true ' equals: true. self json: ' true ' equals: true. ! ----- Method: JsonTests>>testCtor (in category 'as yet unclassified') ----- testCtor self json: '@JsonDummyTestObject {"a": 1, "b": 2, "c": 3}' equals: self simpleDummyObject. self json: (Json render: self simpleDummyObject) equals: self simpleDummyObject.! ----- Method: JsonTests>>testDictionary (in category 'as yet unclassified') ----- testDictionary self json: '{}' equals: (Dictionary new). self json: '{"a": "a"}' equals: (Dictionary new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (Dictionary new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: ({'a'->'b'. 'b'->'a'} as: Dictionary).! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self should: [self readFrom: '@Missing[]'] raise: JsonSyntaxError whoseDescriptionIncludes: 'Unknown ctor' description: 'Unknown ctor' ! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonSyntaxError whoseDescriptionIncludes: 'Unknown ctor' description: 'Unknown ctor' ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

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

08 Sep '22

Christoph Thiede uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-ul.15.mcz ==================== Summary ==================== Name: JSON-ul.15 Author: ul Time: 4 November 2008, 7:31:42 am UUID: c5bb462e-3d57-aa44-b199-0a8bada56309 Ancestors: JSON-djr.14 - fix: Control characters are escaped. - enh: rendering time decreased (especially for strings) - unnecessary spaces after commas and columns are not rendered ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: ArrayedCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPut: $[. self size > 0 ifTrue: [ (self at: 1) jsonWriteOn: aStream. 2 to: self size do: [ :index | aStream nextPut: $,. (self at: index) jsonWriteOn: aStream ] ]. aStream nextPut: $]! Object subclass: #Json instanceVariableNames: 'stream ctorMap' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray'! !Json commentStamp: '<historical>' prior: 0! This class reads and writes JSON format data - strings, numbers, boolean, nil, arrays and dictionaries. See http://www.crockford.com/JSON/index.html. It has been extended with syntax for invoking a prearranged list of constructors on read objects.! Json class instanceVariableNames: 'escapeArray'! ----- Method: Json class>>escapeForCharacter: (in category 'as yet unclassified') ----- escapeForCharacter: c | index | (index := c asciiValue + 1) <= escapeArray size ifTrue: [ ^escapeArray at: index ]. ^nil! ----- Method: Json class>>initialize (in category 'as yet unclassified') ----- initialize "Json initialize." escapeArray := Array new: 128. (0 to: 31), #(127) do: [ :each | escapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0) ]. { $" -> '\"'. $\ -> '\\'. Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | escapeArray at: each key asciiValue + 1 put: each value ]. ! ----- Method: Json class>>mimeType (in category 'as yet unclassified') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'as yet unclassified') ----- newWithConstructors: aCollection | m | m _ Dictionary new. aCollection do: [:each | (each isKindOf: Association) ifTrue: [m add: each] ifFalse: [m at: each name asString put: each]]. ^ self new ctorMap: m; yourself.! ----- Method: Json class>>numbersMayContain: (in category 'as yet unclassified') ----- numbersMayContain: aChar ^ aChar isDigit or: [#($- $+ $. $e $E) includes: aChar]! ----- Method: Json class>>readFrom: (in category 'as yet unclassified') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'as yet unclassified') ----- render: anObject | s | s := WriteStream on: String new. anObject jsonWriteOn: s. ^ s contents.! ----- Method: Json class>>render:withConstructor:on: (in category 'as yet unclassified') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'as yet unclassified') ----- renderInstanceVariables: aCollection of: anObject on: aStream | map | map _ Dictionary new. aCollection do: [:ivarName | map at: ivarName put: (anObject instVarNamed: ivarName)]. self render: map withConstructor: anObject class name asString on: aStream! ----- Method: Json>>consume:returning: (in category 'private') ----- consume: aString returning: anObject aString do: [:c | self next == c ifFalse: [JsonSyntaxError signal: 'Expected ''', aString, ''''] ]. ^ anObject! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap _ m! ----- Method: Json>>interpretStringEscape (in category 'private') ----- interpretStringEscape | c | c := self next. c == $b ifTrue: [^ Character backspace]. c == $n ifTrue: [^ Character lf]. c == $f ifTrue: [^ Character newPage]. c == $r ifTrue: [^ Character cr]. c == $t ifTrue: [^ Character tab]. c == $u ifTrue: [^ self unescapeUnicode]. ^ c.! ----- Method: Json>>next (in category 'private') ----- next ^ self stream next! ----- Method: Json>>peek (in category 'private') ----- peek ^ self stream peek! ----- Method: Json>>readAny (in category 'parsing') ----- readAny "This is the main entry point for the JSON parser. See also readFrom: on the class side." | c | self skipWhitespace. c := self peek asLowercase. c == ${ ifTrue: [self next. ^ self readDictionary]. c == $[ ifTrue: [self next. ^ self readArray]. c == $" ifTrue: [self next. ^ self readString]. c == $t ifTrue: [^ self consume: 'true' returning: true]. c == $f ifTrue: [^ self consume: 'false' returning: false]. c == $n ifTrue: [^ self consume: 'null' returning: nil]. c == $@ ifTrue: [self next. ^ self readConstructor]. (Json numbersMayContain: c) ifTrue: [^ self readNumber]. JsonSyntaxError signal: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | a needComma | a := OrderedCollection new. needComma _ false. [ self skipWhitespace. self peek == $] ifTrue: [self next. ^ a asArray]. needComma ifTrue: [self peek == $, ifFalse: [JsonSyntaxError signal: 'Missing comma']. self next.] ifFalse: [needComma _ true]. a add: self readAny. ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor | s c v ctor | s := WriteStream on: ''. [ c := self peek. c ifNil: [JsonSyntaxError signal: 'Premature EOF reading constructor name']. ((c == $.) or: [c isLetter]) ifTrue: [s nextPut: c. self next] ifFalse: [ v := self readAny. s := s contents. ctor _ ctorMap ifNotNil: [ctor _ ctorMap at: s ifAbsent: [nil]]. ctor ifNil: [JsonSyntaxError signal: 'Unknown ctor ', s]. ^ ctor constructFromJson: v] ] repeat. ! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | m k v needComma | m := Dictionary new. needComma _ false. [ self skipWhitespace. self peek == $} ifTrue: [self next. ^ m]. needComma ifTrue: [self peek == $, ifFalse: [JsonSyntaxError signal: 'Missing comma']. self next. self skipWhitespace] ifFalse: [needComma _ true.]. self next == $" ifFalse: [JsonSyntaxError signal: 'Key in dictionary must be string']. k := self readString. self skipWhitespace. self peek == $: ifFalse: [JsonSyntaxError signal: 'Missing colon']. self next. v := self readAny. m at: k put: v. ] repeat. ! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream self stream: aStream. ^ self readAny! ----- Method: Json>>readNumber (in category 'private') ----- readNumber | acc c | acc := WriteStream on: ''. [ c := self peek. (c isNil not and: [Json numbersMayContain: c]) ifFalse: [ [^ acc contents asNumber] on: Error do: [JsonSyntaxError signal: 'Invalid number']]. acc nextPut: c. self next. ] repeat.! ----- Method: Json>>readString (in category 'private') ----- readString | s c | s := WriteStream on: ''. [ c := self next. c == $\ ifTrue: [s nextPut: self interpretStringEscape.] ifFalse: [c == $" ifTrue: [^ s contents.]. s nextPut: c] ] repeat.! ----- Method: Json>>skipComment (in category 'private') ----- skipComment self peek == $/ ifTrue: [ self next. self peek == $/ ifTrue: [self skipToEndOfLine] ifFalse: [self peek == $* ifTrue: [self next. self skipCommentBody] ifFalse: [JsonSyntaxError signal: 'Invalid comment syntax']]] ! ----- Method: Json>>skipCommentBody (in category 'private') ----- skipCommentBody [ [self next == $*] whileFalse. self peek == $/ ] whileFalse. self next. "skip that last slash" self skipWhitespace.! ----- Method: Json>>skipToEndOfLine (in category 'private') ----- skipToEndOfLine [self peek == Character cr or: [self peek == Character lf]] whileFalse: [self next]. self skipWhitespace! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace [self peek isSeparator] whileTrue: [self next]. self skipComment.! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'accessing') ----- stream: anObject "Set the value of stream" stream := anObject. (stream respondsTo: #reset) ifTrue: [ stream reset. ]. ! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode |string| string := (String with: self next with: self next with: self next with: self next) asUppercase. ^ Unicode value: (Number readFrom: '16r', string)! Object subclass: #JsonDummyTestObject instanceVariableNames: 'a b c' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonDummyTestObject class>>constructFromJson: (in category 'as yet unclassified') ----- constructFromJson: j ^ self new a: (j at: 'a'); b: (j at: 'b'); c: (j at: 'c'); yourself! ----- Method: JsonDummyTestObject>>= (in category 'as yet unclassified') ----- = other ^ other class == self class and: [ a = other a and: [ b = other b and: [ c = other c]]]! ----- Method: JsonDummyTestObject>>a (in category 'accessing') ----- a "Answer the value of a" ^ a! ----- Method: JsonDummyTestObject>>a: (in category 'accessing') ----- a: anObject "Set the value of a" a _ anObject! ----- Method: JsonDummyTestObject>>b (in category 'accessing') ----- b "Answer the value of b" ^ b! ----- Method: JsonDummyTestObject>>b: (in category 'accessing') ----- b: anObject "Set the value of b" b _ anObject! ----- Method: JsonDummyTestObject>>c (in category 'accessing') ----- c "Answer the value of c" ^ c! ----- Method: JsonDummyTestObject>>c: (in category 'accessing') ----- c: anObject "Set the value of c" c _ anObject! ----- Method: JsonDummyTestObject>>jsonWriteOn: (in category 'as yet unclassified') ----- jsonWriteOn: s Json renderInstanceVariables: {#a. #b. #c} of: self on: s ! ----- Method: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! ----- Method: SequenceableCollection>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: $[. self do: [ :v | needComma ifTrue: [ aStream nextPut: $, ] ifFalse: [ needComma := true ]. v jsonWriteOn: aStream ]. aStream nextPut: $]! ----- Method: Dictionary>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | needComma | needComma := false. aStream nextPut: ${. self associationsDo: [ :assoc | needComma ifTrue: [ aStream nextPut: $, ] ifFalse: [ needComma := true ]. assoc key asString jsonWriteOn: aStream. aStream nextPut: $:. assoc value jsonWriteOn: aStream ]. aStream nextPut: $}.! ----- Method: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | replacement | aStream nextPut: $". self do: [ :ch | (replacement := Json escapeForCharacter: ch) ifNil: [ aStream nextPut: ch ] ifNotNil: [ aStream nextPutAll: replacement ] ]. aStream nextPut: $". ! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: (self printStringBase: 10)! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: '<historical>' prior: 0! Class Json signals instances of me when an input stream contains invalid JSON input.! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>json:equals: (in category 'as yet unclassified') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'as yet unclassified') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'as yet unclassified') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'as yet unclassified') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'as yet unclassified') ----- testArray self json: '[]' equals: #(). self json: '[[]]' equals: #(#()). self json: '[[], []]' equals: #(#() #()). self json: '["hi", "there"]' equals: #('hi' 'there'). self json: '[["a", "b", null]]' equals: #(('a' 'b' nil)).! ----- Method: JsonTests>>testAtomFalse (in category 'as yet unclassified') ----- testAtomFalse self json: 'false' equals: false. self json: ' false' equals: false. self json: 'false ' equals: false. self json: ' false ' equals: false. ! ----- Method: JsonTests>>testAtomNull (in category 'as yet unclassified') ----- testAtomNull self json: 'null' equals: nil. self json: ' null' equals: nil. self json: 'null ' equals: nil. self json: ' null ' equals: nil. ! ----- Method: JsonTests>>testAtomNumber (in category 'as yet unclassified') ----- testAtomNumber self json: '1' equals: 1. self json: '0123' equals: 123. self json: '1.23e2' equals: 123. self json: '-1' equals: -1. self json: '-0' equals: 0. self json: '[-1.2]' equals: #(-1.2).! ----- Method: JsonTests>>testAtomString (in category 'as yet unclassified') ----- testAtomString self json: '"hi"' equals: 'hi'. self json: '"\""' equals: '"'. self json: '"\\"' equals: '\'. self json: '""' equals: ''.! ----- Method: JsonTests>>testAtomTrue (in category 'as yet unclassified') ----- testAtomTrue self json: 'true' equals: true. self json: ' true' equals: true. self json: 'true ' equals: true. self json: ' true ' equals: true. ! ----- Method: JsonTests>>testCtor (in category 'as yet unclassified') ----- testCtor self json: '@JsonDummyTestObject {"a": 1, "b": 2, "c": 3}' equals: self simpleDummyObject. self json: (Json render: self simpleDummyObject) equals: self simpleDummyObject.! ----- Method: JsonTests>>testDictionary (in category 'as yet unclassified') ----- testDictionary self json: '{}' equals: (Dictionary new). self json: '{"a": "a"}' equals: (Dictionary new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (Dictionary new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: ({'a'->'b'. 'b'->'a'} as: Dictionary).! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self should: [self readFrom: '@Missing[]'] raise: JsonSyntaxError whoseDescriptionIncludes: 'Unknown ctor' description: 'Unknown ctor' ! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonSyntaxError whoseDescriptionIncludes: 'Unknown ctor' description: 'Unknown ctor' ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'.! ----- Method: False>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'false'!

1 0

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

← Newer
1
2
3
4
5
6
7
8
9
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages September 2022