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'!
packages@lists.squeakfoundation.org