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