Squeak-dev September 2022

squeak-dev@lists.squeakfoundation.org

29 participants
157 discussions

The Trunk: JSON-klub.46.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-klub.46.mcz ==================== Summary ==================== Name: JSON-klub.46 Author: klub Time: 14 January 2018, 5:55:56.563627 pm UUID: 7e8086c5-b2b1-46ec-83d0-94e1daee207b Ancestors: JSON-ul.45 Added OrderedJsonObject which is the same as JsonObject, but it inherits from OrderedDictionary, so the order of the entries is preserved. ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- 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'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! OrderedDictionary subclass: #OrderedJsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: OrderedJsonObject 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: OrderedJsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ----- Method: OrderedJsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: OrderedJsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: Time>>jsonWriteOn: (in category '*JSON') ----- jsonWriteOn: stream stream nextPut: $". self print24: true showSeconds: true on: stream. stream 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: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! 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: 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 precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^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: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! NumberParser subclass: #JsonNumberParser instanceVariableNames: 'fraction' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') ----- allowPlusSign ^false! ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') ----- allowPlusSignInExponent ^true! ----- Method: JsonNumberParser>>error: (in category 'error') ----- error: aString JsonSyntaxError signal: aString! ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') ----- exponentLetters ^'eE'! ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') ----- initialize super initialize. base := 10. fraction := Fraction numerator: 0 denominator: 1! ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') ----- makeFloatFromMantissa: mantissa exponent: exponent exponent = 0 ifTrue: [ ^mantissa asFloat ]. exponent >= 16 ifTrue: [ ^(mantissa * (self tenRaisedTo: exponent)) asFloat ]. (exponent >= -15 and: [ mantissa highBitOfMagnitude <= 54 ]) ifTrue: [ exponent >= 1 ifTrue: [ ^mantissa asFloat * (self tenRaisedTo: exponent) asFloat ]. ^mantissa asFloat / (self tenRaisedTo: exponent negated) asFloat ]. ^(fraction setNumerator: mantissa denominator: (self tenRaisedTo: exponent negated)) asFloat! ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') ----- nextElementaryLargeInteger "Form an unsigned integer with incoming digits from sourceStream. Return this integer, or zero if no digits found. Stop reading if end of digits or if a LargeInteger is formed. Count the number of digits and the position of lastNonZero digit and store them in instVar." | digit value | value := 0. nDigits := 0. lastNonZero := 0. [ value isLarge ifTrue: [ ^value ]. ((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 or: [ digit >= 10 ]) ifTrue: [ sourceStream skip: -1. ^value ]. nDigits := nDigits + 1. digit = 0 ifFalse: [ lastNonZero := nDigits. value := value * 10 + digit ] ifTrue: [ value := value * 10 ] ] repeat! ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') ----- nextNumber: negative | numberOfTrailingZeroInIntegerPart numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value | integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $.) ifFalse: [ "No fraction part" negative ifTrue: [ integerPart := integerPart negated ]. self readExponent ifFalse: [ ^integerPart ]. exponent > 0 ifTrue: [ ^integerPart * (self tenRaisedTo: exponent) ]. ^(Fraction numerator: integerPart denominator: (self tenRaisedTo: exponent negated)) asFloat ]. fractionPart := self nextUnsignedIntegerOrNil ifNil: [ self error: 'Missing fraction part!!' ]. fractionPart isZero ifTrue: [ self readExponent ifFalse: [ negative ifTrue: [ integerPart isZero ifTrue: [ ^Float negativeZero ]. ^integerPart negated ]. ^integerPart ]. exponent >= 0 ifTrue: [ negative ifTrue: [ integerPart := integerPart negated ]. ^integerPart * (self tenRaisedTo: exponent) ]. value := self makeFloatFromMantissa: integerPart exponent: exponent. negative ifTrue: [ ^value negated ]. ^value ]. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. numberOfNonZeroFractionDigits := lastNonZero. self readExponent. exponent := exponent - numberOfNonZeroFractionDigits. mantissa := integerPart * (10 raisedToInteger: numberOfNonZeroFractionDigits) + (fractionPart // (10 raisedToInteger: numberOfTrailingZeroInFractionPart)). value := self makeFloatFromMantissa: mantissa exponent: exponent. negative ifTrue: [ ^value negated ]. ^value! ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') ----- nextUnsignedIntegerOrNil "Form an unsigned integer with incoming digits from sourceStream. Answer this integer, or nil if no digit found. Count the number of digits and the position of lastNonZero digit and store them in instVar" | nPackets high nDigitsHigh lastNonZeroHigh low | "read no more digits than one elementary LargeInteger" high := self nextElementaryLargeInteger. nDigits = 0 ifTrue: [^nil]. "Not enough digits to form a LargeInteger, stop iteration" high isLarge ifFalse: [^high]. "We now have to engage arithmetic with LargeInteger Decompose the integer in a high and low packets of growing size:" nPackets := 1. nDigitsHigh := nDigits. lastNonZeroHigh := lastNonZero. [ low := self nextLargeIntegerBase: 10 nPackets: nPackets . high := high * (10 raisedToInteger: nDigits) + low. lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh]. nDigitsHigh := nDigitsHigh + nDigits. low isLarge] whileTrue: [nPackets := nPackets * 2]. nDigits := nDigitsHigh. lastNonZero := lastNonZeroHigh. ^high! ----- Method: JsonNumberParser>>tenRaisedTo: (in category 'parsing-private') ----- tenRaisedTo: anInteger anInteger >= 0 ifFalse: [ ^10 raisedToInteger: anInteger ]. anInteger >= 16 ifTrue: [ ^10 raisedToInteger: anInteger ]. ^#(1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000 10000000000 100000000000 1000000000000 10000000000000 100000000000000 1000000000000000) at: anInteger + 1! ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: stream self printFractionAsDecimalOn: stream! ----- 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: $]! 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"'.! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | index start | aStream nextPut: $". start := 1. [ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [ aStream next: index - start putAll: self startingAt: start. aStream nextPutAll: (Json escapeForCharacter: (self at: index)). start := index + 1 ]. start <= self size ifTrue: [ aStream next: self size + 1 - start putAll: self startingAt: start ]. aStream nextPut: $". ! Object subclass: #Json instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray escapeSet'! !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0! I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries. The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects. Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct. Instance Variables stream: <PositionableStream> currentCharacter: <Character> arrayBufferStream: <WriteStream> stringBufferStream: <ReadWriteStream> numberParser: <ExtendedNumberParser> ctorMap: <Dictionary> For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream. arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one. stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this. numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it. ctorMap is the Dictionary holding the constructor classes by name. arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time. For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:. ! Json class instanceVariableNames: 'escapeArray escapeSet'! ----- Method: Json class>>escapeForCharacter: (in category 'accessing') ----- escapeForCharacter: c | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^nil! ----- Method: Json class>>escapeSet (in category 'accessing') ----- escapeSet ^escapeSet! ----- Method: Json class>>initialize (in category 'class initialization') ----- initialize "Json initialize." | newEscapeArray newEscapeSet | newEscapeArray := Array new: 128. newEscapeSet := CharacterSet new. (0 to: 31), #(127) do: [ :each | newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0). newEscapeSet add: (Character value: each) ]. { $" -> '\"'. $\ -> '\\'. $/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>." Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | newEscapeArray at: each key asciiValue + 1 put: each value. newEscapeSet add: each key ]. escapeArray := newEscapeArray. escapeSet := newEscapeSet! ----- Method: Json class>>mimeType (in category 'accessing') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'instance creation') ----- 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>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'rendering') ----- render: anObject ^String streamContents: [ :stream | anObject jsonWriteOn: stream ]! ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') ----- 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>>arrayBufferStream (in category 'private') ----- arrayBufferStream ^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]! ----- Method: Json>>consume: (in category 'private') ----- consume: aString 1 to: aString size do: [ :index | stream next == (aString at: index) ifFalse: [ self error: 'Expected ', (aString at: index) printString ] ]. currentCharacter := stream next! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap := m! ----- Method: Json>>error: (in category 'error handling') ----- error: aString JsonSyntaxError signal: aString! ----- Method: Json>>interpretStringEscape: (in category 'private') ----- interpretStringEscape: aCharacter aCharacter == $b ifTrue: [ ^Character backspace ]. aCharacter == $n ifTrue: [ ^Character lf ]. aCharacter == $f ifTrue: [ ^Character newPage ]. aCharacter == $r ifTrue: [ ^Character cr ]. aCharacter == $t ifTrue: [ ^Character tab ]. aCharacter == $u ifTrue: [ ^self unescapeUnicode ]. aCharacter == $" ifTrue: [ ^aCharacter ]. aCharacter == $\ ifTrue: [ ^aCharacter ]. aCharacter == $/ ifTrue: [ ^aCharacter ]. self error: 'Unexpected escaped character: ', aCharacter asString ! ----- Method: Json>>readAny (in category 'private') ----- readAny self skipWhitespace. currentCharacter == ${ ifTrue: [ ^self readDictionary ]. currentCharacter == $[ ifTrue: [ ^self readArray ]. currentCharacter == $" ifTrue: [ ^self readString ]. currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ]. currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ]. currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ]. currentCharacter == $- ifTrue: [ ^self readNumber: true ]. (#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [ ^self readNumber: false ]. currentCharacter == $@ ifTrue: [ ^self readConstructor ]. ^self error: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | initialPosition | currentCharacter := stream next. self skipWhitespace. currentCharacter == $] ifTrue: [ currentCharacter := stream next. ^#() ]. initialPosition := self arrayBufferStream position. [ arrayBufferStream nextPut: self readAny. self skipWhitespace. currentCharacter == $] ifTrue: [ | result | result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position. arrayBufferStream position: initialPosition. currentCharacter := stream next. ^result ]. currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ]. currentCharacter := stream next ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor ctorMap ifNil: [ ^self error: 'No constructors were declared.' ]. self stringBufferStream resetToStart. [ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [ stringBufferStream nextPut: currentCharacter ]. (ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor | ^constructor constructFromJson: self readAny ]. self error: 'Unknown constructor: ', stringBufferStream contents! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | result key commaNeeded | result := JsonObject new. commaNeeded := false. currentCharacter := stream next. [ self skipWhitespace. currentCharacter == $} ifTrue: [ currentCharacter := stream next. ^result ]. commaNeeded ifFalse: [ commaNeeded := true ] ifTrue: [ currentCharacter == $, ifFalse: [ self error: 'Missing comma' ]. currentCharacter := stream next. self skipWhitespace ]. currentCharacter == $" ifFalse: [ self error: 'Key in dictionary must be string' ]. key := self readString. self skipWhitespace. currentCharacter == $: ifFalse: [ self error: 'Missing colon' ]. currentCharacter := stream next. result at: key put: self readAny ] repeat. ! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream | result | stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next. result := self readAny. stream atEnd ifFalse: [ stream skip: -1 ]. "Undo prereading." ^result! ----- Method: Json>>readNumber: (in category 'private') ----- readNumber: negative | result | negative ifFalse: [ stream skip: -1 ]. result := (numberParser ifNil: [ numberParser := JsonNumberParser new on: stream; failBlock: [ self error: 'Invalid number.' ]; yourself ]) nextNumber: negative. currentCharacter := stream next. ^result ! ----- Method: Json>>readString (in category 'private') ----- readString self stringBufferStream resetToStart. [ (currentCharacter := stream next) == $\ ifTrue: [ stringBufferStream nextPut: (self interpretStringEscape: stream next) ] ifFalse: [ currentCharacter == $" ifTrue: [ currentCharacter := stream next. ^stringBufferStream contents ]. stringBufferStream nextPut: currentCharacter ] ] repeat! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace [ currentCharacter isSeparator ] whileTrue: [ currentCharacter := stream next ]! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stringBufferStream (in category 'private') ----- stringBufferStream ^stringBufferStream ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ]! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode | code digitValue | code := 0. 1 to: 4 do: [ :index | (digitValue := stream next digitValue) < 0 ifTrue: [ self error: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ code := code * 16 + digitValue ] ifFalse: [ self error: 'Invalid hexadecimal digit' ] ]. ^Character value: code! 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 ]!

1 0

The Trunk: JSON-ul.47.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.47.mcz ==================== Summary ==================== Name: JSON-ul.47 Author: ul Time: 22 January 2018, 12:32:52.716166 am UUID: f2d44ea2-c2a1-4da0-9dec-5a3b1823ab3b Ancestors: JSON-ul.46, JSON-klub.46 - merged with JSON-klub.46 - ScaledDecimal>>jsonWriteOn: rounds the number instead of truncating it ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- 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'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! OrderedDictionary subclass: #OrderedJsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: OrderedJsonObject 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: OrderedJsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ----- Method: OrderedJsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: OrderedJsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: Time>>jsonWriteOn: (in category '*JSON') ----- jsonWriteOn: stream stream nextPut: $". self print24: true showSeconds: true on: stream. stream 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: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: 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 precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^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: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! NumberParser subclass: #JsonNumberParser instanceVariableNames: 'fraction' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') ----- allowPlusSign ^false! ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') ----- allowPlusSignInExponent ^true! ----- Method: JsonNumberParser>>error: (in category 'error') ----- error: aString JsonSyntaxError signal: aString! ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') ----- exponentLetters ^'eE'! ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') ----- initialize super initialize. base := 10. fraction := Fraction numerator: 0 denominator: 1! ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') ----- makeFloatFromMantissa: mantissa exponent: exponent exponent = 0 ifTrue: [ ^mantissa asFloat ]. exponent >= 16 ifTrue: [ ^(mantissa * (self tenRaisedTo: exponent)) asFloat ]. (exponent >= -15 and: [ mantissa highBitOfMagnitude <= 54 ]) ifTrue: [ exponent >= 1 ifTrue: [ ^mantissa asFloat * (self tenRaisedTo: exponent) asFloat ]. ^mantissa asFloat / (self tenRaisedTo: exponent negated) asFloat ]. ^(fraction setNumerator: mantissa denominator: (self tenRaisedTo: exponent negated)) asFloat! ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') ----- nextElementaryLargeInteger "Form an unsigned integer with incoming digits from sourceStream. Return this integer, or zero if no digits found. Stop reading if end of digits or if a LargeInteger is formed. Count the number of digits and the position of lastNonZero digit and store them in instVar." | digit value | value := 0. nDigits := 0. lastNonZero := 0. [ value isLarge ifTrue: [ ^value ]. ((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 or: [ digit >= 10 ]) ifTrue: [ sourceStream skip: -1. ^value ]. nDigits := nDigits + 1. digit = 0 ifFalse: [ lastNonZero := nDigits. value := value * 10 + digit ] ifTrue: [ value := value * 10 ] ] repeat! ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') ----- nextNumber: negative | numberOfTrailingZeroInIntegerPart numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value | integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $.) ifFalse: [ "No fraction part" negative ifTrue: [ integerPart := integerPart negated ]. self readExponent ifFalse: [ ^integerPart ]. exponent > 0 ifTrue: [ ^integerPart * (self tenRaisedTo: exponent) ]. ^(Fraction numerator: integerPart denominator: (self tenRaisedTo: exponent negated)) asFloat ]. fractionPart := self nextUnsignedIntegerOrNil ifNil: [ self error: 'Missing fraction part!!' ]. fractionPart isZero ifTrue: [ self readExponent ifFalse: [ negative ifTrue: [ integerPart isZero ifTrue: [ ^Float negativeZero ]. ^integerPart negated ]. ^integerPart ]. exponent >= 0 ifTrue: [ negative ifTrue: [ integerPart := integerPart negated ]. ^integerPart * (self tenRaisedTo: exponent) ]. value := self makeFloatFromMantissa: integerPart exponent: exponent. negative ifTrue: [ ^value negated ]. ^value ]. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. numberOfNonZeroFractionDigits := lastNonZero. self readExponent. exponent := exponent - numberOfNonZeroFractionDigits. mantissa := integerPart * (self tenRaisedTo: numberOfNonZeroFractionDigits) + (fractionPart // (self tenRaisedTo: numberOfTrailingZeroInFractionPart)). value := self makeFloatFromMantissa: mantissa exponent: exponent. negative ifTrue: [ ^value negated ]. ^value! ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') ----- nextUnsignedIntegerOrNil "Form an unsigned integer with incoming digits from sourceStream. Answer this integer, or nil if no digit found. Count the number of digits and the position of lastNonZero digit and store them in instVar" | nPackets high nDigitsHigh lastNonZeroHigh low | "read no more digits than one elementary LargeInteger" high := self nextElementaryLargeInteger. nDigits = 0 ifTrue: [^nil]. "Not enough digits to form a LargeInteger, stop iteration" high isLarge ifFalse: [^high]. "We now have to engage arithmetic with LargeInteger Decompose the integer in a high and low packets of growing size:" nPackets := 1. nDigitsHigh := nDigits. lastNonZeroHigh := lastNonZero. [ low := self nextLargeIntegerBase: 10 nPackets: nPackets . high := high * (self tenRaisedTo: nDigits) + low. lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh]. nDigitsHigh := nDigitsHigh + nDigits. low isLarge] whileTrue: [nPackets := nPackets * 2]. nDigits := nDigitsHigh. lastNonZero := lastNonZeroHigh. ^high! ----- Method: JsonNumberParser>>tenRaisedTo: (in category 'parsing-private') ----- tenRaisedTo: anInteger anInteger >= 0 ifFalse: [ ^10 raisedToInteger: anInteger ]. anInteger >= 16 ifTrue: [ ^10 raisedToInteger: anInteger ]. ^#(1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000 10000000000 100000000000 1000000000000 10000000000000 100000000000000 1000000000000000) at: anInteger + 1! ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: stream self printOn: stream showingDecimalPlaces: scale! ----- 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: $]! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>assertIncompleteJson: (in category 'as yet unclassified') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'as yet unclassified') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- Method: JsonTests>>json:equals: (in category 'as yet unclassified') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'as yet unclassified') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'as yet unclassified') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'as yet unclassified') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'as yet unclassified') ----- testArray self json: '[]' equals: #(). self json: '[[]]' equals: #(#()). self json: '[[], []]' equals: #(#() #()). self json: '["hi", "there"]' equals: #('hi' 'there'). self json: '[["a", "b", null]]' equals: #(('a' 'b' nil)).! ----- Method: JsonTests>>testAtomFalse (in category 'as yet unclassified') ----- testAtomFalse self json: 'false' equals: false. self json: ' false' equals: false. self json: 'false ' equals: false. self json: ' false ' equals: false. ! ----- Method: JsonTests>>testAtomNull (in category 'as yet unclassified') ----- testAtomNull self json: 'null' equals: nil. self json: ' null' equals: nil. self json: 'null ' equals: nil. self json: ' null ' equals: nil. ! ----- Method: JsonTests>>testAtomNumber (in category 'as yet unclassified') ----- testAtomNumber self json: '1' equals: 1. self json: '0123' equals: 123. self json: '1.23e2' equals: 123. self json: '-1' equals: -1. self json: '-0' equals: 0. self json: '[-1.2]' equals: #(-1.2).! ----- Method: JsonTests>>testAtomString (in category 'as yet unclassified') ----- testAtomString self json: '"hi"' equals: 'hi'. self json: '"\""' equals: '"'. self json: '"\\"' equals: '\'. self json: '""' equals: ''. self json: '"a\u0004b"' equals: ({$a. Character value: 4. $b} as: String). self json: '"a\nb"' equals: ({$a. Character lf. $b} as: String).! ----- Method: JsonTests>>testAtomTrue (in category 'as yet unclassified') ----- testAtomTrue self json: 'true' equals: true. self json: ' true' equals: true. self json: 'true ' equals: true. self json: ' true ' equals: true. ! ----- Method: JsonTests>>testCtor (in category 'as yet unclassified') ----- testCtor self json: '@JsonDummyTestObject {"a": 1, "b": 2, "c": 3}' equals: self simpleDummyObject. self json: (Json render: self simpleDummyObject) equals: self simpleDummyObject.! ----- Method: JsonTests>>testDictionary (in category 'as yet unclassified') ----- testDictionary self json: '{}' equals: (JsonObject new). self json: '{"a": "a"}' equals: (JsonObject new at: 'a' put: 'a'; yourself). self json: '{"a": [[]]}' equals: (JsonObject new at: 'a' put: #(#()); yourself). self json: '{"a":"b", "b":"a"}' equals: (JsonObject new add: 'a'->'b'; add: 'b'->'a';yourself).! ----- Method: JsonTests>>testIncomplete (in category 'as yet unclassified') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'as yet unclassified') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'as yet unclassified') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testMissingCtor (in category 'as yet unclassified') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'as yet unclassified') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testStreaming (in category 'as yet unclassified') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: JsonObject new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'as yet unclassified') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- Method: JsonTests>>testWriteAssociation (in category 'as yet unclassified') ----- testWriteAssociation self render: 'key' -> 'value' equals: '"key": "value"'. self render: 'key' -> 2 equals: '"key": 2'. "keys should be strings" self render: 42 -> 2 equals: '"42": 2'. "try to do _something_ for more complex keys" self render: #(42 43 44) -> 2 equals: '"#(42 43 44)": 2'. ! ----- Method: JsonTests>>testWriteString (in category 'as yet unclassified') ----- testWriteString self render: '"' equals: '"\""'. self render: '\' equals: '"\\"'. self render: 'hi' equals: '"hi"'. self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'. self render: ({$a. Character value: 4. $b} as: String) equals: '"a\u0004b"'.! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | index start | aStream nextPut: $". start := 1. [ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [ aStream next: index - start putAll: self startingAt: start. aStream nextPutAll: (Json escapeForCharacter: (self at: index)). start := index + 1 ]. start <= self size ifTrue: [ aStream next: self size + 1 - start putAll: self startingAt: start ]. aStream nextPut: $". ! Object subclass: #Json instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray escapeSet'! !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0! I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries. The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects. Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct. Instance Variables stream: <PositionableStream> currentCharacter: <Character> arrayBufferStream: <WriteStream> stringBufferStream: <ReadWriteStream> numberParser: <ExtendedNumberParser> ctorMap: <Dictionary> For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream. arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one. stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this. numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it. ctorMap is the Dictionary holding the constructor classes by name. arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time. For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:. ! Json class instanceVariableNames: 'escapeArray escapeSet'! ----- Method: Json class>>escapeForCharacter: (in category 'accessing') ----- escapeForCharacter: c | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^nil! ----- Method: Json class>>escapeSet (in category 'accessing') ----- escapeSet ^escapeSet! ----- Method: Json class>>initialize (in category 'class initialization') ----- initialize "Json initialize." | newEscapeArray newEscapeSet | newEscapeArray := Array new: 128. newEscapeSet := CharacterSet new. (0 to: 31), #(127) do: [ :each | newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0). newEscapeSet add: (Character value: each) ]. { $" -> '\"'. $\ -> '\\'. $/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>." Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | newEscapeArray at: each key asciiValue + 1 put: each value. newEscapeSet add: each key ]. escapeArray := newEscapeArray. escapeSet := newEscapeSet! ----- Method: Json class>>mimeType (in category 'accessing') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'instance creation') ----- 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>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'rendering') ----- render: anObject ^String streamContents: [ :stream | anObject jsonWriteOn: stream ]! ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') ----- 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>>arrayBufferStream (in category 'private') ----- arrayBufferStream ^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]! ----- Method: Json>>consume: (in category 'private') ----- consume: aString | message | 1 to: aString size do: [ :index | (currentCharacter := stream next) == (aString at: index) ifFalse: [ message := 'Expected ', (aString at: index) printString. currentCharacter ifNil: [ self incomplete: message ] ifNotNil: [ self invalid: message ] ] ]. currentCharacter := stream next! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap := m! ----- Method: Json>>error: (in category 'error handling') ----- error: aString (currentCharacter isNil and: [ stream atEnd ]) ifTrue: [ self incomplete: aString ] ifFalse: [ self invalid: aString ]! ----- Method: Json>>incomplete: (in category 'error handling') ----- incomplete: aString JsonIncompleteError signal: aString! ----- Method: Json>>interpretStringEscape: (in category 'private') ----- interpretStringEscape: aCharacter aCharacter == $b ifTrue: [ ^Character backspace ]. aCharacter == $n ifTrue: [ ^Character lf ]. aCharacter == $f ifTrue: [ ^Character newPage ]. aCharacter == $r ifTrue: [ ^Character cr ]. aCharacter == $t ifTrue: [ ^Character tab ]. aCharacter == $u ifTrue: [ ^self unescapeUnicode ]. aCharacter == $" ifTrue: [ ^aCharacter ]. aCharacter == $\ ifTrue: [ ^aCharacter ]. aCharacter == $/ ifTrue: [ ^aCharacter ]. self error: 'Unexpected escaped character: ', aCharacter asString ! ----- Method: Json>>invalid: (in category 'error handling') ----- invalid: aString JsonInvalidError signal: aString! ----- Method: Json>>readAny (in category 'private') ----- readAny self skipWhitespace. currentCharacter == ${ ifTrue: [ ^self readDictionary ]. currentCharacter == $[ ifTrue: [ ^self readArray ]. currentCharacter == $" ifTrue: [ ^self readString ]. currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ]. currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ]. currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ]. currentCharacter == $- ifTrue: [ ^self readNumber: true ]. (#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [ ^self readNumber: false ]. currentCharacter == $@ ifTrue: [ ^self readConstructor ]. self invalid: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | initialPosition | currentCharacter := stream next. self skipWhitespace. currentCharacter == $] ifTrue: [ currentCharacter := stream next. ^#() ]. initialPosition := self arrayBufferStream position. [ arrayBufferStream nextPut: self readAny. self skipWhitespace. currentCharacter == $] ifTrue: [ | result | result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position. arrayBufferStream position: initialPosition. currentCharacter := stream next. ^result ]. currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ]. currentCharacter := stream next ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor ctorMap ifNil: [ ^self error: 'No constructors were declared.' ]. self resetStringBufferStream. [ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [ stringBufferStream nextPut: currentCharacter ]. (ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor | ^constructor constructFromJson: self readAny ]. self error: 'Unknown constructor: ', stringBufferStream contents! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | result key commaNeeded | result := JsonObject new. commaNeeded := false. currentCharacter := stream next. [ self skipWhitespace. currentCharacter == $} ifTrue: [ currentCharacter := stream next. ^result ]. commaNeeded ifFalse: [ commaNeeded := true ] ifTrue: [ currentCharacter == $, ifFalse: [ self error: 'Missing comma' ]. currentCharacter := stream next. self skipWhitespace ]. currentCharacter == $" ifFalse: [ self error: 'Key in dictionary must be string' ]. key := self readString. self skipWhitespace. currentCharacter == $: ifFalse: [ self error: 'Missing colon' ]. currentCharacter := stream next. result at: key put: self readAny ] repeat. ! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream | result | stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next. result := self readAny. stream atEnd ifFalse: [ stream skip: -1 ]. "Undo prereading." ^result! ----- Method: Json>>readNumber: (in category 'private') ----- readNumber: negative | result | negative ifFalse: [ stream skip: -1 ]. result := (numberParser ifNil: [ numberParser := JsonNumberParser new on: stream; failBlock: [ self error: 'Invalid number.' ]; yourself ]) nextNumber: negative. currentCharacter := stream next. ^result ! ----- Method: Json>>readString (in category 'private') ----- readString self resetStringBufferStream. [ currentCharacter := stream next ifNil: [self incomplete: 'Unexpected end of string' ]. currentCharacter == $" ifTrue: [ currentCharacter := stream next. ^stringBufferStream contents ]. currentCharacter == $\ ifTrue: [ stringBufferStream nextPut: (self interpretStringEscape: (stream next ifNil: [ self incomplete: 'Unexpected end of string' ])) ] ifFalse: [ stringBufferStream nextPut: currentCharacter ] ] repeat! ----- Method: Json>>resetStringBufferStream (in category 'private') ----- resetStringBufferStream stringBufferStream ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ] ifNotNil: [ stringBufferStream resetToStart ]! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace currentCharacter ifNil: [ self incomplete: 'Input stream is empty' ]. [ currentCharacter isSeparator ] whileTrue: [ currentCharacter := stream next ifNil: [ self incomplete: 'Input stream is empty' ]. ]! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'private') ----- stream: aStream "For testing purposes only" stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode | code digitValue | code := 0. 1 to: 4 do: [ :index | (digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [ self invalid: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ code := code * 16 + digitValue ] ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ]. ^Character value: code! 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 ]!

1 0

The Trunk: JSON-ul.48.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.48.mcz ==================== Summary ==================== Name: JSON-ul.48 Author: ul Time: 16 July 2018, 4:00:43.631343 pm UUID: 0f8f75fe-fa5f-4326-9ff3-c308d74c77e8 Ancestors: JSON-ul.47 JsonObject & OrderedJsonObject - #at:put: verifies that the key is a String - make #at:put: return self instead of the value stored. This allows one to omit the #yourself send when an object is scripted, which sometimes happens and results in hard to debug issues. - allow one to change the default dictionary class before parsing via Json >> #dictionaryClass:. This makes OrderedJsonObject more useful. - updated the tests and categorized the test methods ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- 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'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! OrderedDictionary subclass: #OrderedJsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: OrderedJsonObject 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: OrderedJsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: OrderedJsonObject>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ----- Method: OrderedJsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: OrderedJsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: Time>>jsonWriteOn: (in category '*JSON') ----- jsonWriteOn: stream stream nextPut: $". self print24: true showSeconds: true on: stream. stream 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: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: 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>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: JsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^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: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! NumberParser subclass: #JsonNumberParser instanceVariableNames: 'fraction' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') ----- allowPlusSign ^false! ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') ----- allowPlusSignInExponent ^true! ----- Method: JsonNumberParser>>error: (in category 'error') ----- error: aString JsonSyntaxError signal: aString! ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') ----- exponentLetters ^'eE'! ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') ----- initialize super initialize. base := 10. fraction := Fraction numerator: 0 denominator: 1! ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') ----- makeFloatFromMantissa: mantissa exponent: exponent exponent = 0 ifTrue: [ ^mantissa asFloat ]. exponent >= 16 ifTrue: [ ^(mantissa * (self tenRaisedTo: exponent)) asFloat ]. (exponent >= -15 and: [ mantissa highBitOfMagnitude <= 54 ]) ifTrue: [ exponent >= 1 ifTrue: [ ^mantissa asFloat * (self tenRaisedTo: exponent) asFloat ]. ^mantissa asFloat / (self tenRaisedTo: exponent negated) asFloat ]. ^(fraction setNumerator: mantissa denominator: (self tenRaisedTo: exponent negated)) asFloat! ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') ----- nextElementaryLargeInteger "Form an unsigned integer with incoming digits from sourceStream. Return this integer, or zero if no digits found. Stop reading if end of digits or if a LargeInteger is formed. Count the number of digits and the position of lastNonZero digit and store them in instVar." | digit value | value := 0. nDigits := 0. lastNonZero := 0. [ value isLarge ifTrue: [ ^value ]. ((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 or: [ digit >= 10 ]) ifTrue: [ sourceStream skip: -1. ^value ]. nDigits := nDigits + 1. digit = 0 ifFalse: [ lastNonZero := nDigits. value := value * 10 + digit ] ifTrue: [ value := value * 10 ] ] repeat! ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') ----- nextNumber: negative | numberOfTrailingZeroInIntegerPart numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value | integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $.) ifFalse: [ "No fraction part" negative ifTrue: [ integerPart := integerPart negated ]. self readExponent ifFalse: [ ^integerPart ]. exponent > 0 ifTrue: [ ^integerPart * (self tenRaisedTo: exponent) ]. ^(Fraction numerator: integerPart denominator: (self tenRaisedTo: exponent negated)) asFloat ]. fractionPart := self nextUnsignedIntegerOrNil ifNil: [ self error: 'Missing fraction part!!' ]. fractionPart isZero ifTrue: [ self readExponent ifFalse: [ negative ifTrue: [ integerPart isZero ifTrue: [ ^Float negativeZero ]. ^integerPart negated ]. ^integerPart ]. exponent >= 0 ifTrue: [ negative ifTrue: [ integerPart := integerPart negated ]. ^integerPart * (self tenRaisedTo: exponent) ]. value := self makeFloatFromMantissa: integerPart exponent: exponent. negative ifTrue: [ ^value negated ]. ^value ]. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. numberOfNonZeroFractionDigits := lastNonZero. self readExponent. exponent := exponent - numberOfNonZeroFractionDigits. mantissa := integerPart * (self tenRaisedTo: numberOfNonZeroFractionDigits) + (fractionPart // (self tenRaisedTo: numberOfTrailingZeroInFractionPart)). value := self makeFloatFromMantissa: mantissa exponent: exponent. negative ifTrue: [ ^value negated ]. ^value! ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') ----- nextUnsignedIntegerOrNil "Form an unsigned integer with incoming digits from sourceStream. Answer this integer, or nil if no digit found. Count the number of digits and the position of lastNonZero digit and store them in instVar" | nPackets high nDigitsHigh lastNonZeroHigh low | "read no more digits than one elementary LargeInteger" high := self nextElementaryLargeInteger. nDigits = 0 ifTrue: [^nil]. "Not enough digits to form a LargeInteger, stop iteration" high isLarge ifFalse: [^high]. "We now have to engage arithmetic with LargeInteger Decompose the integer in a high and low packets of growing size:" nPackets := 1. nDigitsHigh := nDigits. lastNonZeroHigh := lastNonZero. [ low := self nextLargeIntegerBase: 10 nPackets: nPackets . high := high * (self tenRaisedTo: nDigits) + low. lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh]. nDigitsHigh := nDigitsHigh + nDigits. low isLarge] whileTrue: [nPackets := nPackets * 2]. nDigits := nDigitsHigh. lastNonZero := lastNonZeroHigh. ^high! ----- Method: JsonNumberParser>>tenRaisedTo: (in category 'parsing-private') ----- tenRaisedTo: anInteger anInteger >= 0 ifFalse: [ ^10 raisedToInteger: anInteger ]. anInteger >= 16 ifTrue: [ ^10 raisedToInteger: anInteger ]. ^#(1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000 10000000000 100000000000 1000000000000 10000000000000 100000000000000 1000000000000000) at: anInteger + 1! ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: stream self printOn: stream showingDecimalPlaces: scale! ----- 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: $]! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>assertIncompleteJson: (in category 'helpers') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'helpers') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- Method: JsonTests>>json:equals: (in category 'helpers') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'helpers') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'helpers') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'helpers') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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>>testDictionaryClass (in category 'tests') ----- testDictionaryClass | parser | parser := Json new. self assert: (parser readFrom: '{}' readStream) class == JsonObject. parser dictionaryClass: OrderedJsonObject. self assert: (parser readFrom: '{}' readStream) class == OrderedJsonObject. self assert: (parser readFrom: '{"x":{"y":{}}}' readStream) x y class == OrderedJsonObject! ----- Method: JsonTests>>testIncomplete (in category 'tests') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'tests') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'tests') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testJsonObjectAtPutReturnsTheObject (in category 'tests') ----- testJsonObjectAtPutReturnsTheObject { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self assert: (json at: 'foo' put: 1) == json. self assert: (json foo: 1) == json ]! ----- Method: JsonTests>>testMissingCtor (in category 'tests') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'tests') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testNonStringKeysRaiseError (in category 'tests') ----- testNonStringKeysRaiseError { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self should: [ json at: 1 put: 1 ] raise: Error. self assert: json isEmpty. json at: '1' put: 1. self assert: 1 equals: (json at: '1') ]! ----- Method: JsonTests>>testStreaming (in category 'tests') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: JsonObject new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'tests') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- Method: JsonTests>>testWriteAssociation (in category 'tests') ----- 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 'tests') ----- 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: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | index start | aStream nextPut: $". start := 1. [ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [ aStream next: index - start putAll: self startingAt: start. aStream nextPutAll: (Json escapeForCharacter: (self at: index)). start := index + 1 ]. start <= self size ifTrue: [ aStream next: self size + 1 - start putAll: self startingAt: start ]. aStream nextPut: $". ! Object subclass: #Json instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap dictionaryClass' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray escapeSet'! !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0! I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries. The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects. Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct. Instance Variables stream: <PositionableStream> currentCharacter: <Character> arrayBufferStream: <WriteStream> stringBufferStream: <ReadWriteStream> numberParser: <ExtendedNumberParser> ctorMap: <Dictionary> For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream. arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one. stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this. numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it. ctorMap is the Dictionary holding the constructor classes by name. arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time. For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:. ! Json class instanceVariableNames: 'escapeArray escapeSet'! ----- Method: Json class>>escapeForCharacter: (in category 'accessing') ----- escapeForCharacter: c | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^nil! ----- Method: Json class>>escapeSet (in category 'accessing') ----- escapeSet ^escapeSet! ----- Method: Json class>>initialize (in category 'class initialization') ----- initialize "Json initialize." | newEscapeArray newEscapeSet | newEscapeArray := Array new: 128. newEscapeSet := CharacterSet new. (0 to: 31), #(127) do: [ :each | newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0). newEscapeSet add: (Character value: each) ]. { $" -> '\"'. $\ -> '\\'. $/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>." Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | newEscapeArray at: each key asciiValue + 1 put: each value. newEscapeSet add: each key ]. escapeArray := newEscapeArray. escapeSet := newEscapeSet! ----- Method: Json class>>mimeType (in category 'accessing') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'instance creation') ----- 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>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'rendering') ----- render: anObject ^String streamContents: [ :stream | anObject jsonWriteOn: stream ]! ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') ----- 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>>arrayBufferStream (in category 'private') ----- arrayBufferStream ^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]! ----- Method: Json>>consume: (in category 'private') ----- consume: aString | message | 1 to: aString size do: [ :index | (currentCharacter := stream next) == (aString at: index) ifFalse: [ message := 'Expected ', (aString at: index) printString. currentCharacter ifNil: [ self incomplete: message ] ifNotNil: [ self invalid: message ] ] ]. currentCharacter := stream next! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap := m! ----- Method: Json>>dictionaryClass: (in category 'accessing') ----- dictionaryClass: aClass "This method allows you to override the default dictionary class to be created while parsing a stream. Instances of aClass are expected to understand #at:put:." dictionaryClass := aClass! ----- Method: Json>>error: (in category 'error handling') ----- error: aString (currentCharacter isNil and: [ stream atEnd ]) ifTrue: [ self incomplete: aString ] ifFalse: [ self invalid: aString ]! ----- Method: Json>>incomplete: (in category 'error handling') ----- incomplete: aString JsonIncompleteError signal: aString! ----- Method: Json>>initialize (in category 'initialize-release') ----- initialize dictionaryClass := JsonObject ! ----- Method: Json>>interpretStringEscape: (in category 'private') ----- interpretStringEscape: aCharacter aCharacter == $b ifTrue: [ ^Character backspace ]. aCharacter == $n ifTrue: [ ^Character lf ]. aCharacter == $f ifTrue: [ ^Character newPage ]. aCharacter == $r ifTrue: [ ^Character cr ]. aCharacter == $t ifTrue: [ ^Character tab ]. aCharacter == $u ifTrue: [ ^self unescapeUnicode ]. aCharacter == $" ifTrue: [ ^aCharacter ]. aCharacter == $\ ifTrue: [ ^aCharacter ]. aCharacter == $/ ifTrue: [ ^aCharacter ]. self error: 'Unexpected escaped character: ', aCharacter asString ! ----- Method: Json>>invalid: (in category 'error handling') ----- invalid: aString JsonInvalidError signal: aString! ----- Method: Json>>readAny (in category 'private') ----- readAny self skipWhitespace. currentCharacter == ${ ifTrue: [ ^self readDictionary ]. currentCharacter == $[ ifTrue: [ ^self readArray ]. currentCharacter == $" ifTrue: [ ^self readString ]. currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ]. currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ]. currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ]. currentCharacter == $- ifTrue: [ ^self readNumber: true ]. (#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [ ^self readNumber: false ]. currentCharacter == $@ ifTrue: [ ^self readConstructor ]. self invalid: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | initialPosition | currentCharacter := stream next. self skipWhitespace. currentCharacter == $] ifTrue: [ currentCharacter := stream next. ^#() ]. initialPosition := self arrayBufferStream position. [ arrayBufferStream nextPut: self readAny. self skipWhitespace. currentCharacter == $] ifTrue: [ | result | result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position. arrayBufferStream position: initialPosition. currentCharacter := stream next. ^result ]. currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ]. currentCharacter := stream next ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor ctorMap ifNil: [ ^self error: 'No constructors were declared.' ]. self resetStringBufferStream. [ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [ stringBufferStream nextPut: currentCharacter ]. (ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor | ^constructor constructFromJson: self readAny ]. self error: 'Unknown constructor: ', stringBufferStream contents! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | result key commaNeeded | result := dictionaryClass new. commaNeeded := false. currentCharacter := stream next. [ self skipWhitespace. currentCharacter == $} ifTrue: [ currentCharacter := stream next. ^result ]. commaNeeded ifFalse: [ commaNeeded := true ] ifTrue: [ currentCharacter == $, ifFalse: [ self error: 'Missing comma' ]. currentCharacter := stream next. self skipWhitespace ]. currentCharacter == $" ifFalse: [ self error: 'Key in dictionary must be string' ]. key := self readString. self skipWhitespace. currentCharacter == $: ifFalse: [ self error: 'Missing colon' ]. currentCharacter := stream next. result at: key put: self readAny ] repeat! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream | result | stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next. result := self readAny. stream atEnd ifFalse: [ stream skip: -1 ]. "Undo prereading." ^result! ----- Method: Json>>readNumber: (in category 'private') ----- readNumber: negative | result | negative ifFalse: [ stream skip: -1 ]. result := (numberParser ifNil: [ numberParser := JsonNumberParser new on: stream; failBlock: [ self error: 'Invalid number.' ]; yourself ]) nextNumber: negative. currentCharacter := stream next. ^result ! ----- Method: Json>>readString (in category 'private') ----- readString self resetStringBufferStream. [ currentCharacter := stream next ifNil: [self incomplete: 'Unexpected end of string' ]. currentCharacter == $" ifTrue: [ currentCharacter := stream next. ^stringBufferStream contents ]. currentCharacter == $\ ifTrue: [ stringBufferStream nextPut: (self interpretStringEscape: (stream next ifNil: [ self incomplete: 'Unexpected end of string' ])) ] ifFalse: [ stringBufferStream nextPut: currentCharacter ] ] repeat! ----- Method: Json>>resetStringBufferStream (in category 'private') ----- resetStringBufferStream stringBufferStream ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ] ifNotNil: [ stringBufferStream resetToStart ]! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace currentCharacter ifNil: [ self incomplete: 'Input stream is empty' ]. [ currentCharacter isSeparator ] whileTrue: [ currentCharacter := stream next ifNil: [ self incomplete: 'Input stream is empty' ]. ]! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'private') ----- stream: aStream "For testing purposes only" stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode | code digitValue | code := 0. 1 to: 4 do: [ :index | (digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [ self invalid: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ code := code * 16 + digitValue ] ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ]. ^Character value: code! 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 ]!

1 0

The Trunk: JSON-klub.49.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-klub.49.mcz ==================== Summary ==================== Name: JSON-klub.49 Author: klub Time: 8 November 2018, 1:54:36.404002 pm UUID: 3fd83ffb-e4b6-4e55-82ac-f7a526bf2601 Ancestors: JSON-ul.48 - added convenience methods #parseAsJson and #parseAsOrderedJson to String to make it easier to parse a String ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- 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'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! OrderedDictionary subclass: #OrderedJsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: OrderedJsonObject 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: OrderedJsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: OrderedJsonObject>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ----- Method: OrderedJsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: OrderedJsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: Time>>jsonWriteOn: (in category '*JSON') ----- jsonWriteOn: stream stream nextPut: $". self print24: true showSeconds: true on: stream. stream 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: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: 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>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: JsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^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: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! NumberParser subclass: #JsonNumberParser instanceVariableNames: 'fraction' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') ----- allowPlusSign ^false! ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') ----- allowPlusSignInExponent ^true! ----- Method: JsonNumberParser>>error: (in category 'error') ----- error: aString JsonSyntaxError signal: aString! ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') ----- exponentLetters ^'eE'! ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') ----- initialize super initialize. base := 10. fraction := Fraction numerator: 0 denominator: 1! ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') ----- makeFloatFromMantissa: mantissa exponent: exponent exponent = 0 ifTrue: [ ^mantissa asFloat ]. exponent >= 16 ifTrue: [ ^(mantissa * (self tenRaisedTo: exponent)) asFloat ]. (exponent >= -15 and: [ mantissa highBitOfMagnitude <= 54 ]) ifTrue: [ exponent >= 1 ifTrue: [ ^mantissa asFloat * (self tenRaisedTo: exponent) asFloat ]. ^mantissa asFloat / (self tenRaisedTo: exponent negated) asFloat ]. ^(fraction setNumerator: mantissa denominator: (self tenRaisedTo: exponent negated)) asFloat! ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') ----- nextElementaryLargeInteger "Form an unsigned integer with incoming digits from sourceStream. Return this integer, or zero if no digits found. Stop reading if end of digits or if a LargeInteger is formed. Count the number of digits and the position of lastNonZero digit and store them in instVar." | digit value | value := 0. nDigits := 0. lastNonZero := 0. [ value isLarge ifTrue: [ ^value ]. ((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 or: [ digit >= 10 ]) ifTrue: [ sourceStream skip: -1. ^value ]. nDigits := nDigits + 1. digit = 0 ifFalse: [ lastNonZero := nDigits. value := value * 10 + digit ] ifTrue: [ value := value * 10 ] ] repeat! ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') ----- nextNumber: negative | numberOfTrailingZeroInIntegerPart numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value | integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $.) ifFalse: [ "No fraction part" negative ifTrue: [ integerPart := integerPart negated ]. self readExponent ifFalse: [ ^integerPart ]. exponent > 0 ifTrue: [ ^integerPart * (self tenRaisedTo: exponent) ]. ^(Fraction numerator: integerPart denominator: (self tenRaisedTo: exponent negated)) asFloat ]. fractionPart := self nextUnsignedIntegerOrNil ifNil: [ self error: 'Missing fraction part!!' ]. fractionPart isZero ifTrue: [ self readExponent ifFalse: [ negative ifTrue: [ integerPart isZero ifTrue: [ ^Float negativeZero ]. ^integerPart negated ]. ^integerPart ]. exponent >= 0 ifTrue: [ negative ifTrue: [ integerPart := integerPart negated ]. ^integerPart * (self tenRaisedTo: exponent) ]. value := self makeFloatFromMantissa: integerPart exponent: exponent. negative ifTrue: [ ^value negated ]. ^value ]. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. numberOfNonZeroFractionDigits := lastNonZero. self readExponent. exponent := exponent - numberOfNonZeroFractionDigits. mantissa := integerPart * (self tenRaisedTo: numberOfNonZeroFractionDigits) + (fractionPart // (self tenRaisedTo: numberOfTrailingZeroInFractionPart)). value := self makeFloatFromMantissa: mantissa exponent: exponent. negative ifTrue: [ ^value negated ]. ^value! ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') ----- nextUnsignedIntegerOrNil "Form an unsigned integer with incoming digits from sourceStream. Answer this integer, or nil if no digit found. Count the number of digits and the position of lastNonZero digit and store them in instVar" | nPackets high nDigitsHigh lastNonZeroHigh low | "read no more digits than one elementary LargeInteger" high := self nextElementaryLargeInteger. nDigits = 0 ifTrue: [^nil]. "Not enough digits to form a LargeInteger, stop iteration" high isLarge ifFalse: [^high]. "We now have to engage arithmetic with LargeInteger Decompose the integer in a high and low packets of growing size:" nPackets := 1. nDigitsHigh := nDigits. lastNonZeroHigh := lastNonZero. [ low := self nextLargeIntegerBase: 10 nPackets: nPackets . high := high * (self tenRaisedTo: nDigits) + low. lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh]. nDigitsHigh := nDigitsHigh + nDigits. low isLarge] whileTrue: [nPackets := nPackets * 2]. nDigits := nDigitsHigh. lastNonZero := lastNonZeroHigh. ^high! ----- Method: JsonNumberParser>>tenRaisedTo: (in category 'parsing-private') ----- tenRaisedTo: anInteger anInteger >= 0 ifFalse: [ ^10 raisedToInteger: anInteger ]. anInteger >= 16 ifTrue: [ ^10 raisedToInteger: anInteger ]. ^#(1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000 10000000000 100000000000 1000000000000 10000000000000 100000000000000 1000000000000000) at: anInteger + 1! ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: stream self printOn: stream showingDecimalPlaces: scale! ----- 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: $]! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>assertIncompleteJson: (in category 'helpers') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'helpers') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- Method: JsonTests>>json:equals: (in category 'helpers') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'helpers') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'helpers') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'helpers') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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>>testDictionaryClass (in category 'tests') ----- testDictionaryClass | parser | parser := Json new. self assert: (parser readFrom: '{}' readStream) class == JsonObject. parser dictionaryClass: OrderedJsonObject. self assert: (parser readFrom: '{}' readStream) class == OrderedJsonObject. self assert: (parser readFrom: '{"x":{"y":{}}}' readStream) x y class == OrderedJsonObject! ----- Method: JsonTests>>testIncomplete (in category 'tests') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'tests') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'tests') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testJsonObjectAtPutReturnsTheObject (in category 'tests') ----- testJsonObjectAtPutReturnsTheObject { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self assert: (json at: 'foo' put: 1) == json. self assert: (json foo: 1) == json ]! ----- Method: JsonTests>>testMissingCtor (in category 'tests') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'tests') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testNonStringKeysRaiseError (in category 'tests') ----- testNonStringKeysRaiseError { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self should: [ json at: 1 put: 1 ] raise: Error. self assert: json isEmpty. json at: '1' put: 1. self assert: 1 equals: (json at: '1') ]! ----- Method: JsonTests>>testStreaming (in category 'tests') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: JsonObject new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'tests') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- Method: JsonTests>>testWriteAssociation (in category 'tests') ----- 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 'tests') ----- 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: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | index start | aStream nextPut: $". start := 1. [ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [ aStream next: index - start putAll: self startingAt: start. aStream nextPutAll: (Json escapeForCharacter: (self at: index)). start := index + 1 ]. start <= self size ifTrue: [ aStream next: self size + 1 - start putAll: self startingAt: start ]. aStream nextPut: $". ! ----- Method: String>>parseAsJson (in category '*JSON') ----- parseAsJson "Convenience" ^Json readFrom: self readStream! ----- Method: String>>parseAsOrderedJson (in category '*JSON') ----- parseAsOrderedJson "Convenience" ^Json new dictionaryClass: OrderedJsonObject; readFrom: self readStream! Object subclass: #Json instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap dictionaryClass' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray escapeSet'! !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0! I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries. The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects. Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct. Instance Variables stream: <PositionableStream> currentCharacter: <Character> arrayBufferStream: <WriteStream> stringBufferStream: <ReadWriteStream> numberParser: <ExtendedNumberParser> ctorMap: <Dictionary> For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream. arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one. stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this. numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it. ctorMap is the Dictionary holding the constructor classes by name. arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time. For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:. ! Json class instanceVariableNames: 'escapeArray escapeSet'! ----- Method: Json class>>escapeForCharacter: (in category 'accessing') ----- escapeForCharacter: c | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^nil! ----- Method: Json class>>escapeSet (in category 'accessing') ----- escapeSet ^escapeSet! ----- Method: Json class>>initialize (in category 'class initialization') ----- initialize "Json initialize." | newEscapeArray newEscapeSet | newEscapeArray := Array new: 128. newEscapeSet := CharacterSet new. (0 to: 31), #(127) do: [ :each | newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0). newEscapeSet add: (Character value: each) ]. { $" -> '\"'. $\ -> '\\'. $/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>." Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | newEscapeArray at: each key asciiValue + 1 put: each value. newEscapeSet add: each key ]. escapeArray := newEscapeArray. escapeSet := newEscapeSet! ----- Method: Json class>>mimeType (in category 'accessing') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'instance creation') ----- 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>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'rendering') ----- render: anObject ^String streamContents: [ :stream | anObject jsonWriteOn: stream ]! ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') ----- 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>>arrayBufferStream (in category 'private') ----- arrayBufferStream ^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]! ----- Method: Json>>consume: (in category 'private') ----- consume: aString | message | 1 to: aString size do: [ :index | (currentCharacter := stream next) == (aString at: index) ifFalse: [ message := 'Expected ', (aString at: index) printString. currentCharacter ifNil: [ self incomplete: message ] ifNotNil: [ self invalid: message ] ] ]. currentCharacter := stream next! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap := m! ----- Method: Json>>dictionaryClass: (in category 'accessing') ----- dictionaryClass: aClass "This method allows you to override the default dictionary class to be created while parsing a stream. Instances of aClass are expected to understand #at:put:." dictionaryClass := aClass! ----- Method: Json>>error: (in category 'error handling') ----- error: aString (currentCharacter isNil and: [ stream atEnd ]) ifTrue: [ self incomplete: aString ] ifFalse: [ self invalid: aString ]! ----- Method: Json>>incomplete: (in category 'error handling') ----- incomplete: aString JsonIncompleteError signal: aString! ----- Method: Json>>initialize (in category 'initialize-release') ----- initialize dictionaryClass := JsonObject ! ----- Method: Json>>interpretStringEscape: (in category 'private') ----- interpretStringEscape: aCharacter aCharacter == $b ifTrue: [ ^Character backspace ]. aCharacter == $n ifTrue: [ ^Character lf ]. aCharacter == $f ifTrue: [ ^Character newPage ]. aCharacter == $r ifTrue: [ ^Character cr ]. aCharacter == $t ifTrue: [ ^Character tab ]. aCharacter == $u ifTrue: [ ^self unescapeUnicode ]. aCharacter == $" ifTrue: [ ^aCharacter ]. aCharacter == $\ ifTrue: [ ^aCharacter ]. aCharacter == $/ ifTrue: [ ^aCharacter ]. self error: 'Unexpected escaped character: ', aCharacter asString ! ----- Method: Json>>invalid: (in category 'error handling') ----- invalid: aString JsonInvalidError signal: aString! ----- Method: Json>>readAny (in category 'private') ----- readAny self skipWhitespace. currentCharacter == ${ ifTrue: [ ^self readDictionary ]. currentCharacter == $[ ifTrue: [ ^self readArray ]. currentCharacter == $" ifTrue: [ ^self readString ]. currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ]. currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ]. currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ]. currentCharacter == $- ifTrue: [ ^self readNumber: true ]. (#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [ ^self readNumber: false ]. currentCharacter == $@ ifTrue: [ ^self readConstructor ]. self invalid: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | initialPosition | currentCharacter := stream next. self skipWhitespace. currentCharacter == $] ifTrue: [ currentCharacter := stream next. ^#() ]. initialPosition := self arrayBufferStream position. [ arrayBufferStream nextPut: self readAny. self skipWhitespace. currentCharacter == $] ifTrue: [ | result | result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position. arrayBufferStream position: initialPosition. currentCharacter := stream next. ^result ]. currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ]. currentCharacter := stream next ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor ctorMap ifNil: [ ^self error: 'No constructors were declared.' ]. self resetStringBufferStream. [ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [ stringBufferStream nextPut: currentCharacter ]. (ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor | ^constructor constructFromJson: self readAny ]. self error: 'Unknown constructor: ', stringBufferStream contents! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | result key commaNeeded | result := dictionaryClass new. commaNeeded := false. currentCharacter := stream next. [ self skipWhitespace. currentCharacter == $} ifTrue: [ currentCharacter := stream next. ^result ]. commaNeeded ifFalse: [ commaNeeded := true ] ifTrue: [ currentCharacter == $, ifFalse: [ self error: 'Missing comma' ]. currentCharacter := stream next. self skipWhitespace ]. currentCharacter == $" ifFalse: [ self error: 'Key in dictionary must be string' ]. key := self readString. self skipWhitespace. currentCharacter == $: ifFalse: [ self error: 'Missing colon' ]. currentCharacter := stream next. result at: key put: self readAny ] repeat! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream | result | stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next. result := self readAny. stream atEnd ifFalse: [ stream skip: -1 ]. "Undo prereading." ^result! ----- Method: Json>>readNumber: (in category 'private') ----- readNumber: negative | result | negative ifFalse: [ stream skip: -1 ]. result := (numberParser ifNil: [ numberParser := JsonNumberParser new on: stream; failBlock: [ self error: 'Invalid number.' ]; yourself ]) nextNumber: negative. currentCharacter := stream next. ^result ! ----- Method: Json>>readString (in category 'private') ----- readString self resetStringBufferStream. [ currentCharacter := stream next ifNil: [self incomplete: 'Unexpected end of string' ]. currentCharacter == $" ifTrue: [ currentCharacter := stream next. ^stringBufferStream contents ]. currentCharacter == $\ ifTrue: [ stringBufferStream nextPut: (self interpretStringEscape: (stream next ifNil: [ self incomplete: 'Unexpected end of string' ])) ] ifFalse: [ stringBufferStream nextPut: currentCharacter ] ] repeat! ----- Method: Json>>resetStringBufferStream (in category 'private') ----- resetStringBufferStream stringBufferStream ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ] ifNotNil: [ stringBufferStream resetToStart ]! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace currentCharacter ifNil: [ self incomplete: 'Input stream is empty' ]. [ currentCharacter isSeparator ] whileTrue: [ currentCharacter := stream next ifNil: [ self incomplete: 'Input stream is empty' ]. ]! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'private') ----- stream: aStream "For testing purposes only" stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode | code digitValue | code := 0. 1 to: 4 do: [ :index | (digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [ self invalid: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ code := code * 16 + digitValue ] ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ]. ^Character value: code! 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 ]!

1 0

The Trunk: JSON-klub.50.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-klub.50.mcz ==================== Summary ==================== Name: JSON-klub.50 Author: klub Time: 24 April 2019, 11:02:02.046155 am UUID: 7a41cfff-0f5a-4997-b10f-98d63ee967b4 Ancestors: JSON-klub.49 - Added SerializedJson and String >> #asSerializedJson which can be used to build and serialize json objects with parts that have already been serialized. ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- 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'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! OrderedDictionary subclass: #OrderedJsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: OrderedJsonObject 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: OrderedJsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: OrderedJsonObject>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ----- Method: OrderedJsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: OrderedJsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: Time>>jsonWriteOn: (in category '*JSON') ----- jsonWriteOn: stream stream nextPut: $". self print24: true showSeconds: true on: stream. stream 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: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: 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>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: JsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^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: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! NumberParser subclass: #JsonNumberParser instanceVariableNames: 'fraction' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') ----- allowPlusSign ^false! ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') ----- allowPlusSignInExponent ^true! ----- Method: JsonNumberParser>>error: (in category 'error') ----- error: aString JsonSyntaxError signal: aString! ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') ----- exponentLetters ^'eE'! ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') ----- initialize super initialize. base := 10. fraction := Fraction numerator: 0 denominator: 1! ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') ----- makeFloatFromMantissa: mantissa exponent: exponent exponent = 0 ifTrue: [ ^mantissa asFloat ]. exponent >= 16 ifTrue: [ ^(mantissa * (self tenRaisedTo: exponent)) asFloat ]. (exponent >= -15 and: [ mantissa highBitOfMagnitude <= 54 ]) ifTrue: [ exponent >= 1 ifTrue: [ ^mantissa asFloat * (self tenRaisedTo: exponent) asFloat ]. ^mantissa asFloat / (self tenRaisedTo: exponent negated) asFloat ]. ^(fraction setNumerator: mantissa denominator: (self tenRaisedTo: exponent negated)) asFloat! ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') ----- nextElementaryLargeInteger "Form an unsigned integer with incoming digits from sourceStream. Return this integer, or zero if no digits found. Stop reading if end of digits or if a LargeInteger is formed. Count the number of digits and the position of lastNonZero digit and store them in instVar." | digit value | value := 0. nDigits := 0. lastNonZero := 0. [ value isLarge ifTrue: [ ^value ]. ((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 or: [ digit >= 10 ]) ifTrue: [ sourceStream skip: -1. ^value ]. nDigits := nDigits + 1. digit = 0 ifFalse: [ lastNonZero := nDigits. value := value * 10 + digit ] ifTrue: [ value := value * 10 ] ] repeat! ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') ----- nextNumber: negative | numberOfTrailingZeroInIntegerPart numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value | integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $.) ifFalse: [ "No fraction part" negative ifTrue: [ integerPart := integerPart negated ]. self readExponent ifFalse: [ ^integerPart ]. exponent > 0 ifTrue: [ ^integerPart * (self tenRaisedTo: exponent) ]. ^(Fraction numerator: integerPart denominator: (self tenRaisedTo: exponent negated)) asFloat ]. fractionPart := self nextUnsignedIntegerOrNil ifNil: [ self error: 'Missing fraction part!!' ]. fractionPart isZero ifTrue: [ self readExponent ifFalse: [ negative ifTrue: [ integerPart isZero ifTrue: [ ^Float negativeZero ]. ^integerPart negated ]. ^integerPart ]. exponent >= 0 ifTrue: [ negative ifTrue: [ integerPart := integerPart negated ]. ^integerPart * (self tenRaisedTo: exponent) ]. value := self makeFloatFromMantissa: integerPart exponent: exponent. negative ifTrue: [ ^value negated ]. ^value ]. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. numberOfNonZeroFractionDigits := lastNonZero. self readExponent. exponent := exponent - numberOfNonZeroFractionDigits. mantissa := integerPart * (self tenRaisedTo: numberOfNonZeroFractionDigits) + (fractionPart // (self tenRaisedTo: numberOfTrailingZeroInFractionPart)). value := self makeFloatFromMantissa: mantissa exponent: exponent. negative ifTrue: [ ^value negated ]. ^value! ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') ----- nextUnsignedIntegerOrNil "Form an unsigned integer with incoming digits from sourceStream. Answer this integer, or nil if no digit found. Count the number of digits and the position of lastNonZero digit and store them in instVar" | nPackets high nDigitsHigh lastNonZeroHigh low | "read no more digits than one elementary LargeInteger" high := self nextElementaryLargeInteger. nDigits = 0 ifTrue: [^nil]. "Not enough digits to form a LargeInteger, stop iteration" high isLarge ifFalse: [^high]. "We now have to engage arithmetic with LargeInteger Decompose the integer in a high and low packets of growing size:" nPackets := 1. nDigitsHigh := nDigits. lastNonZeroHigh := lastNonZero. [ low := self nextLargeIntegerBase: 10 nPackets: nPackets . high := high * (self tenRaisedTo: nDigits) + low. lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh]. nDigitsHigh := nDigitsHigh + nDigits. low isLarge] whileTrue: [nPackets := nPackets * 2]. nDigits := nDigitsHigh. lastNonZero := lastNonZeroHigh. ^high! ----- Method: JsonNumberParser>>tenRaisedTo: (in category 'parsing-private') ----- tenRaisedTo: anInteger anInteger >= 0 ifFalse: [ ^10 raisedToInteger: anInteger ]. anInteger >= 16 ifTrue: [ ^10 raisedToInteger: anInteger ]. ^#(1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000 10000000000 100000000000 1000000000000 10000000000000 100000000000000 1000000000000000) at: anInteger + 1! ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: stream self printOn: stream showingDecimalPlaces: scale! ----- 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: $]! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>assertIncompleteJson: (in category 'helpers') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'helpers') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- Method: JsonTests>>json:equals: (in category 'helpers') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'helpers') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'helpers') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'helpers') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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>>testDictionaryClass (in category 'tests') ----- testDictionaryClass | parser | parser := Json new. self assert: (parser readFrom: '{}' readStream) class == JsonObject. parser dictionaryClass: OrderedJsonObject. self assert: (parser readFrom: '{}' readStream) class == OrderedJsonObject. self assert: (parser readFrom: '{"x":{"y":{}}}' readStream) x y class == OrderedJsonObject! ----- Method: JsonTests>>testIncomplete (in category 'tests') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'tests') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'tests') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testJsonObjectAtPutReturnsTheObject (in category 'tests') ----- testJsonObjectAtPutReturnsTheObject { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self assert: (json at: 'foo' put: 1) == json. self assert: (json foo: 1) == json ]! ----- Method: JsonTests>>testMissingCtor (in category 'tests') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'tests') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testNonStringKeysRaiseError (in category 'tests') ----- testNonStringKeysRaiseError { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self should: [ json at: 1 put: 1 ] raise: Error. self assert: json isEmpty. json at: '1' put: 1. self assert: 1 equals: (json at: '1') ]! ----- Method: JsonTests>>testStreaming (in category 'tests') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: JsonObject new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'tests') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- Method: JsonTests>>testWriteAssociation (in category 'tests') ----- 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 'tests') ----- 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: String>>asSerializedJson (in category '*JSON') ----- asSerializedJson " Assume that the receiver is a valid serialized json string. Return an object that understands #jsonWriteOn: and will write this string on its argument. " ^SerializedJson on: self! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | index start | aStream nextPut: $". start := 1. [ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [ aStream next: index - start putAll: self startingAt: start. aStream nextPutAll: (Json escapeForCharacter: (self at: index)). start := index + 1 ]. start <= self size ifTrue: [ aStream next: self size + 1 - start putAll: self startingAt: start ]. aStream nextPut: $". ! ----- Method: String>>parseAsJson (in category '*JSON') ----- parseAsJson "Convenience" ^Json readFrom: self readStream! ----- Method: String>>parseAsOrderedJson (in category '*JSON') ----- parseAsOrderedJson "Convenience" ^Json new dictionaryClass: OrderedJsonObject; readFrom: self readStream! Object subclass: #Json instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap dictionaryClass' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray escapeSet'! !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0! I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries. The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects. Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct. Instance Variables stream: <PositionableStream> currentCharacter: <Character> arrayBufferStream: <WriteStream> stringBufferStream: <ReadWriteStream> numberParser: <ExtendedNumberParser> ctorMap: <Dictionary> For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream. arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one. stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this. numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it. ctorMap is the Dictionary holding the constructor classes by name. arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time. For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:. ! Json class instanceVariableNames: 'escapeArray escapeSet'! ----- Method: Json class>>escapeForCharacter: (in category 'accessing') ----- escapeForCharacter: c | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^nil! ----- Method: Json class>>escapeSet (in category 'accessing') ----- escapeSet ^escapeSet! ----- Method: Json class>>initialize (in category 'class initialization') ----- initialize "Json initialize." | newEscapeArray newEscapeSet | newEscapeArray := Array new: 128. newEscapeSet := CharacterSet new. (0 to: 31), #(127) do: [ :each | newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0). newEscapeSet add: (Character value: each) ]. { $" -> '\"'. $\ -> '\\'. $/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>." Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | newEscapeArray at: each key asciiValue + 1 put: each value. newEscapeSet add: each key ]. escapeArray := newEscapeArray. escapeSet := newEscapeSet! ----- Method: Json class>>mimeType (in category 'accessing') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'instance creation') ----- 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>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'rendering') ----- render: anObject ^String streamContents: [ :stream | anObject jsonWriteOn: stream ]! ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') ----- 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>>arrayBufferStream (in category 'private') ----- arrayBufferStream ^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]! ----- Method: Json>>consume: (in category 'private') ----- consume: aString | message | 1 to: aString size do: [ :index | (currentCharacter := stream next) == (aString at: index) ifFalse: [ message := 'Expected ', (aString at: index) printString. currentCharacter ifNil: [ self incomplete: message ] ifNotNil: [ self invalid: message ] ] ]. currentCharacter := stream next! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap := m! ----- Method: Json>>dictionaryClass: (in category 'accessing') ----- dictionaryClass: aClass "This method allows you to override the default dictionary class to be created while parsing a stream. Instances of aClass are expected to understand #at:put:." dictionaryClass := aClass! ----- Method: Json>>error: (in category 'error handling') ----- error: aString (currentCharacter isNil and: [ stream atEnd ]) ifTrue: [ self incomplete: aString ] ifFalse: [ self invalid: aString ]! ----- Method: Json>>incomplete: (in category 'error handling') ----- incomplete: aString JsonIncompleteError signal: aString! ----- Method: Json>>initialize (in category 'initialize-release') ----- initialize dictionaryClass := JsonObject ! ----- Method: Json>>interpretStringEscape: (in category 'private') ----- interpretStringEscape: aCharacter aCharacter == $b ifTrue: [ ^Character backspace ]. aCharacter == $n ifTrue: [ ^Character lf ]. aCharacter == $f ifTrue: [ ^Character newPage ]. aCharacter == $r ifTrue: [ ^Character cr ]. aCharacter == $t ifTrue: [ ^Character tab ]. aCharacter == $u ifTrue: [ ^self unescapeUnicode ]. aCharacter == $" ifTrue: [ ^aCharacter ]. aCharacter == $\ ifTrue: [ ^aCharacter ]. aCharacter == $/ ifTrue: [ ^aCharacter ]. self error: 'Unexpected escaped character: ', aCharacter asString ! ----- Method: Json>>invalid: (in category 'error handling') ----- invalid: aString JsonInvalidError signal: aString! ----- Method: Json>>readAny (in category 'private') ----- readAny self skipWhitespace. currentCharacter == ${ ifTrue: [ ^self readDictionary ]. currentCharacter == $[ ifTrue: [ ^self readArray ]. currentCharacter == $" ifTrue: [ ^self readString ]. currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ]. currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ]. currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ]. currentCharacter == $- ifTrue: [ ^self readNumber: true ]. (#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [ ^self readNumber: false ]. currentCharacter == $@ ifTrue: [ ^self readConstructor ]. self invalid: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | initialPosition | currentCharacter := stream next. self skipWhitespace. currentCharacter == $] ifTrue: [ currentCharacter := stream next. ^#() ]. initialPosition := self arrayBufferStream position. [ arrayBufferStream nextPut: self readAny. self skipWhitespace. currentCharacter == $] ifTrue: [ | result | result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position. arrayBufferStream position: initialPosition. currentCharacter := stream next. ^result ]. currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ]. currentCharacter := stream next ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor ctorMap ifNil: [ ^self error: 'No constructors were declared.' ]. self resetStringBufferStream. [ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [ stringBufferStream nextPut: currentCharacter ]. (ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor | ^constructor constructFromJson: self readAny ]. self error: 'Unknown constructor: ', stringBufferStream contents! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | result key commaNeeded | result := dictionaryClass new. commaNeeded := false. currentCharacter := stream next. [ self skipWhitespace. currentCharacter == $} ifTrue: [ currentCharacter := stream next. ^result ]. commaNeeded ifFalse: [ commaNeeded := true ] ifTrue: [ currentCharacter == $, ifFalse: [ self error: 'Missing comma' ]. currentCharacter := stream next. self skipWhitespace ]. currentCharacter == $" ifFalse: [ self error: 'Key in dictionary must be string' ]. key := self readString. self skipWhitespace. currentCharacter == $: ifFalse: [ self error: 'Missing colon' ]. currentCharacter := stream next. result at: key put: self readAny ] repeat! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream | result | stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next. result := self readAny. stream atEnd ifFalse: [ stream skip: -1 ]. "Undo prereading." ^result! ----- Method: Json>>readNumber: (in category 'private') ----- readNumber: negative | result | negative ifFalse: [ stream skip: -1 ]. result := (numberParser ifNil: [ numberParser := JsonNumberParser new on: stream; failBlock: [ self error: 'Invalid number.' ]; yourself ]) nextNumber: negative. currentCharacter := stream next. ^result ! ----- Method: Json>>readString (in category 'private') ----- readString self resetStringBufferStream. [ currentCharacter := stream next ifNil: [self incomplete: 'Unexpected end of string' ]. currentCharacter == $" ifTrue: [ currentCharacter := stream next. ^stringBufferStream contents ]. currentCharacter == $\ ifTrue: [ stringBufferStream nextPut: (self interpretStringEscape: (stream next ifNil: [ self incomplete: 'Unexpected end of string' ])) ] ifFalse: [ stringBufferStream nextPut: currentCharacter ] ] repeat! ----- Method: Json>>resetStringBufferStream (in category 'private') ----- resetStringBufferStream stringBufferStream ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ] ifNotNil: [ stringBufferStream resetToStart ]! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace currentCharacter ifNil: [ self incomplete: 'Input stream is empty' ]. [ currentCharacter isSeparator ] whileTrue: [ currentCharacter := stream next ifNil: [ self incomplete: 'Input stream is empty' ]. ]! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'private') ----- stream: aStream "For testing purposes only" stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode | code digitValue | code := 0. 1 to: 4 do: [ :index | (digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [ self invalid: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ code := code * 16 + digitValue ] ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ]. ^Character value: code! 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 ]! Object subclass: #SerializedJson instanceVariableNames: 'jsonString' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: SerializedJson class>>on: (in category 'instance creation') ----- on: aString ^self new jsonString: aString; yourself! ----- Method: SerializedJson>>jsonString (in category 'accessing') ----- jsonString ^jsonString ! ----- Method: SerializedJson>>jsonString: (in category 'accessing') ----- jsonString: aString jsonString := aString ! ----- Method: SerializedJson>>jsonWriteOn: (in category 'json-writing') ----- jsonWriteOn: stream stream nextPutAll: jsonString!

1 0

The Trunk: JSON-ul.51.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.51.mcz ==================== Summary ==================== Name: JSON-ul.51 Author: ul Time: 28 March 2020, 4:56:38.588541 am UUID: 63bf1eab-8112-4eca-91e4-530066259253 Ancestors: JSON-klub.50 - fix: only undo prereading in Json >> #readFrom: when there was a character read from the stream - fix: avoid long parsing when exponent is larger than what Floats can represent - fix: raise JsonSyntaxError when a number atom has leading zeroes ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- 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'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! OrderedDictionary subclass: #OrderedJsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: OrderedJsonObject 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: OrderedJsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: OrderedJsonObject>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ----- Method: OrderedJsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: OrderedJsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: Time>>jsonWriteOn: (in category '*JSON') ----- jsonWriteOn: stream stream nextPut: $". self print24: true showSeconds: true on: stream. stream 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: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: 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>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: JsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^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: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! NumberParser subclass: #JsonNumberParser instanceVariableNames: 'fraction' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') ----- allowPlusSign ^false! ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') ----- allowPlusSignInExponent ^true! ----- Method: JsonNumberParser>>error: (in category 'error') ----- error: aString JsonSyntaxError signal: aString! ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') ----- exponentLetters ^'eE'! ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') ----- initialize super initialize. base := 10. fraction := Fraction numerator: 0 denominator: 1! ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') ----- makeFloatFromMantissa: mantissa exponent: exponent exponent = 0 ifTrue: [ ^mantissa asFloat ]. exponent >= 16 ifTrue: [ exponent > Float emax ifTrue: [ mantissa isZero ifTrue: [ ^0.0 ]. mantissa positive ifTrue: [ ^Float infinity ]. ^Float negativeInfinity ]. ^(mantissa * (self tenRaisedTo: exponent)) asFloat ]. (exponent >= -15 and: [ mantissa highBitOfMagnitude <= 54 ]) ifTrue: [ exponent >= 1 ifTrue: [ ^mantissa asFloat * (self tenRaisedTo: exponent) asFloat ]. ^mantissa asFloat / (self tenRaisedTo: exponent negated) asFloat ]. exponent < Float emin ifTrue: [ mantissa positive ifTrue: [ ^0.0 ]. ^-0.0 ]. ^(fraction setNumerator: mantissa denominator: (self tenRaisedTo: exponent negated)) asFloat! ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') ----- nextElementaryLargeInteger "Form an unsigned integer with incoming digits from sourceStream. Return this integer, or zero if no digits found. Stop reading if end of digits or if a LargeInteger is formed. Count the number of digits and the position of lastNonZero digit and store them in instVar." | digit value | value := 0. nDigits := 0. lastNonZero := 0. [ value isLarge ifTrue: [ ^value ]. ((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 or: [ digit >= 10 ]) ifTrue: [ sourceStream skip: -1. ^value ]. nDigits := nDigits + 1. digit = 0 ifFalse: [ (lastNonZero = 0 and: [ nDigits > 1 ]) ifTrue: [ self error: 'Leading zeroes are not allowed.' ]. lastNonZero := nDigits. value := value * 10 + digit ] ifTrue: [ value := value * 10 ] ] repeat! ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') ----- nextNumber: negative | numberOfTrailingZeroInIntegerPart numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value | integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $.) ifFalse: [ "No fraction part" negative ifTrue: [ integerPart := integerPart negated ]. self readExponent ifFalse: [ ^integerPart ]. exponent > 0 ifTrue: [ ^integerPart * (self tenRaisedTo: exponent) ]. ^(Fraction numerator: integerPart denominator: (self tenRaisedTo: exponent negated)) asFloat ]. fractionPart := self nextUnsignedIntegerOrNil ifNil: [ self error: 'Missing fraction part!!' ]. fractionPart isZero ifTrue: [ self readExponent ifFalse: [ negative ifTrue: [ integerPart isZero ifTrue: [ ^Float negativeZero ]. ^integerPart negated ]. ^integerPart ]. exponent >= 0 ifTrue: [ negative ifTrue: [ integerPart := integerPart negated ]. ^integerPart * (self tenRaisedTo: exponent) ]. value := self makeFloatFromMantissa: integerPart exponent: exponent. negative ifTrue: [ ^value negated ]. ^value ]. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. numberOfNonZeroFractionDigits := lastNonZero. self readExponent. exponent := exponent - numberOfNonZeroFractionDigits. mantissa := integerPart * (self tenRaisedTo: numberOfNonZeroFractionDigits) + (fractionPart // (self tenRaisedTo: numberOfTrailingZeroInFractionPart)). value := self makeFloatFromMantissa: mantissa exponent: exponent. negative ifTrue: [ ^value negated ]. ^value! ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') ----- nextUnsignedIntegerOrNil "Form an unsigned integer with incoming digits from sourceStream. Answer this integer, or nil if no digit found. Count the number of digits and the position of lastNonZero digit and store them in instVar" | nPackets high nDigitsHigh lastNonZeroHigh low | "read no more digits than one elementary LargeInteger" high := self nextElementaryLargeInteger. nDigits = 0 ifTrue: [^nil]. "Not enough digits to form a LargeInteger, stop iteration" high isLarge ifFalse: [^high]. "We now have to engage arithmetic with LargeInteger Decompose the integer in a high and low packets of growing size:" nPackets := 1. nDigitsHigh := nDigits. lastNonZeroHigh := lastNonZero. [ low := self nextLargeIntegerBase: 10 nPackets: nPackets . high := high * (self tenRaisedTo: nDigits) + low. lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh]. nDigitsHigh := nDigitsHigh + nDigits. low isLarge] whileTrue: [nPackets := nPackets * 2]. nDigits := nDigitsHigh. lastNonZero := lastNonZeroHigh. ^high! ----- Method: JsonNumberParser>>tenRaisedTo: (in category 'parsing-private') ----- tenRaisedTo: anInteger anInteger >= 0 ifFalse: [ ^10 raisedToInteger: anInteger ]. anInteger >= 16 ifTrue: [ ^10 raisedToInteger: anInteger ]. ^#(1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000 10000000000 100000000000 1000000000000 10000000000000 100000000000000 1000000000000000) at: anInteger + 1! ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: stream self printOn: stream showingDecimalPlaces: scale! ----- 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: $]! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>assertIncompleteJson: (in category 'helpers') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'helpers') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- Method: JsonTests>>json:equals: (in category 'helpers') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'helpers') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'helpers') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'helpers') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- testAtomNumber self json: '1' equals: 1. self json: '123' equals: 123. self should: [ self json: '0123' equals: 123 ] raise: JsonSyntaxError. "No leading zeroes." 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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>>testDictionaryClass (in category 'tests') ----- testDictionaryClass | parser | parser := Json new. self assert: (parser readFrom: '{}' readStream) class == JsonObject. parser dictionaryClass: OrderedJsonObject. self assert: (parser readFrom: '{}' readStream) class == OrderedJsonObject. self assert: (parser readFrom: '{"x":{"y":{}}}' readStream) x y class == OrderedJsonObject! ----- Method: JsonTests>>testIncomplete (in category 'tests') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'tests') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'tests') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testJsonObjectAtPutReturnsTheObject (in category 'tests') ----- testJsonObjectAtPutReturnsTheObject { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self assert: (json at: 'foo' put: 1) == json. self assert: (json foo: 1) == json ]! ----- Method: JsonTests>>testMissingCtor (in category 'tests') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'tests') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testNonStringKeysRaiseError (in category 'tests') ----- testNonStringKeysRaiseError { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self should: [ json at: 1 put: 1 ] raise: Error. self assert: json isEmpty. json at: '1' put: 1. self assert: 1 equals: (json at: '1') ]! ----- Method: JsonTests>>testStreaming (in category 'tests') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: JsonObject new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'tests') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- Method: JsonTests>>testWriteAssociation (in category 'tests') ----- 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 'tests') ----- 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: String>>asSerializedJson (in category '*JSON') ----- asSerializedJson " Assume that the receiver is a valid serialized json string. Return an object that understands #jsonWriteOn: and will write this string on its argument. " ^SerializedJson on: self! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | index start | aStream nextPut: $". start := 1. [ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [ aStream next: index - start putAll: self startingAt: start. aStream nextPutAll: (Json escapeForCharacter: (self at: index)). start := index + 1 ]. start <= self size ifTrue: [ aStream next: self size + 1 - start putAll: self startingAt: start ]. aStream nextPut: $". ! ----- Method: String>>parseAsJson (in category '*JSON') ----- parseAsJson "Convenience" ^Json readFrom: self readStream! ----- Method: String>>parseAsOrderedJson (in category '*JSON') ----- parseAsOrderedJson "Convenience" ^Json new dictionaryClass: OrderedJsonObject; readFrom: self readStream! Object subclass: #Json instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap dictionaryClass' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray escapeSet'! !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0! I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries. The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects. Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct. Instance Variables stream: <PositionableStream> currentCharacter: <Character> arrayBufferStream: <WriteStream> stringBufferStream: <ReadWriteStream> numberParser: <ExtendedNumberParser> ctorMap: <Dictionary> For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream. arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one. stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this. numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it. ctorMap is the Dictionary holding the constructor classes by name. arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time. For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:. ! Json class instanceVariableNames: 'escapeArray escapeSet'! ----- Method: Json class>>escapeForCharacter: (in category 'accessing') ----- escapeForCharacter: c | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^nil! ----- Method: Json class>>escapeSet (in category 'accessing') ----- escapeSet ^escapeSet! ----- Method: Json class>>initialize (in category 'class initialization') ----- initialize "Json initialize." | newEscapeArray newEscapeSet | newEscapeArray := Array new: 128. newEscapeSet := CharacterSet new. (0 to: 31), #(127) do: [ :each | newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0). newEscapeSet add: (Character value: each) ]. { $" -> '\"'. $\ -> '\\'. $/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>." Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | newEscapeArray at: each key asciiValue + 1 put: each value. newEscapeSet add: each key ]. escapeArray := newEscapeArray. escapeSet := newEscapeSet! ----- Method: Json class>>mimeType (in category 'accessing') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'instance creation') ----- 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>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'rendering') ----- render: anObject ^String streamContents: [ :stream | anObject jsonWriteOn: stream ]! ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') ----- 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>>arrayBufferStream (in category 'private') ----- arrayBufferStream ^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]! ----- Method: Json>>consume: (in category 'private') ----- consume: aString | message | 1 to: aString size do: [ :index | (currentCharacter := stream next) == (aString at: index) ifFalse: [ message := 'Expected ', (aString at: index) printString. currentCharacter ifNil: [ self incomplete: message ] ifNotNil: [ self invalid: message ] ] ]. currentCharacter := stream next! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap := m! ----- Method: Json>>dictionaryClass: (in category 'accessing') ----- dictionaryClass: aClass "This method allows you to override the default dictionary class to be created while parsing a stream. Instances of aClass are expected to understand #at:put:." dictionaryClass := aClass! ----- Method: Json>>error: (in category 'error handling') ----- error: aString (currentCharacter isNil and: [ stream atEnd ]) ifTrue: [ self incomplete: aString ] ifFalse: [ self invalid: aString ]! ----- Method: Json>>incomplete: (in category 'error handling') ----- incomplete: aString JsonIncompleteError signal: aString! ----- Method: Json>>initialize (in category 'initialize-release') ----- initialize dictionaryClass := JsonObject ! ----- Method: Json>>interpretStringEscape: (in category 'private') ----- interpretStringEscape: aCharacter aCharacter == $b ifTrue: [ ^Character backspace ]. aCharacter == $n ifTrue: [ ^Character lf ]. aCharacter == $f ifTrue: [ ^Character newPage ]. aCharacter == $r ifTrue: [ ^Character cr ]. aCharacter == $t ifTrue: [ ^Character tab ]. aCharacter == $u ifTrue: [ ^self unescapeUnicode ]. aCharacter == $" ifTrue: [ ^aCharacter ]. aCharacter == $\ ifTrue: [ ^aCharacter ]. aCharacter == $/ ifTrue: [ ^aCharacter ]. self error: 'Unexpected escaped character: ', aCharacter asString ! ----- Method: Json>>invalid: (in category 'error handling') ----- invalid: aString JsonInvalidError signal: aString! ----- Method: Json>>readAny (in category 'private') ----- readAny self skipWhitespace. currentCharacter == ${ ifTrue: [ ^self readDictionary ]. currentCharacter == $[ ifTrue: [ ^self readArray ]. currentCharacter == $" ifTrue: [ ^self readString ]. currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ]. currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ]. currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ]. currentCharacter == $- ifTrue: [ ^self readNumber: true ]. (#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [ ^self readNumber: false ]. currentCharacter == $@ ifTrue: [ ^self readConstructor ]. self invalid: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | initialPosition | currentCharacter := stream next. self skipWhitespace. currentCharacter == $] ifTrue: [ currentCharacter := stream next. ^#() ]. initialPosition := self arrayBufferStream position. [ arrayBufferStream nextPut: self readAny. self skipWhitespace. currentCharacter == $] ifTrue: [ | result | result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position. arrayBufferStream position: initialPosition. currentCharacter := stream next. ^result ]. currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ]. currentCharacter := stream next ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor ctorMap ifNil: [ ^self error: 'No constructors were declared.' ]. self resetStringBufferStream. [ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [ stringBufferStream nextPut: currentCharacter ]. (ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor | ^constructor constructFromJson: self readAny ]. self error: 'Unknown constructor: ', stringBufferStream contents! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | result key commaNeeded | result := dictionaryClass new. commaNeeded := false. currentCharacter := stream next. [ self skipWhitespace. currentCharacter == $} ifTrue: [ currentCharacter := stream next. ^result ]. commaNeeded ifFalse: [ commaNeeded := true ] ifTrue: [ currentCharacter == $, ifFalse: [ self error: 'Missing comma' ]. currentCharacter := stream next. self skipWhitespace ]. currentCharacter == $" ifFalse: [ self error: 'Key in dictionary must be string' ]. key := self readString. self skipWhitespace. currentCharacter == $: ifFalse: [ self error: 'Missing colon' ]. currentCharacter := stream next. result at: key put: self readAny ] repeat! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream | result | stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next. result := self readAny. currentCharacter ifNotNil: [ stream skip: -1 ]. "Undo prereading." ^result! ----- Method: Json>>readNumber: (in category 'private') ----- readNumber: negative | result | negative ifFalse: [ stream skip: -1 ]. result := (numberParser ifNil: [ numberParser := JsonNumberParser new on: stream; failBlock: [ self error: 'Invalid number.' ]; yourself ]) nextNumber: negative. currentCharacter := stream next. ^result ! ----- Method: Json>>readString (in category 'private') ----- readString self resetStringBufferStream. [ currentCharacter := stream next ifNil: [self incomplete: 'Unexpected end of string' ]. currentCharacter == $" ifTrue: [ currentCharacter := stream next. ^stringBufferStream contents ]. currentCharacter == $\ ifTrue: [ stringBufferStream nextPut: (self interpretStringEscape: (stream next ifNil: [ self incomplete: 'Unexpected end of string' ])) ] ifFalse: [ stringBufferStream nextPut: currentCharacter ] ] repeat! ----- Method: Json>>resetStringBufferStream (in category 'private') ----- resetStringBufferStream stringBufferStream ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ] ifNotNil: [ stringBufferStream resetToStart ]! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace currentCharacter ifNil: [ self incomplete: 'Input stream is empty' ]. [ currentCharacter isSeparator ] whileTrue: [ currentCharacter := stream next ifNil: [ self incomplete: 'Input stream is empty' ]. ]! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'private') ----- stream: aStream "For testing purposes only" stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode | code digitValue | code := 0. 1 to: 4 do: [ :index | (digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [ self invalid: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ code := code * 16 + digitValue ] ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ]. ^Character value: code! 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 ]! Object subclass: #SerializedJson instanceVariableNames: 'jsonString' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: SerializedJson class>>on: (in category 'instance creation') ----- on: aString ^self new jsonString: aString; yourself! ----- Method: SerializedJson>>jsonString (in category 'accessing') ----- jsonString ^jsonString ! ----- Method: SerializedJson>>jsonString: (in category 'accessing') ----- jsonString: aString jsonString := aString ! ----- Method: SerializedJson>>jsonWriteOn: (in category 'json-writing') ----- jsonWriteOn: stream stream nextPutAll: jsonString!

1 0

The Trunk: JSON-ul.52.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.52.mcz ==================== Summary ==================== Name: JSON-ul.52 Author: ul Time: 28 March 2020, 5:14:19.385987 am UUID: ce84535f-78e3-483e-b833-f6ac1d4e0f54 Ancestors: JSON-ul.51 - tightened up the range of possible valid decimal exponents ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- 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'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! OrderedDictionary subclass: #OrderedJsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: OrderedJsonObject 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: OrderedJsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: OrderedJsonObject>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ----- Method: OrderedJsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: OrderedJsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: Time>>jsonWriteOn: (in category '*JSON') ----- jsonWriteOn: stream stream nextPut: $". self print24: true showSeconds: true on: stream. stream 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: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: 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>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: JsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^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: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! NumberParser subclass: #JsonNumberParser instanceVariableNames: 'fraction' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') ----- allowPlusSign ^false! ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') ----- allowPlusSignInExponent ^true! ----- Method: JsonNumberParser>>error: (in category 'error') ----- error: aString JsonSyntaxError signal: aString! ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') ----- exponentLetters ^'eE'! ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') ----- initialize super initialize. base := 10. fraction := Fraction numerator: 0 denominator: 1! ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') ----- makeFloatFromMantissa: mantissa exponent: exponent exponent = 0 ifTrue: [ ^mantissa asFloat ]. exponent >= 16 ifTrue: [ exponent > 324 ifTrue: [ "(Float emax + 53 * 2 ln / 10 ln) ceiling => 324" mantissa isZero ifTrue: [ ^0.0 ]. mantissa positive ifTrue: [ ^Float infinity ]. ^Float negativeInfinity ]. ^(mantissa * (self tenRaisedTo: exponent)) asFloat ]. (exponent >= -15 and: [ mantissa highBitOfMagnitude <= 54 ]) ifTrue: [ exponent >= 1 ifTrue: [ ^mantissa asFloat * (self tenRaisedTo: exponent) asFloat ]. ^mantissa asFloat / (self tenRaisedTo: exponent negated) asFloat ]. exponent < -324 ifTrue: [ "-1 * (53 - Float emin * 2 ln / 10 ln) ceiling => -324" mantissa positive ifTrue: [ ^0.0 ]. ^-0.0 ]. ^(fraction setNumerator: mantissa denominator: (self tenRaisedTo: exponent negated)) asFloat! ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') ----- nextElementaryLargeInteger "Form an unsigned integer with incoming digits from sourceStream. Return this integer, or zero if no digits found. Stop reading if end of digits or if a LargeInteger is formed. Count the number of digits and the position of lastNonZero digit and store them in instVar." | digit value | value := 0. nDigits := 0. lastNonZero := 0. [ value isLarge ifTrue: [ ^value ]. ((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 or: [ digit >= 10 ]) ifTrue: [ sourceStream skip: -1. ^value ]. nDigits := nDigits + 1. digit = 0 ifFalse: [ (lastNonZero = 0 and: [ nDigits > 1 ]) ifTrue: [ self error: 'Leading zeroes are not allowed.' ]. lastNonZero := nDigits. value := value * 10 + digit ] ifTrue: [ value := value * 10 ] ] repeat! ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') ----- nextNumber: negative | numberOfTrailingZeroInIntegerPart numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value | integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $.) ifFalse: [ "No fraction part" negative ifTrue: [ integerPart := integerPart negated ]. self readExponent ifFalse: [ ^integerPart ]. exponent > 0 ifTrue: [ ^integerPart * (self tenRaisedTo: exponent) ]. ^(Fraction numerator: integerPart denominator: (self tenRaisedTo: exponent negated)) asFloat ]. fractionPart := self nextUnsignedIntegerOrNil ifNil: [ self error: 'Missing fraction part!!' ]. fractionPart isZero ifTrue: [ self readExponent ifFalse: [ negative ifTrue: [ integerPart isZero ifTrue: [ ^Float negativeZero ]. ^integerPart negated ]. ^integerPart ]. exponent >= 0 ifTrue: [ negative ifTrue: [ integerPart := integerPart negated ]. ^integerPart * (self tenRaisedTo: exponent) ]. value := self makeFloatFromMantissa: integerPart exponent: exponent. negative ifTrue: [ ^value negated ]. ^value ]. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. numberOfNonZeroFractionDigits := lastNonZero. self readExponent. exponent := exponent - numberOfNonZeroFractionDigits. mantissa := integerPart * (self tenRaisedTo: numberOfNonZeroFractionDigits) + (fractionPart // (self tenRaisedTo: numberOfTrailingZeroInFractionPart)). value := self makeFloatFromMantissa: mantissa exponent: exponent. negative ifTrue: [ ^value negated ]. ^value! ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') ----- nextUnsignedIntegerOrNil "Form an unsigned integer with incoming digits from sourceStream. Answer this integer, or nil if no digit found. Count the number of digits and the position of lastNonZero digit and store them in instVar" | nPackets high nDigitsHigh lastNonZeroHigh low | "read no more digits than one elementary LargeInteger" high := self nextElementaryLargeInteger. nDigits = 0 ifTrue: [^nil]. "Not enough digits to form a LargeInteger, stop iteration" high isLarge ifFalse: [^high]. "We now have to engage arithmetic with LargeInteger Decompose the integer in a high and low packets of growing size:" nPackets := 1. nDigitsHigh := nDigits. lastNonZeroHigh := lastNonZero. [ low := self nextLargeIntegerBase: 10 nPackets: nPackets . high := high * (self tenRaisedTo: nDigits) + low. lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh]. nDigitsHigh := nDigitsHigh + nDigits. low isLarge] whileTrue: [nPackets := nPackets * 2]. nDigits := nDigitsHigh. lastNonZero := lastNonZeroHigh. ^high! ----- Method: JsonNumberParser>>tenRaisedTo: (in category 'parsing-private') ----- tenRaisedTo: anInteger anInteger >= 0 ifFalse: [ ^10 raisedToInteger: anInteger ]. anInteger >= 16 ifTrue: [ ^10 raisedToInteger: anInteger ]. ^#(1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000 10000000000 100000000000 1000000000000 10000000000000 100000000000000 1000000000000000) at: anInteger + 1! ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: stream self printOn: stream showingDecimalPlaces: scale! ----- 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: $]! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>assertIncompleteJson: (in category 'helpers') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'helpers') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- Method: JsonTests>>json:equals: (in category 'helpers') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'helpers') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'helpers') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'helpers') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- testAtomNumber self json: '1' equals: 1. self json: '123' equals: 123. self should: [ self json: '0123' equals: 123 ] raise: JsonSyntaxError. "No leading zeroes." 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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>>testDictionaryClass (in category 'tests') ----- testDictionaryClass | parser | parser := Json new. self assert: (parser readFrom: '{}' readStream) class == JsonObject. parser dictionaryClass: OrderedJsonObject. self assert: (parser readFrom: '{}' readStream) class == OrderedJsonObject. self assert: (parser readFrom: '{"x":{"y":{}}}' readStream) x y class == OrderedJsonObject! ----- Method: JsonTests>>testIncomplete (in category 'tests') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'tests') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'tests') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testJsonObjectAtPutReturnsTheObject (in category 'tests') ----- testJsonObjectAtPutReturnsTheObject { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self assert: (json at: 'foo' put: 1) == json. self assert: (json foo: 1) == json ]! ----- Method: JsonTests>>testMissingCtor (in category 'tests') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'tests') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testNonStringKeysRaiseError (in category 'tests') ----- testNonStringKeysRaiseError { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self should: [ json at: 1 put: 1 ] raise: Error. self assert: json isEmpty. json at: '1' put: 1. self assert: 1 equals: (json at: '1') ]! ----- Method: JsonTests>>testStreaming (in category 'tests') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: JsonObject new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'tests') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- Method: JsonTests>>testWriteAssociation (in category 'tests') ----- 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 'tests') ----- 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: String>>asSerializedJson (in category '*JSON') ----- asSerializedJson " Assume that the receiver is a valid serialized json string. Return an object that understands #jsonWriteOn: and will write this string on its argument. " ^SerializedJson on: self! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | index start | aStream nextPut: $". start := 1. [ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [ aStream next: index - start putAll: self startingAt: start. aStream nextPutAll: (Json escapeForCharacter: (self at: index)). start := index + 1 ]. start <= self size ifTrue: [ aStream next: self size + 1 - start putAll: self startingAt: start ]. aStream nextPut: $". ! ----- Method: String>>parseAsJson (in category '*JSON') ----- parseAsJson "Convenience" ^Json readFrom: self readStream! ----- Method: String>>parseAsOrderedJson (in category '*JSON') ----- parseAsOrderedJson "Convenience" ^Json new dictionaryClass: OrderedJsonObject; readFrom: self readStream! Object subclass: #Json instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap dictionaryClass' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray escapeSet'! !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0! I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries. The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects. Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct. Instance Variables stream: <PositionableStream> currentCharacter: <Character> arrayBufferStream: <WriteStream> stringBufferStream: <ReadWriteStream> numberParser: <ExtendedNumberParser> ctorMap: <Dictionary> For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream. arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one. stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this. numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it. ctorMap is the Dictionary holding the constructor classes by name. arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time. For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:. ! Json class instanceVariableNames: 'escapeArray escapeSet'! ----- Method: Json class>>escapeForCharacter: (in category 'accessing') ----- escapeForCharacter: c | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^nil! ----- Method: Json class>>escapeSet (in category 'accessing') ----- escapeSet ^escapeSet! ----- Method: Json class>>initialize (in category 'class initialization') ----- initialize "Json initialize." | newEscapeArray newEscapeSet | newEscapeArray := Array new: 128. newEscapeSet := CharacterSet new. (0 to: 31), #(127) do: [ :each | newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0). newEscapeSet add: (Character value: each) ]. { $" -> '\"'. $\ -> '\\'. $/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>." Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | newEscapeArray at: each key asciiValue + 1 put: each value. newEscapeSet add: each key ]. escapeArray := newEscapeArray. escapeSet := newEscapeSet! ----- Method: Json class>>mimeType (in category 'accessing') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'instance creation') ----- 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>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'rendering') ----- render: anObject ^String streamContents: [ :stream | anObject jsonWriteOn: stream ]! ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') ----- 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>>arrayBufferStream (in category 'private') ----- arrayBufferStream ^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]! ----- Method: Json>>consume: (in category 'private') ----- consume: aString | message | 1 to: aString size do: [ :index | (currentCharacter := stream next) == (aString at: index) ifFalse: [ message := 'Expected ', (aString at: index) printString. currentCharacter ifNil: [ self incomplete: message ] ifNotNil: [ self invalid: message ] ] ]. currentCharacter := stream next! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap := m! ----- Method: Json>>dictionaryClass: (in category 'accessing') ----- dictionaryClass: aClass "This method allows you to override the default dictionary class to be created while parsing a stream. Instances of aClass are expected to understand #at:put:." dictionaryClass := aClass! ----- Method: Json>>error: (in category 'error handling') ----- error: aString (currentCharacter isNil and: [ stream atEnd ]) ifTrue: [ self incomplete: aString ] ifFalse: [ self invalid: aString ]! ----- Method: Json>>incomplete: (in category 'error handling') ----- incomplete: aString JsonIncompleteError signal: aString! ----- Method: Json>>initialize (in category 'initialize-release') ----- initialize dictionaryClass := JsonObject ! ----- Method: Json>>interpretStringEscape: (in category 'private') ----- interpretStringEscape: aCharacter aCharacter == $b ifTrue: [ ^Character backspace ]. aCharacter == $n ifTrue: [ ^Character lf ]. aCharacter == $f ifTrue: [ ^Character newPage ]. aCharacter == $r ifTrue: [ ^Character cr ]. aCharacter == $t ifTrue: [ ^Character tab ]. aCharacter == $u ifTrue: [ ^self unescapeUnicode ]. aCharacter == $" ifTrue: [ ^aCharacter ]. aCharacter == $\ ifTrue: [ ^aCharacter ]. aCharacter == $/ ifTrue: [ ^aCharacter ]. self error: 'Unexpected escaped character: ', aCharacter asString ! ----- Method: Json>>invalid: (in category 'error handling') ----- invalid: aString JsonInvalidError signal: aString! ----- Method: Json>>readAny (in category 'private') ----- readAny self skipWhitespace. currentCharacter == ${ ifTrue: [ ^self readDictionary ]. currentCharacter == $[ ifTrue: [ ^self readArray ]. currentCharacter == $" ifTrue: [ ^self readString ]. currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ]. currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ]. currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ]. currentCharacter == $- ifTrue: [ ^self readNumber: true ]. (#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [ ^self readNumber: false ]. currentCharacter == $@ ifTrue: [ ^self readConstructor ]. self invalid: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | initialPosition | currentCharacter := stream next. self skipWhitespace. currentCharacter == $] ifTrue: [ currentCharacter := stream next. ^#() ]. initialPosition := self arrayBufferStream position. [ arrayBufferStream nextPut: self readAny. self skipWhitespace. currentCharacter == $] ifTrue: [ | result | result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position. arrayBufferStream position: initialPosition. currentCharacter := stream next. ^result ]. currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ]. currentCharacter := stream next ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor ctorMap ifNil: [ ^self error: 'No constructors were declared.' ]. self resetStringBufferStream. [ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [ stringBufferStream nextPut: currentCharacter ]. (ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor | ^constructor constructFromJson: self readAny ]. self error: 'Unknown constructor: ', stringBufferStream contents! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | result key commaNeeded | result := dictionaryClass new. commaNeeded := false. currentCharacter := stream next. [ self skipWhitespace. currentCharacter == $} ifTrue: [ currentCharacter := stream next. ^result ]. commaNeeded ifFalse: [ commaNeeded := true ] ifTrue: [ currentCharacter == $, ifFalse: [ self error: 'Missing comma' ]. currentCharacter := stream next. self skipWhitespace ]. currentCharacter == $" ifFalse: [ self error: 'Key in dictionary must be string' ]. key := self readString. self skipWhitespace. currentCharacter == $: ifFalse: [ self error: 'Missing colon' ]. currentCharacter := stream next. result at: key put: self readAny ] repeat! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream | result | stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next. result := self readAny. currentCharacter ifNotNil: [ stream skip: -1 ]. "Undo prereading." ^result! ----- Method: Json>>readNumber: (in category 'private') ----- readNumber: negative | result | negative ifFalse: [ stream skip: -1 ]. result := (numberParser ifNil: [ numberParser := JsonNumberParser new on: stream; failBlock: [ self error: 'Invalid number.' ]; yourself ]) nextNumber: negative. currentCharacter := stream next. ^result ! ----- Method: Json>>readString (in category 'private') ----- readString self resetStringBufferStream. [ currentCharacter := stream next ifNil: [self incomplete: 'Unexpected end of string' ]. currentCharacter == $" ifTrue: [ currentCharacter := stream next. ^stringBufferStream contents ]. currentCharacter == $\ ifTrue: [ stringBufferStream nextPut: (self interpretStringEscape: (stream next ifNil: [ self incomplete: 'Unexpected end of string' ])) ] ifFalse: [ stringBufferStream nextPut: currentCharacter ] ] repeat! ----- Method: Json>>resetStringBufferStream (in category 'private') ----- resetStringBufferStream stringBufferStream ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ] ifNotNil: [ stringBufferStream resetToStart ]! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace currentCharacter ifNil: [ self incomplete: 'Input stream is empty' ]. [ currentCharacter isSeparator ] whileTrue: [ currentCharacter := stream next ifNil: [ self incomplete: 'Input stream is empty' ]. ]! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'private') ----- stream: aStream "For testing purposes only" stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode | code digitValue | code := 0. 1 to: 4 do: [ :index | (digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [ self invalid: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ code := code * 16 + digitValue ] ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ]. ^Character value: code! 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 ]! Object subclass: #SerializedJson instanceVariableNames: 'jsonString' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: SerializedJson class>>on: (in category 'instance creation') ----- on: aString ^self new jsonString: aString; yourself! ----- Method: SerializedJson>>jsonString (in category 'accessing') ----- jsonString ^jsonString ! ----- Method: SerializedJson>>jsonString: (in category 'accessing') ----- jsonString: aString jsonString := aString ! ----- Method: SerializedJson>>jsonWriteOn: (in category 'json-writing') ----- jsonWriteOn: stream stream nextPutAll: jsonString!

1 0

The Trunk: JSON-ul.53.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.53.mcz ==================== Summary ==================== Name: JSON-ul.53 Author: ul Time: 29 May 2020, 8:24:04.195764 pm UUID: 106f38be-cebe-4dbc-9ea3-b7e3dbb6d1ac Ancestors: JSON-ul.52 - improve number parser performance by separating the factors of the exponent - improved number parser precision ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- 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'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! OrderedDictionary subclass: #OrderedJsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: OrderedJsonObject 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: OrderedJsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: OrderedJsonObject>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ----- Method: OrderedJsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: OrderedJsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: Time>>jsonWriteOn: (in category '*JSON') ----- jsonWriteOn: stream stream nextPut: $". self print24: true showSeconds: true on: stream. stream 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: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: 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>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: JsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^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: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! NumberParser subclass: #JsonNumberParser instanceVariableNames: 'fraction leadingZeroesAllowed' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') ----- allowPlusSign ^false! ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') ----- allowPlusSignInExponent ^true! ----- Method: JsonNumberParser>>error: (in category 'error') ----- error: aString JsonSyntaxError signal: aString! ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') ----- exponentLetters ^'eE'! ----- Method: JsonNumberParser>>fiveRaisedTo: (in category 'parsing-private') ----- fiveRaisedTo: anInteger anInteger >= 0 ifFalse: [ ^5 raisedToInteger: anInteger ]. anInteger >= 28 ifTrue: [ ^5 raisedToInteger: anInteger ]. ^#(1 5 25 125 625 3125 15625 78125 390625 1953125 9765625 48828125 244140625 1220703125 6103515625 30517578125 152587890625 762939453125 3814697265625 19073486328125 95367431640625 476837158203125 2384185791015625 11920928955078125 59604644775390625 298023223876953125 1490116119384765625 7450580596923828125) at: anInteger + 1! ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') ----- initialize super initialize. base := 10. fraction := Fraction numerator: 0 denominator: 1. leadingZeroesAllowed := false! ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') ----- makeFloatFromMantissa: mantissa exponent: exponent exponent = 0 ifTrue: [ ^mantissa asFloat ]. exponent >= 16 ifTrue: [ exponent > 324 ifTrue: [ "(Float emax + 53 * 2 ln / 10 ln) ceiling => 324" mantissa isZero ifTrue: [ ^0.0 ]. mantissa positive ifTrue: [ ^Float infinity ]. ^Float negativeInfinity ]. ^(mantissa * (self fiveRaisedTo: exponent)) asFloat timesTwoPower: exponent ]. (exponent >= -15 and: [ mantissa highBitOfMagnitude <= 53 ]) ifTrue: [ exponent >= 1 ifTrue: [ ^mantissa asFloat * (self fiveRaisedTo: exponent) asFloat timesTwoPower: exponent ]. ^mantissa asFloat / (self fiveRaisedTo: exponent negated) asFloat timesTwoPower: exponent ]. exponent >= 1 ifTrue: [ ^(mantissa * (self fiveRaisedTo: exponent)) asFloat timesTwoPower: exponent ]. exponent < -324 ifTrue: [ "-1 * (53 - Float emin * 2 ln / 10 ln) ceiling => -324" mantissa positive ifTrue: [ ^0.0 ]. ^-0.0 ]. ^(fraction setNumerator: mantissa denominator: (self fiveRaisedTo: exponent negated)) reduced asFloat timesTwoPower: exponent ! ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') ----- nextElementaryLargeInteger "Form an unsigned integer with incoming digits from sourceStream. Return this integer, or zero if no digits found. Stop reading if end of digits or if a LargeInteger is formed. Count the number of digits and the position of lastNonZero digit and store them in instVar." | digit value | value := 0. nDigits := 0. lastNonZero := 0. [ value isLarge ifTrue: [ ^value ]. ((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 or: [ digit >= 10 ]) ifTrue: [ sourceStream skip: -1. ^value ]. nDigits := nDigits + 1. digit = 0 ifFalse: [ (lastNonZero = 0 and: [ nDigits > 1 and: [ leadingZeroesAllowed not ] ]) ifTrue: [ self error: 'Leading zeroes are not allowed.' ]. lastNonZero := nDigits. value := value * 10 + digit ] ifTrue: [ value := value * 10 ] ] repeat! ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') ----- nextNumber: negative | numberOfTrailingZeroInIntegerPart oldLeadingZeroesAllowed numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value | integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $.) ifFalse: [ "No fraction part" negative ifTrue: [ integerPart := integerPart negated ]. self readExponent ifFalse: [ ^integerPart ]. exponent > 0 ifTrue: [ ^integerPart * (self fiveRaisedTo: exponent) bitShift: exponent ]. ^(Fraction numerator: integerPart denominator: (self fiveRaisedTo: exponent negated)) reduced asFloat timesTwoPower: exponent negated ]. oldLeadingZeroesAllowed := leadingZeroesAllowed. leadingZeroesAllowed := true. fractionPart := self nextUnsignedIntegerOrNil. leadingZeroesAllowed := oldLeadingZeroesAllowed. fractionPart ifNil: [ self error: 'Missing fraction part!!' ]. fractionPart isZero ifTrue: [ self readExponent ifFalse: [ negative ifTrue: [ integerPart isZero ifTrue: [ ^Float negativeZero ]. ^integerPart negated ]. ^integerPart ]. exponent >= 0 ifTrue: [ negative ifTrue: [ integerPart := integerPart negated ]. ^integerPart * (self fiveRaisedTo: exponent) bitShift: exponent ]. value := self makeFloatFromMantissa: integerPart exponent: exponent. negative ifTrue: [ ^value negated ]. ^value ]. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. numberOfNonZeroFractionDigits := lastNonZero. self readExponent. exponent := exponent - numberOfNonZeroFractionDigits. mantissa := (integerPart * (self fiveRaisedTo: numberOfNonZeroFractionDigits) bitShift: numberOfNonZeroFractionDigits) + (fractionPart // (self fiveRaisedTo: numberOfTrailingZeroInFractionPart) bitShift: 0 - numberOfTrailingZeroInFractionPart). value := self makeFloatFromMantissa: mantissa exponent: exponent. negative ifTrue: [ ^value negated ]. ^value! ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') ----- nextUnsignedIntegerOrNil "Form an unsigned integer with incoming digits from sourceStream. Answer this integer, or nil if no digit found. Count the number of digits and the position of lastNonZero digit and store them in instVar" | nPackets high nDigitsHigh lastNonZeroHigh low | "read no more digits than one elementary LargeInteger" high := self nextElementaryLargeInteger. nDigits = 0 ifTrue: [^nil]. "Not enough digits to form a LargeInteger, stop iteration" high isLarge ifFalse: [^high]. "We now have to engage arithmetic with LargeInteger Decompose the integer in a high and low packets of growing size:" nPackets := 1. nDigitsHigh := nDigits. lastNonZeroHigh := lastNonZero. [ low := self nextLargeIntegerBase: 10 nPackets: nPackets . high := (high * (self fiveRaisedTo: nDigits) bitShift: nDigits) + low. lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh]. nDigitsHigh := nDigitsHigh + nDigits. low isLarge] whileTrue: [nPackets := nPackets * 2]. nDigits := nDigitsHigh. lastNonZero := lastNonZeroHigh. ^high! ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: stream self printOn: stream showingDecimalPlaces: scale! ----- 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: $]! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>assertIncompleteJson: (in category 'helpers') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'helpers') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- Method: JsonTests>>json:equals: (in category 'helpers') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'helpers') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'helpers') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'helpers') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- testAtomNumber self json: '1' equals: 1. self json: '123' equals: 123. self should: [ self json: '0123' equals: 123 ] raise: JsonSyntaxError. "No leading zeroes." 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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>>testDictionaryClass (in category 'tests') ----- testDictionaryClass | parser | parser := Json new. self assert: (parser readFrom: '{}' readStream) class == JsonObject. parser dictionaryClass: OrderedJsonObject. self assert: (parser readFrom: '{}' readStream) class == OrderedJsonObject. self assert: (parser readFrom: '{"x":{"y":{}}}' readStream) x y class == OrderedJsonObject! ----- Method: JsonTests>>testIncomplete (in category 'tests') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'tests') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'tests') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testJsonObjectAtPutReturnsTheObject (in category 'tests') ----- testJsonObjectAtPutReturnsTheObject { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self assert: (json at: 'foo' put: 1) == json. self assert: (json foo: 1) == json ]! ----- Method: JsonTests>>testMissingCtor (in category 'tests') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'tests') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testNonStringKeysRaiseError (in category 'tests') ----- testNonStringKeysRaiseError { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self should: [ json at: 1 put: 1 ] raise: Error. self assert: json isEmpty. json at: '1' put: 1. self assert: 1 equals: (json at: '1') ]! ----- Method: JsonTests>>testStreaming (in category 'tests') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: JsonObject new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'tests') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- Method: JsonTests>>testWriteAssociation (in category 'tests') ----- 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 'tests') ----- 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: String>>asSerializedJson (in category '*JSON') ----- asSerializedJson " Assume that the receiver is a valid serialized json string. Return an object that understands #jsonWriteOn: and will write this string on its argument. " ^SerializedJson on: self! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | index start | aStream nextPut: $". start := 1. [ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [ aStream next: index - start putAll: self startingAt: start. aStream nextPutAll: (Json escapeForCharacter: (self at: index)). start := index + 1 ]. start <= self size ifTrue: [ aStream next: self size + 1 - start putAll: self startingAt: start ]. aStream nextPut: $". ! ----- Method: String>>parseAsJson (in category '*JSON') ----- parseAsJson "Convenience" ^Json readFrom: self readStream! ----- Method: String>>parseAsOrderedJson (in category '*JSON') ----- parseAsOrderedJson "Convenience" ^Json new dictionaryClass: OrderedJsonObject; readFrom: self readStream! Object subclass: #Json instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap dictionaryClass' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray escapeSet'! !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0! I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries. The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects. Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct. Instance Variables stream: <PositionableStream> currentCharacter: <Character> arrayBufferStream: <WriteStream> stringBufferStream: <ReadWriteStream> numberParser: <ExtendedNumberParser> ctorMap: <Dictionary> For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream. arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one. stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this. numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it. ctorMap is the Dictionary holding the constructor classes by name. arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time. For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:. ! Json class instanceVariableNames: 'escapeArray escapeSet'! ----- Method: Json class>>escapeForCharacter: (in category 'accessing') ----- escapeForCharacter: c | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^nil! ----- Method: Json class>>escapeSet (in category 'accessing') ----- escapeSet ^escapeSet! ----- Method: Json class>>initialize (in category 'class initialization') ----- initialize "Json initialize." | newEscapeArray newEscapeSet | newEscapeArray := Array new: 128. newEscapeSet := CharacterSet new. (0 to: 31), #(127) do: [ :each | newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0). newEscapeSet add: (Character value: each) ]. { $" -> '\"'. $\ -> '\\'. $/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>." Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | newEscapeArray at: each key asciiValue + 1 put: each value. newEscapeSet add: each key ]. escapeArray := newEscapeArray. escapeSet := newEscapeSet! ----- Method: Json class>>mimeType (in category 'accessing') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'instance creation') ----- 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>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'rendering') ----- render: anObject ^String streamContents: [ :stream | anObject jsonWriteOn: stream ]! ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') ----- 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>>arrayBufferStream (in category 'private') ----- arrayBufferStream ^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]! ----- Method: Json>>consume: (in category 'private') ----- consume: aString | message | 1 to: aString size do: [ :index | (currentCharacter := stream next) == (aString at: index) ifFalse: [ message := 'Expected ', (aString at: index) printString. currentCharacter ifNil: [ self incomplete: message ] ifNotNil: [ self invalid: message ] ] ]. currentCharacter := stream next! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap := m! ----- Method: Json>>dictionaryClass: (in category 'accessing') ----- dictionaryClass: aClass "This method allows you to override the default dictionary class to be created while parsing a stream. Instances of aClass are expected to understand #at:put:." dictionaryClass := aClass! ----- Method: Json>>error: (in category 'error handling') ----- error: aString (currentCharacter isNil and: [ stream atEnd ]) ifTrue: [ self incomplete: aString ] ifFalse: [ self invalid: aString ]! ----- Method: Json>>incomplete: (in category 'error handling') ----- incomplete: aString JsonIncompleteError signal: aString! ----- Method: Json>>initialize (in category 'initialize-release') ----- initialize dictionaryClass := JsonObject ! ----- Method: Json>>interpretStringEscape: (in category 'private') ----- interpretStringEscape: aCharacter aCharacter == $b ifTrue: [ ^Character backspace ]. aCharacter == $n ifTrue: [ ^Character lf ]. aCharacter == $f ifTrue: [ ^Character newPage ]. aCharacter == $r ifTrue: [ ^Character cr ]. aCharacter == $t ifTrue: [ ^Character tab ]. aCharacter == $u ifTrue: [ ^self unescapeUnicode ]. aCharacter == $" ifTrue: [ ^aCharacter ]. aCharacter == $\ ifTrue: [ ^aCharacter ]. aCharacter == $/ ifTrue: [ ^aCharacter ]. self error: 'Unexpected escaped character: ', aCharacter asString ! ----- Method: Json>>invalid: (in category 'error handling') ----- invalid: aString JsonInvalidError signal: aString! ----- Method: Json>>readAny (in category 'private') ----- readAny self skipWhitespace. currentCharacter == ${ ifTrue: [ ^self readDictionary ]. currentCharacter == $[ ifTrue: [ ^self readArray ]. currentCharacter == $" ifTrue: [ ^self readString ]. currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ]. currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ]. currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ]. currentCharacter == $- ifTrue: [ ^self readNumber: true ]. (#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [ ^self readNumber: false ]. currentCharacter == $@ ifTrue: [ ^self readConstructor ]. self invalid: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | initialPosition | currentCharacter := stream next. self skipWhitespace. currentCharacter == $] ifTrue: [ currentCharacter := stream next. ^#() ]. initialPosition := self arrayBufferStream position. [ arrayBufferStream nextPut: self readAny. self skipWhitespace. currentCharacter == $] ifTrue: [ | result | result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position. arrayBufferStream position: initialPosition. currentCharacter := stream next. ^result ]. currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ]. currentCharacter := stream next ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor ctorMap ifNil: [ ^self error: 'No constructors were declared.' ]. self resetStringBufferStream. [ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [ stringBufferStream nextPut: currentCharacter ]. (ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor | ^constructor constructFromJson: self readAny ]. self error: 'Unknown constructor: ', stringBufferStream contents! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | result key commaNeeded | result := dictionaryClass new. commaNeeded := false. currentCharacter := stream next. [ self skipWhitespace. currentCharacter == $} ifTrue: [ currentCharacter := stream next. ^result ]. commaNeeded ifFalse: [ commaNeeded := true ] ifTrue: [ currentCharacter == $, ifFalse: [ self error: 'Missing comma' ]. currentCharacter := stream next. self skipWhitespace ]. currentCharacter == $" ifFalse: [ self error: 'Key in dictionary must be string' ]. key := self readString. self skipWhitespace. currentCharacter == $: ifFalse: [ self error: 'Missing colon' ]. currentCharacter := stream next. result at: key put: self readAny ] repeat! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream | result | stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next. result := self readAny. currentCharacter ifNotNil: [ stream skip: -1 ]. "Undo prereading." ^result! ----- Method: Json>>readNumber: (in category 'private') ----- readNumber: negative | result | negative ifFalse: [ stream skip: -1 ]. result := (numberParser ifNil: [ numberParser := JsonNumberParser new on: stream; failBlock: [ self error: 'Invalid number.' ]; yourself ]) nextNumber: negative. currentCharacter := stream next. ^result ! ----- Method: Json>>readString (in category 'private') ----- readString self resetStringBufferStream. [ currentCharacter := stream next ifNil: [self incomplete: 'Unexpected end of string' ]. currentCharacter == $" ifTrue: [ currentCharacter := stream next. ^stringBufferStream contents ]. currentCharacter == $\ ifTrue: [ stringBufferStream nextPut: (self interpretStringEscape: (stream next ifNil: [ self incomplete: 'Unexpected end of string' ])) ] ifFalse: [ stringBufferStream nextPut: currentCharacter ] ] repeat! ----- Method: Json>>resetStringBufferStream (in category 'private') ----- resetStringBufferStream stringBufferStream ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ] ifNotNil: [ stringBufferStream resetToStart ]! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace currentCharacter ifNil: [ self incomplete: 'Input stream is empty' ]. [ currentCharacter isSeparator ] whileTrue: [ currentCharacter := stream next ifNil: [ self incomplete: 'Input stream is empty' ]. ]! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'private') ----- stream: aStream "For testing purposes only" stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode | code digitValue | code := 0. 1 to: 4 do: [ :index | (digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [ self invalid: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ code := code * 16 + digitValue ] ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ]. ^Character value: code! 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 ]! Object subclass: #SerializedJson instanceVariableNames: 'jsonString' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: SerializedJson class>>on: (in category 'instance creation') ----- on: aString ^self new jsonString: aString; yourself! ----- Method: SerializedJson>>jsonString (in category 'accessing') ----- jsonString ^jsonString ! ----- Method: SerializedJson>>jsonString: (in category 'accessing') ----- jsonString: aString jsonString := aString ! ----- Method: SerializedJson>>jsonWriteOn: (in category 'json-writing') ----- jsonWriteOn: stream stream nextPutAll: jsonString!

1 0

The Trunk: JSON-ul.54.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.54.mcz ==================== Summary ==================== Name: JSON-ul.54 Author: ul Time: 30 May 2020, 4:52:22.332812 am UUID: 76e4e8be-cb72-4d09-9a5d-c27622b213c6 Ancestors: JSON-ul.53 - further improved number parser performance and fixed precision in less common cases ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- 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'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! OrderedDictionary subclass: #OrderedJsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: OrderedJsonObject 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: OrderedJsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: OrderedJsonObject>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ----- Method: OrderedJsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: OrderedJsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: Time>>jsonWriteOn: (in category '*JSON') ----- jsonWriteOn: stream stream nextPut: $". self print24: true showSeconds: true on: stream. stream 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: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: 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>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: JsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^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: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! NumberParser subclass: #JsonNumberParser instanceVariableNames: 'fraction leadingZeroesAllowed' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') ----- allowPlusSign ^false! ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') ----- allowPlusSignInExponent ^true! ----- Method: JsonNumberParser>>error: (in category 'error') ----- error: aString JsonSyntaxError signal: aString! ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') ----- exponentLetters ^'eE'! ----- Method: JsonNumberParser>>fiveRaisedTo: (in category 'parsing-private') ----- fiveRaisedTo: anInteger anInteger >= 0 ifFalse: [ ^1 / (self fiveRaisedTo: 0 - anInteger) ]. anInteger >= 28 ifTrue: [ ^5 raisedToInteger: anInteger ]. ^#(1 5 25 125 625 3125 15625 78125 390625 1953125 9765625 48828125 244140625 1220703125 6103515625 30517578125 152587890625 762939453125 3814697265625 19073486328125 95367431640625 476837158203125 2384185791015625 11920928955078125 59604644775390625 298023223876953125 1490116119384765625 7450580596923828125) at: anInteger + 1! ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') ----- initialize super initialize. base := 10. fraction := Fraction numerator: 0 denominator: 1. leadingZeroesAllowed := false! ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') ----- makeFloatFromMantissa: mantissa exponent: exponent "Return a Float equal to mantissa * 10 ^ exponent." exponent = 0 ifTrue: [ ^mantissa asFloat ]. exponent > 0 ifTrue: [ exponent <= 22 "Can 5 raisedToInteger: exponent be represented exactly as a Float? ((1 << Float precision - 1) log: 5) floor => 22" ifFalse: [ exponent > 324 ifTrue: [ "(Float emax + Float precision * (2 log: 10)) ceiling => 324" mantissa isZero ifTrue: [ ^0.0 ]. mantissa positive ifTrue: [ ^Float infinity ]. ^Float negativeInfinity ]. ^(mantissa * (self fiveRaisedTo: exponent)) asFloat timesTwoPower: exponent ] ifTrue: [ mantissa highBitOfMagnitude <= Float precision ifTrue: [ "Mantissa can also be represented as an exact Float. Float >> #* should be exact." ^mantissa asFloat * (self fiveRaisedTo: exponent) asFloat timesTwoPower: exponent ] ]. ^(mantissa * (self fiveRaisedTo: exponent)) asFloat timesTwoPower: exponent ]. "exponent < 0" exponent >= -22 "Can 5 raisedToInteger: 0 - exponent be represented exactly as a Float?" ifTrue: [ mantissa highBitOfMagnitude <= Float precision ifTrue: [ "Mantissa can also be represented as an exact Float. Float >> #/ should be exact." ^mantissa asFloat / (self fiveRaisedTo: 0 - exponent) asFloat timesTwoPower: exponent ] ] ifFalse: [ exponent < -324 ifTrue: [ "-1 * (Float precision - Float emin * (2 log: 10)) ceiling => -324" mantissa positive ifTrue: [ ^0.0 ]. ^-0.0 ] ]. "No luck. Let Fraction >> #asFloat do the heavy lifting." ^(fraction setNumerator: mantissa denominator: ((self fiveRaisedTo: 0 - exponent) bitShift: 0 - exponent)) asFloat "Can't use #timesTwoPower: here. No #reduced here, because there's none in NumberParser either"! ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') ----- nextElementaryLargeInteger "Form an unsigned integer with incoming digits from sourceStream. Return this integer, or zero if no digits found. Stop reading if end of digits or if a LargeInteger is formed. Count the number of digits and the position of lastNonZero digit and store them in instVar." | digit value | value := 0. nDigits := 0. lastNonZero := 0. [ value isLarge ifTrue: [ ^value ]. ((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 or: [ digit >= 10 ]) ifTrue: [ sourceStream skip: -1. ^value ]. nDigits := nDigits + 1. digit = 0 ifFalse: [ (lastNonZero = 0 and: [ nDigits > 1 and: [ leadingZeroesAllowed not ] ]) ifTrue: [ self error: 'Leading zeroes are not allowed.' ]. lastNonZero := nDigits. value := value * 10 + digit ] ifTrue: [ value := value * 10 ] ] repeat! ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') ----- nextNumber: negative | numberOfTrailingZeroInIntegerPart oldLeadingZeroesAllowed numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value | integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $.) ifFalse: [ "No fraction part" negative ifTrue: [ integerPart := integerPart negated ]. self readExponent ifFalse: [ ^integerPart ]. exponent > 0 ifTrue: [ ^integerPart * (self fiveRaisedTo: exponent) bitShift: exponent ]. ^self makeFloatFromMantissa: integerPart exponent: exponent ]. oldLeadingZeroesAllowed := leadingZeroesAllowed. leadingZeroesAllowed := true. fractionPart := self nextUnsignedIntegerOrNil. leadingZeroesAllowed := oldLeadingZeroesAllowed. fractionPart ifNil: [ self error: 'Missing fraction part!!' ]. fractionPart isZero ifTrue: [ self readExponent ifFalse: [ negative ifTrue: [ integerPart isZero ifTrue: [ ^Float negativeZero ]. ^integerPart negated ]. ^integerPart ]. exponent >= 0 ifTrue: [ negative ifTrue: [ integerPart := integerPart negated ]. ^integerPart * (self fiveRaisedTo: exponent) bitShift: exponent ]. value := self makeFloatFromMantissa: integerPart exponent: exponent. negative ifTrue: [ ^value negated ]. ^value ]. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. numberOfNonZeroFractionDigits := lastNonZero. self readExponent. exponent := exponent - numberOfNonZeroFractionDigits. mantissa := (integerPart * (self fiveRaisedTo: numberOfNonZeroFractionDigits) bitShift: numberOfNonZeroFractionDigits) + (fractionPart // (self fiveRaisedTo: numberOfTrailingZeroInFractionPart) bitShift: 0 - numberOfTrailingZeroInFractionPart). value := self makeFloatFromMantissa: mantissa exponent: exponent. negative ifTrue: [ ^value negated ]. ^value! ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') ----- nextUnsignedIntegerOrNil "Form an unsigned integer with incoming digits from sourceStream. Answer this integer, or nil if no digit found. Count the number of digits and the position of lastNonZero digit and store them in instVar" | nPackets high nDigitsHigh lastNonZeroHigh low | "read no more digits than one elementary LargeInteger" high := self nextElementaryLargeInteger. nDigits = 0 ifTrue: [^nil]. "Not enough digits to form a LargeInteger, stop iteration" high isLarge ifFalse: [^high]. "We now have to engage arithmetic with LargeInteger Decompose the integer in a high and low packets of growing size:" nPackets := 1. nDigitsHigh := nDigits. lastNonZeroHigh := lastNonZero. [ low := self nextLargeIntegerBase: 10 nPackets: nPackets . high := (high * (self fiveRaisedTo: nDigits) bitShift: nDigits) + low. lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh]. nDigitsHigh := nDigitsHigh + nDigits. low isLarge] whileTrue: [nPackets := nPackets * 2]. nDigits := nDigitsHigh. lastNonZero := lastNonZeroHigh. ^high! ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: stream self printOn: stream showingDecimalPlaces: scale! ----- 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: $]! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>assertIncompleteJson: (in category 'helpers') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'helpers') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- Method: JsonTests>>json:equals: (in category 'helpers') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: readValue = aValue.! ----- Method: JsonTests>>readFrom: (in category 'helpers') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'helpers') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'helpers') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- testAtomNumber self json: '1' equals: 1. self json: '123' equals: 123. self should: [ self json: '0123' equals: 123 ] raise: JsonSyntaxError. "No leading zeroes." 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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>>testDictionaryClass (in category 'tests') ----- testDictionaryClass | parser | parser := Json new. self assert: (parser readFrom: '{}' readStream) class == JsonObject. parser dictionaryClass: OrderedJsonObject. self assert: (parser readFrom: '{}' readStream) class == OrderedJsonObject. self assert: (parser readFrom: '{"x":{"y":{}}}' readStream) x y class == OrderedJsonObject! ----- Method: JsonTests>>testIncomplete (in category 'tests') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'tests') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'tests') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testJsonObjectAtPutReturnsTheObject (in category 'tests') ----- testJsonObjectAtPutReturnsTheObject { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self assert: (json at: 'foo' put: 1) == json. self assert: (json foo: 1) == json ]! ----- Method: JsonTests>>testMissingCtor (in category 'tests') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'tests') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testNonStringKeysRaiseError (in category 'tests') ----- testNonStringKeysRaiseError { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self should: [ json at: 1 put: 1 ] raise: Error. self assert: json isEmpty. json at: '1' put: 1. self assert: 1 equals: (json at: '1') ]! ----- Method: JsonTests>>testStreaming (in category 'tests') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: JsonObject new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'tests') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- Method: JsonTests>>testWriteAssociation (in category 'tests') ----- 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 'tests') ----- 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: String>>asSerializedJson (in category '*JSON') ----- asSerializedJson " Assume that the receiver is a valid serialized json string. Return an object that understands #jsonWriteOn: and will write this string on its argument. " ^SerializedJson on: self! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | index start | aStream nextPut: $". start := 1. [ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [ aStream next: index - start putAll: self startingAt: start. aStream nextPutAll: (Json escapeForCharacter: (self at: index)). start := index + 1 ]. start <= self size ifTrue: [ aStream next: self size + 1 - start putAll: self startingAt: start ]. aStream nextPut: $". ! ----- Method: String>>parseAsJson (in category '*JSON') ----- parseAsJson "Convenience" ^Json readFrom: self readStream! ----- Method: String>>parseAsOrderedJson (in category '*JSON') ----- parseAsOrderedJson "Convenience" ^Json new dictionaryClass: OrderedJsonObject; readFrom: self readStream! Object subclass: #Json instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap dictionaryClass' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray escapeSet'! !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0! I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries. The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects. Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct. Instance Variables stream: <PositionableStream> currentCharacter: <Character> arrayBufferStream: <WriteStream> stringBufferStream: <ReadWriteStream> numberParser: <ExtendedNumberParser> ctorMap: <Dictionary> For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream. arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one. stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this. numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it. ctorMap is the Dictionary holding the constructor classes by name. arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time. For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:. ! Json class instanceVariableNames: 'escapeArray escapeSet'! ----- Method: Json class>>escapeForCharacter: (in category 'accessing') ----- escapeForCharacter: c | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^nil! ----- Method: Json class>>escapeSet (in category 'accessing') ----- escapeSet ^escapeSet! ----- Method: Json class>>initialize (in category 'class initialization') ----- initialize "Json initialize." | newEscapeArray newEscapeSet | newEscapeArray := Array new: 128. newEscapeSet := CharacterSet new. (0 to: 31), #(127) do: [ :each | newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0). newEscapeSet add: (Character value: each) ]. { $" -> '\"'. $\ -> '\\'. $/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>." Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | newEscapeArray at: each key asciiValue + 1 put: each value. newEscapeSet add: each key ]. escapeArray := newEscapeArray. escapeSet := newEscapeSet! ----- Method: Json class>>mimeType (in category 'accessing') ----- mimeType ^ 'application/x-json'! ----- Method: Json class>>newWithConstructors: (in category 'instance creation') ----- 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>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'rendering') ----- render: anObject ^String streamContents: [ :stream | anObject jsonWriteOn: stream ]! ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') ----- 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>>arrayBufferStream (in category 'private') ----- arrayBufferStream ^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]! ----- Method: Json>>consume: (in category 'private') ----- consume: aString | message | 1 to: aString size do: [ :index | (currentCharacter := stream next) == (aString at: index) ifFalse: [ message := 'Expected ', (aString at: index) printString. currentCharacter ifNil: [ self incomplete: message ] ifNotNil: [ self invalid: message ] ] ]. currentCharacter := stream next! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap := m! ----- Method: Json>>dictionaryClass: (in category 'accessing') ----- dictionaryClass: aClass "This method allows you to override the default dictionary class to be created while parsing a stream. Instances of aClass are expected to understand #at:put:." dictionaryClass := aClass! ----- Method: Json>>error: (in category 'error handling') ----- error: aString (currentCharacter isNil and: [ stream atEnd ]) ifTrue: [ self incomplete: aString ] ifFalse: [ self invalid: aString ]! ----- Method: Json>>incomplete: (in category 'error handling') ----- incomplete: aString JsonIncompleteError signal: aString! ----- Method: Json>>initialize (in category 'initialize-release') ----- initialize dictionaryClass := JsonObject ! ----- Method: Json>>interpretStringEscape: (in category 'private') ----- interpretStringEscape: aCharacter aCharacter == $b ifTrue: [ ^Character backspace ]. aCharacter == $n ifTrue: [ ^Character lf ]. aCharacter == $f ifTrue: [ ^Character newPage ]. aCharacter == $r ifTrue: [ ^Character cr ]. aCharacter == $t ifTrue: [ ^Character tab ]. aCharacter == $u ifTrue: [ ^self unescapeUnicode ]. aCharacter == $" ifTrue: [ ^aCharacter ]. aCharacter == $\ ifTrue: [ ^aCharacter ]. aCharacter == $/ ifTrue: [ ^aCharacter ]. self error: 'Unexpected escaped character: ', aCharacter asString ! ----- Method: Json>>invalid: (in category 'error handling') ----- invalid: aString JsonInvalidError signal: aString! ----- Method: Json>>readAny (in category 'private') ----- readAny self skipWhitespace. currentCharacter == ${ ifTrue: [ ^self readDictionary ]. currentCharacter == $[ ifTrue: [ ^self readArray ]. currentCharacter == $" ifTrue: [ ^self readString ]. currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ]. currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ]. currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ]. currentCharacter == $- ifTrue: [ ^self readNumber: true ]. (#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [ ^self readNumber: false ]. currentCharacter == $@ ifTrue: [ ^self readConstructor ]. self invalid: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | initialPosition | currentCharacter := stream next. self skipWhitespace. currentCharacter == $] ifTrue: [ currentCharacter := stream next. ^#() ]. initialPosition := self arrayBufferStream position. [ arrayBufferStream nextPut: self readAny. self skipWhitespace. currentCharacter == $] ifTrue: [ | result | result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position. arrayBufferStream position: initialPosition. currentCharacter := stream next. ^result ]. currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ]. currentCharacter := stream next ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor ctorMap ifNil: [ ^self error: 'No constructors were declared.' ]. self resetStringBufferStream. [ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [ stringBufferStream nextPut: currentCharacter ]. (ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor | ^constructor constructFromJson: self readAny ]. self error: 'Unknown constructor: ', stringBufferStream contents! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | result key commaNeeded | result := dictionaryClass new. commaNeeded := false. currentCharacter := stream next. [ self skipWhitespace. currentCharacter == $} ifTrue: [ currentCharacter := stream next. ^result ]. commaNeeded ifFalse: [ commaNeeded := true ] ifTrue: [ currentCharacter == $, ifFalse: [ self error: 'Missing comma' ]. currentCharacter := stream next. self skipWhitespace ]. currentCharacter == $" ifFalse: [ self error: 'Key in dictionary must be string' ]. key := self readString. self skipWhitespace. currentCharacter == $: ifFalse: [ self error: 'Missing colon' ]. currentCharacter := stream next. result at: key put: self readAny ] repeat! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream | result | stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next. result := self readAny. currentCharacter ifNotNil: [ stream skip: -1 ]. "Undo prereading." ^result! ----- Method: Json>>readNumber: (in category 'private') ----- readNumber: negative | result | negative ifFalse: [ stream skip: -1 ]. result := (numberParser ifNil: [ numberParser := JsonNumberParser new on: stream; failBlock: [ self error: 'Invalid number.' ]; yourself ]) nextNumber: negative. currentCharacter := stream next. ^result ! ----- Method: Json>>readString (in category 'private') ----- readString self resetStringBufferStream. [ currentCharacter := stream next ifNil: [self incomplete: 'Unexpected end of string' ]. currentCharacter == $" ifTrue: [ currentCharacter := stream next. ^stringBufferStream contents ]. currentCharacter == $\ ifTrue: [ stringBufferStream nextPut: (self interpretStringEscape: (stream next ifNil: [ self incomplete: 'Unexpected end of string' ])) ] ifFalse: [ stringBufferStream nextPut: currentCharacter ] ] repeat! ----- Method: Json>>resetStringBufferStream (in category 'private') ----- resetStringBufferStream stringBufferStream ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ] ifNotNil: [ stringBufferStream resetToStart ]! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace currentCharacter ifNil: [ self incomplete: 'Input stream is empty' ]. [ currentCharacter isSeparator ] whileTrue: [ currentCharacter := stream next ifNil: [ self incomplete: 'Input stream is empty' ]. ]! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'private') ----- stream: aStream "For testing purposes only" stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode | code digitValue | code := 0. 1 to: 4 do: [ :index | (digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [ self invalid: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ code := code * 16 + digitValue ] ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ]. ^Character value: code! 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 ]! Object subclass: #SerializedJson instanceVariableNames: 'jsonString' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: SerializedJson class>>on: (in category 'instance creation') ----- on: aString ^self new jsonString: aString; yourself! ----- Method: SerializedJson>>jsonString (in category 'accessing') ----- jsonString ^jsonString ! ----- Method: SerializedJson>>jsonString: (in category 'accessing') ----- jsonString: aString jsonString := aString ! ----- Method: SerializedJson>>jsonWriteOn: (in category 'json-writing') ----- jsonWriteOn: stream stream nextPutAll: jsonString!

1 0

The Trunk: JSON-ul.55.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.55.mcz ==================== Summary ==================== Name: JSON-ul.55 Author: ul Time: 6 September 2020, 2:04:29.148771 am UUID: 67ed013e-3c3f-4407-8171-066e7574c412 Ancestors: JSON-ul.54 - fix #unescapeUnicode when the encoded character value is outside of BMP (reported by Christoph Thiede on squeak-dev) - #unescapeUnicode won't accept invalid unicode surrogate values any more - added a test case to cover the positive case of #unescapeUnicode - fixed Json class >> #mimeType ==================== Snapshot ==================== SystemOrganization addCategory: #JSON! ----- Method: Integer>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream ^ self printOn: aWriteStream base: 10 ! ----- 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'! ----- Method: Number>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream self printOn: aWriteStream base: 10! OrderedDictionary subclass: #OrderedJsonObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: OrderedJsonObject 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: OrderedJsonObject>>at: (in category 'accessing') ----- at: aKey "make it work more like javascript objects" ^ self at: aKey ifAbsent: [nil]! ----- Method: OrderedJsonObject>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: OrderedJsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ----- Method: OrderedJsonObject>>name (in category 'accessing') ----- name "override 'cause Object defines this" ^self at: 'name'! ----- Method: OrderedJsonObject>>value (in category 'accessing') ----- value "override 'cause Object defines this" ^self at: 'value'! ----- Method: Time>>jsonWriteOn: (in category '*JSON') ----- jsonWriteOn: stream stream nextPut: $". self print24: true showSeconds: true on: stream. stream 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: UndefinedObject>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aWriteStream aWriteStream nextPutAll: 'null'! Error subclass: #JsonSyntaxError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonSyntaxError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! Class Json signals (possibly-indirect) instances of me when reading a JSON value from an input stream fails.! JsonSyntaxError subclass: #JsonIncompleteError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonIncompleteError commentStamp: 'tonyg 4/29/2016 11:37' prior: 0! I signal that reading a JSON value failed because more input is required, but that the input seen so far was not incorrect. Compare to JsonInvalidError. Be warned that reading numbers directly out of a stream can be ambiguous!! Consider reading from '1234'. Is the result intended to be 1234, or is there missing input, and the next character will be '5', making the result (possibly) 12345?! JsonSyntaxError subclass: #JsonInvalidError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonInvalidError commentStamp: 'tonyg 4/29/2016 11:06' prior: 0! I signal that reading a JSON value failed because the input didn't match the (extended)JSON grammar implemented by class Json.! ----- Method: 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>>at:put: (in category 'accessing') ----- at: aString put: anObject aString isString ifFalse: [ self error: 'String expected' ]. super at: aString put: anObject. ^self! ----- Method: JsonObject>>doesNotUnderstand: (in category 'error handling') ----- doesNotUnderstand: aMessage | key precedence | key := aMessage selector. (precedence := key precedence) = 1 ifTrue: [ ^self at: key ifAbsent: nil ]. (precedence = 3 and: [ (key indexOf: $:) = key size ]) ifTrue: [ ^self at: key allButLast asSymbol put: aMessage arguments first ]. ^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: True>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream aStream nextPutAll: 'true'! NumberParser subclass: #JsonNumberParser instanceVariableNames: 'fraction leadingZeroesAllowed' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: JsonNumberParser>>allowPlusSign (in category 'accessing') ----- allowPlusSign ^false! ----- Method: JsonNumberParser>>allowPlusSignInExponent (in category 'accessing') ----- allowPlusSignInExponent ^true! ----- Method: JsonNumberParser>>error: (in category 'error') ----- error: aString JsonSyntaxError signal: aString! ----- Method: JsonNumberParser>>exponentLetters (in category 'accessing') ----- exponentLetters ^'eE'! ----- Method: JsonNumberParser>>fiveRaisedTo: (in category 'parsing-private') ----- fiveRaisedTo: anInteger anInteger >= 0 ifFalse: [ ^1 / (self fiveRaisedTo: 0 - anInteger) ]. anInteger >= 28 ifTrue: [ ^5 raisedToInteger: anInteger ]. ^#(1 5 25 125 625 3125 15625 78125 390625 1953125 9765625 48828125 244140625 1220703125 6103515625 30517578125 152587890625 762939453125 3814697265625 19073486328125 95367431640625 476837158203125 2384185791015625 11920928955078125 59604644775390625 298023223876953125 1490116119384765625 7450580596923828125) at: anInteger + 1! ----- Method: JsonNumberParser>>initialize (in category 'initialize-release') ----- initialize super initialize. base := 10. fraction := Fraction numerator: 0 denominator: 1. leadingZeroesAllowed := false! ----- Method: JsonNumberParser>>makeFloatFromMantissa:exponent: (in category 'parsing-private') ----- makeFloatFromMantissa: mantissa exponent: exponent "Return a Float equal to mantissa * 10 ^ exponent." exponent = 0 ifTrue: [ ^mantissa asFloat ]. exponent > 0 ifTrue: [ exponent <= 22 "Can 5 raisedToInteger: exponent be represented exactly as a Float? ((1 << Float precision - 1) log: 5) floor => 22" ifFalse: [ exponent > 324 ifTrue: [ "(Float emax + Float precision * (2 log: 10)) ceiling => 324" mantissa isZero ifTrue: [ ^0.0 ]. mantissa positive ifTrue: [ ^Float infinity ]. ^Float negativeInfinity ]. ^(mantissa * (self fiveRaisedTo: exponent)) asFloat timesTwoPower: exponent ] ifTrue: [ mantissa highBitOfMagnitude <= Float precision ifTrue: [ "Mantissa can also be represented as an exact Float. Float >> #* should be exact." ^mantissa asFloat * (self fiveRaisedTo: exponent) asFloat timesTwoPower: exponent ] ]. ^(mantissa * (self fiveRaisedTo: exponent)) asFloat timesTwoPower: exponent ]. "exponent < 0" exponent >= -22 "Can 5 raisedToInteger: 0 - exponent be represented exactly as a Float?" ifTrue: [ mantissa highBitOfMagnitude <= Float precision ifTrue: [ "Mantissa can also be represented as an exact Float. Float >> #/ should be exact." ^mantissa asFloat / (self fiveRaisedTo: 0 - exponent) asFloat timesTwoPower: exponent ] ] ifFalse: [ exponent < -324 ifTrue: [ "-1 * (Float precision - Float emin * (2 log: 10)) ceiling => -324" mantissa positive ifTrue: [ ^0.0 ]. ^-0.0 ] ]. "No luck. Let Fraction >> #asFloat do the heavy lifting." ^(fraction setNumerator: mantissa denominator: ((self fiveRaisedTo: 0 - exponent) bitShift: 0 - exponent)) asFloat "Can't use #timesTwoPower: here. No #reduced here, because there's none in NumberParser either"! ----- Method: JsonNumberParser>>nextElementaryLargeInteger (in category 'parsing-large int') ----- nextElementaryLargeInteger "Form an unsigned integer with incoming digits from sourceStream. Return this integer, or zero if no digits found. Stop reading if end of digits or if a LargeInteger is formed. Count the number of digits and the position of lastNonZero digit and store them in instVar." | digit value | value := 0. nDigits := 0. lastNonZero := 0. [ value isLarge ifTrue: [ ^value ]. ((digit := (sourceStream next ifNil: [ ^value ]) asInteger - 48 "$0 asInteger") < 0 or: [ digit >= 10 ]) ifTrue: [ sourceStream skip: -1. ^value ]. nDigits := nDigits + 1. digit = 0 ifFalse: [ (lastNonZero = 0 and: [ nDigits > 1 and: [ leadingZeroesAllowed not ] ]) ifTrue: [ self error: 'Leading zeroes are not allowed.' ]. lastNonZero := nDigits. value := value * 10 + digit ] ifTrue: [ value := value * 10 ] ] repeat! ----- Method: JsonNumberParser>>nextNumber: (in category 'parsing-public') ----- nextNumber: negative | numberOfTrailingZeroInIntegerPart oldLeadingZeroesAllowed numberOfTrailingZeroInFractionPart numberOfNonZeroFractionDigits mantissa value | integerPart := self nextUnsignedIntegerOrNil ifNil: [ ^self error: 'Missing integer part!!' ]. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero. (sourceStream peekFor: $.) ifFalse: [ "No fraction part" negative ifTrue: [ integerPart := integerPart negated ]. self readExponent ifFalse: [ ^integerPart ]. exponent > 0 ifTrue: [ ^integerPart * (self fiveRaisedTo: exponent) bitShift: exponent ]. ^self makeFloatFromMantissa: integerPart exponent: exponent ]. oldLeadingZeroesAllowed := leadingZeroesAllowed. leadingZeroesAllowed := true. fractionPart := self nextUnsignedIntegerOrNil. leadingZeroesAllowed := oldLeadingZeroesAllowed. fractionPart ifNil: [ self error: 'Missing fraction part!!' ]. fractionPart isZero ifTrue: [ self readExponent ifFalse: [ negative ifTrue: [ integerPart isZero ifTrue: [ ^Float negativeZero ]. ^integerPart negated ]. ^integerPart ]. exponent >= 0 ifTrue: [ negative ifTrue: [ integerPart := integerPart negated ]. ^integerPart * (self fiveRaisedTo: exponent) bitShift: exponent ]. value := self makeFloatFromMantissa: integerPart exponent: exponent. negative ifTrue: [ ^value negated ]. ^value ]. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero. numberOfNonZeroFractionDigits := lastNonZero. self readExponent. exponent := exponent - numberOfNonZeroFractionDigits. mantissa := (integerPart * (self fiveRaisedTo: numberOfNonZeroFractionDigits) bitShift: numberOfNonZeroFractionDigits) + (fractionPart // (self fiveRaisedTo: numberOfTrailingZeroInFractionPart) bitShift: 0 - numberOfTrailingZeroInFractionPart). value := self makeFloatFromMantissa: mantissa exponent: exponent. negative ifTrue: [ ^value negated ]. ^value! ----- Method: JsonNumberParser>>nextUnsignedIntegerOrNil (in category 'parsing-public') ----- nextUnsignedIntegerOrNil "Form an unsigned integer with incoming digits from sourceStream. Answer this integer, or nil if no digit found. Count the number of digits and the position of lastNonZero digit and store them in instVar" | nPackets high nDigitsHigh lastNonZeroHigh low | "read no more digits than one elementary LargeInteger" high := self nextElementaryLargeInteger. nDigits = 0 ifTrue: [^nil]. "Not enough digits to form a LargeInteger, stop iteration" high isLarge ifFalse: [^high]. "We now have to engage arithmetic with LargeInteger Decompose the integer in a high and low packets of growing size:" nPackets := 1. nDigitsHigh := nDigits. lastNonZeroHigh := lastNonZero. [ low := self nextLargeIntegerBase: 10 nPackets: nPackets . high := (high * (self fiveRaisedTo: nDigits) bitShift: nDigits) + low. lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh]. nDigitsHigh := nDigitsHigh + nDigits. low isLarge] whileTrue: [nPackets := nPackets * 2]. nDigits := nDigitsHigh. lastNonZero := lastNonZeroHigh. ^high! ----- Method: ScaledDecimal>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: stream self printOn: stream showingDecimalPlaces: scale! ----- 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: $]! TestCase subclass: #JsonTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'JSON'! !JsonTests commentStamp: '<historical>' prior: 0! I provide a number of test cases for class Json.! ----- Method: JsonTests>>assertIncompleteJson: (in category 'helpers') ----- assertIncompleteJson: aString self should: [self readFrom: aString] raise: JsonIncompleteError! ----- Method: JsonTests>>assertInvalidJson: (in category 'helpers') ----- assertInvalidJson: aString self should: [self readFrom: aString] raise: JsonInvalidError! ----- Method: JsonTests>>json:equals: (in category 'helpers') ----- json: aString equals: aValue | readValue | readValue := self readFrom: aString. self assert: aValue equals: readValue! ----- Method: JsonTests>>readFrom: (in category 'helpers') ----- readFrom: aString ^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream ! ----- Method: JsonTests>>render:equals: (in category 'helpers') ----- render: anObject equals: aString self assert: (Json render: anObject) = aString! ----- Method: JsonTests>>simpleDummyObject (in category 'helpers') ----- simpleDummyObject ^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! ----- Method: JsonTests>>testArray (in category 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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 'tests') ----- testAtomNumber self json: '1' equals: 1. self json: '123' equals: 123. self should: [ self json: '0123' equals: 123 ] raise: JsonSyntaxError. "No leading zeroes." 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 'tests') ----- 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). self json: '"a\uD834\uDD1Eb"' equals: ({$a. Character value: 16r1D11E. $b} as: String). ! ----- Method: JsonTests>>testAtomTrue (in category 'tests') ----- 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 'tests') ----- 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 'tests') ----- 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>>testDictionaryClass (in category 'tests') ----- testDictionaryClass | parser | parser := Json new. self assert: (parser readFrom: '{}' readStream) class == JsonObject. parser dictionaryClass: OrderedJsonObject. self assert: (parser readFrom: '{}' readStream) class == OrderedJsonObject. self assert: (parser readFrom: '{"x":{"y":{}}}' readStream) x y class == OrderedJsonObject! ----- Method: JsonTests>>testIncomplete (in category 'tests') ----- testIncomplete self assertIncompleteJson: ''. self assertIncompleteJson: ' '. self assertIncompleteJson: ' tr'. self assertIncompleteJson: 'tru'. self assertIncompleteJson: '['. self assertIncompleteJson: '[true'. self assertIncompleteJson: '[true,'. self assertIncompleteJson: '{'. self assertIncompleteJson: '{"hi"'. self assertIncompleteJson: '{"hi":'. self assertIncompleteJson: '{"hi":true'. self assertIncompleteJson: '{"hi":true,'. self assertIncompleteJson: '{"hi":true,"'. self assertIncompleteJson: '"hello'. self assertIncompleteJson: '"hello '. self assertIncompleteJson: '"hello\'. self assertIncompleteJson: '"\u26'.! ----- Method: JsonTests>>testInvalid (in category 'tests') ----- testInvalid self assertInvalidJson: 'x'. self assertInvalidJson: ' x'. self assertInvalidJson: ' trx'. self assertInvalidJson: 'trux'. self assertInvalidJson: '.'. self assertInvalidJson: ':'. self assertInvalidJson: ','. self assertInvalidJson: ']'. self assertInvalidJson: '}'. self assertInvalidJson: '[x'. self assertInvalidJson: '[true t'. self assertInvalidJson: '[true,]'. self assertInvalidJson: '{]'. self assertInvalidJson: '{,'. self assertInvalidJson: '{"hi",'. self assertInvalidJson: '{"hi":x'. self assertInvalidJson: '{"hi":,'. self assertInvalidJson: '{"hi":true "'. self assertInvalidJson: '{"hi":true,}'. self assertInvalidJson: '\u263A'.! ----- Method: JsonTests>>testInvalidUnicodeEscapes (in category 'tests') ----- testInvalidUnicodeEscapes self assertInvalidJson: '"\u26"'. "Note that naively reading four chars runs off the end here, so we might see JsonIncompleteError, which would be wrong." self assertInvalidJson: '"\u2Z"'. self assertInvalidJson: '"\u2Z44"'.! ----- Method: JsonTests>>testJsonObjectAtPutReturnsTheObject (in category 'tests') ----- testJsonObjectAtPutReturnsTheObject { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self assert: (json at: 'foo' put: 1) == json. self assert: (json foo: 1) == json ]! ----- Method: JsonTests>>testMissingCtor (in category 'tests') ----- testMissingCtor self assertInvalidJson: '@Missing[]'! ----- Method: JsonTests>>testMissingCtorNoMap (in category 'tests') ----- testMissingCtorNoMap self should: [Json new readFrom: '@Missing[]' readStream] raise: JsonInvalidError! ----- Method: JsonTests>>testNonStringKeysRaiseError (in category 'tests') ----- testNonStringKeysRaiseError { JsonObject. OrderedJsonObject } do: [ :jsonObjectClass | | json | json := jsonObjectClass new. self should: [ json at: 1 put: 1 ] raise: Error. self assert: json isEmpty. json at: '1' put: 1. self assert: 1 equals: (json at: '1') ]! ----- Method: JsonTests>>testStreaming (in category 'tests') ----- testStreaming | j | j := Json new stream: 'truefalsetrue[]{}1.234 5.678"A""B"nullnull' readStream. self assert: j readAny equals: true. self assert: j readAny equals: false. self assert: j readAny equals: true. self assert: j readAny equals: #(). self assert: j readAny equals: JsonObject new. self assert: j readAny equals: 1.234. self assert: j readAny equals: 5.678. self assert: j readAny equals: 'A'. self assert: j readAny equals: 'B'. self assert: j readAny equals: nil. self assert: j readAny equals: nil.! ----- Method: JsonTests>>testStringWithUnicode (in category 'tests') ----- testStringWithUnicode | unicodeString | unicodeString := (Unicode value: 16r263A) asString. self json: '"\u263A"' equals:unicodeString. self json: '"\u263a"' equals:unicodeString. self json: '"', unicodeString, '"' equals: unicodeString. self render: unicodeString equals: '"', unicodeString, '"'.! ----- Method: JsonTests>>testWriteAssociation (in category 'tests') ----- 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 'tests') ----- 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: String>>asSerializedJson (in category '*JSON') ----- asSerializedJson " Assume that the receiver is a valid serialized json string. Return an object that understands #jsonWriteOn: and will write this string on its argument. " ^SerializedJson on: self! ----- Method: String>>jsonWriteOn: (in category '*JSON-writing') ----- jsonWriteOn: aStream | index start | aStream nextPut: $". start := 1. [ (index := self indexOfAnyOf: Json escapeSet startingAt: start) = 0 ] whileFalse: [ aStream next: index - start putAll: self startingAt: start. aStream nextPutAll: (Json escapeForCharacter: (self at: index)). start := index + 1 ]. start <= self size ifTrue: [ aStream next: self size + 1 - start putAll: self startingAt: start ]. aStream nextPut: $". ! ----- Method: String>>parseAsJson (in category '*JSON') ----- parseAsJson "Convenience" ^Json readFrom: self readStream! ----- Method: String>>parseAsOrderedJson (in category '*JSON') ----- parseAsOrderedJson "Convenience" ^Json new dictionaryClass: OrderedJsonObject; readFrom: self readStream! Object subclass: #Json instanceVariableNames: 'stream currentCharacter arrayBufferStream stringBufferStream numberParser ctorMap dictionaryClass' classVariableNames: '' poolDictionaries: '' category: 'JSON'! Json class instanceVariableNames: 'escapeArray escapeSet'! !Json commentStamp: 'ul 3/29/2016 04:38' prior: 0! I support reading and writing JSON (see http://json.org) formatted data - strings, numbers, boolean, nil, arrays and dictionaries. The implementation is mainly based on RFC 7159 (https://www.ietf.org/rfc/rfc7159.txt). It has been extended with syntax for invoking a prearranged list of constructors on read objects. Character encoding is not handled here. That's something you have to do before reading or after writing. Mixed processing is possible, but it's entirely your responsibility to keep things correct. Instance Variables stream: <PositionableStream> currentCharacter: <Character> arrayBufferStream: <WriteStream> stringBufferStream: <ReadWriteStream> numberParser: <ExtendedNumberParser> ctorMap: <Dictionary> For parsing, stream has to be initialized by sending #readFrom: to my instance. The parser will pre-read one character, which will be stored in currentCharacter, so the stream is expected to support position manipulation, hence it should be a PositionableStream. arrayBufferStream is WriteStream on an Array, which holds the values during array parsing (see #readArray). When there's a recursive call, this stream is used as a stack to separate the elements parsed in the previous invocation from the current one. stringBufferStream is a ReadWriteStream on a String, which holds the currently parsed String (see #readString), the currently parsed number (see #readNumber) or the name of the currently parsed constructor (see #readConstructor). Recursion has no effect on this. numberParser is a cached instance of ExtendedNumberParser. It's initialized on stringBufferStream, so it can quickly parse the number stored in it. ctorMap is the Dictionary holding the constructor classes by name. arrayBufferStream, stringBufferStream and numberParser are initialized lazily, and should not be accessed externally. Since these are shared objects, along with stream and currentCharacter, holding state, therefore a single instance of me shouldn't be used to parse multiple streams at the same time. For writing, you can use the methods in the class-side rendering category. To convert individual objects to a string, you can use #asJsonString, to serialize it on a stream, you can use #jsonWriteOn:. ! Json class instanceVariableNames: 'escapeArray escapeSet'! ----- Method: Json class>>escapeForCharacter: (in category 'accessing') ----- escapeForCharacter: c | asciiValue | (asciiValue := c asciiValue) < 128 ifTrue: [ ^escapeArray at: asciiValue + 1 ]. ^nil! ----- Method: Json class>>escapeSet (in category 'accessing') ----- escapeSet ^escapeSet! ----- Method: Json class>>initialize (in category 'class initialization') ----- initialize "Json initialize." | newEscapeArray newEscapeSet | newEscapeArray := Array new: 128. newEscapeSet := CharacterSet new. (0 to: 31), #(127) do: [ :each | newEscapeArray at: each + 1 put: '\u', (each printStringHex padded: #left to: 4 with: $0). newEscapeSet add: (Character value: each) ]. { $" -> '\"'. $\ -> '\\'. $/ -> '\/'. "A hack, so the generated JSON will always be HTML+Javascript compatible, because the generated JSON will not contain the seqence </script>." Character backspace -> '\b'. Character lf -> '\n'. Character newPage -> '\f'. Character cr -> '\r'. Character tab -> '\t'. } do: [ :each | newEscapeArray at: each key asciiValue + 1 put: each value. newEscapeSet add: each key ]. escapeArray := newEscapeArray. escapeSet := newEscapeSet! ----- Method: Json class>>mimeType (in category 'accessing') ----- mimeType ^'application/json'! ----- Method: Json class>>newWithConstructors: (in category 'instance creation') ----- 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>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^ self new readFrom: aStream.! ----- Method: Json class>>render: (in category 'rendering') ----- render: anObject ^String streamContents: [ :stream | anObject jsonWriteOn: stream ]! ----- Method: Json class>>render:withConstructor:on: (in category 'rendering') ----- render: anObject withConstructor: aConstructorName on: aStream aStream nextPutAll: '@', aConstructorName. anObject jsonWriteOn: aStream. ! ----- Method: Json class>>renderInstanceVariables:of:on: (in category 'rendering') ----- 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>>arrayBufferStream (in category 'private') ----- arrayBufferStream ^arrayBufferStream ifNil: [ arrayBufferStream := (Array new: 10) writeStream ]! ----- Method: Json>>consume: (in category 'private') ----- consume: aString | message | 1 to: aString size do: [ :index | (currentCharacter := stream next) == (aString at: index) ifFalse: [ message := 'Expected ', (aString at: index) printString. currentCharacter ifNil: [ self incomplete: message ] ifNotNil: [ self invalid: message ] ] ]. currentCharacter := stream next! ----- Method: Json>>ctorMap (in category 'accessing') ----- ctorMap ^ ctorMap! ----- Method: Json>>ctorMap: (in category 'accessing') ----- ctorMap: m ctorMap := m! ----- Method: Json>>dictionaryClass: (in category 'accessing') ----- dictionaryClass: aClass "This method allows you to override the default dictionary class to be created while parsing a stream. Instances of aClass are expected to understand #at:put:." dictionaryClass := aClass! ----- Method: Json>>error: (in category 'error handling') ----- error: aString (currentCharacter isNil and: [ stream atEnd ]) ifTrue: [ self incomplete: aString ] ifFalse: [ self invalid: aString ]! ----- Method: Json>>incomplete: (in category 'error handling') ----- incomplete: aString JsonIncompleteError signal: aString! ----- Method: Json>>initialize (in category 'initialize-release') ----- initialize dictionaryClass := JsonObject ! ----- Method: Json>>interpretStringEscape: (in category 'private') ----- interpretStringEscape: aCharacter aCharacter == $b ifTrue: [ ^Character backspace ]. aCharacter == $n ifTrue: [ ^Character lf ]. aCharacter == $f ifTrue: [ ^Character newPage ]. aCharacter == $r ifTrue: [ ^Character cr ]. aCharacter == $t ifTrue: [ ^Character tab ]. aCharacter == $u ifTrue: [ ^self unescapeUnicode ]. aCharacter == $" ifTrue: [ ^aCharacter ]. aCharacter == $\ ifTrue: [ ^aCharacter ]. aCharacter == $/ ifTrue: [ ^aCharacter ]. self error: 'Unexpected escaped character: ', aCharacter asString ! ----- Method: Json>>invalid: (in category 'error handling') ----- invalid: aString JsonInvalidError signal: aString! ----- Method: Json>>readAny (in category 'private') ----- readAny self skipWhitespace. currentCharacter == ${ ifTrue: [ ^self readDictionary ]. currentCharacter == $[ ifTrue: [ ^self readArray ]. currentCharacter == $" ifTrue: [ ^self readString ]. currentCharacter == $t ifTrue: [ self consume: 'rue'. ^true ]. currentCharacter == $f ifTrue: [ self consume: 'alse'. ^false ]. currentCharacter == $n ifTrue: [ self consume: 'ull'. ^nil ]. currentCharacter == $- ifTrue: [ ^self readNumber: true ]. (#($0 $1 $2 $3 $4 $5 $6 $7 $8 $9) instVarsInclude: currentCharacter) ifTrue: [ ^self readNumber: false ]. currentCharacter == $@ ifTrue: [ ^self readConstructor ]. self invalid: 'Unknown Json input'! ----- Method: Json>>readArray (in category 'private') ----- readArray | initialPosition | currentCharacter := stream next. self skipWhitespace. currentCharacter == $] ifTrue: [ currentCharacter := stream next. ^#() ]. initialPosition := self arrayBufferStream position. [ arrayBufferStream nextPut: self readAny. self skipWhitespace. currentCharacter == $] ifTrue: [ | result | result := arrayBufferStream originalContents copyFrom: initialPosition + 1 to: arrayBufferStream position. arrayBufferStream position: initialPosition. currentCharacter := stream next. ^result ]. currentCharacter == $, ifFalse: [ self error: 'Unexpected character: ', currentCharacter asString ]. currentCharacter := stream next ] repeat. ! ----- Method: Json>>readConstructor (in category 'private') ----- readConstructor ctorMap ifNil: [ ^self error: 'No constructors were declared.' ]. self resetStringBufferStream. [ (currentCharacter := stream next) == $. or: [ currentCharacter isLetter ] ] whileTrue: [ stringBufferStream nextPut: currentCharacter ]. (ctorMap at: stringBufferStream contents ifAbsent: nil) ifNotNil: [ :constructor | ^constructor constructFromJson: self readAny ]. self error: 'Unknown constructor: ', stringBufferStream contents! ----- Method: Json>>readDictionary (in category 'private') ----- readDictionary | result key commaNeeded | result := dictionaryClass new. commaNeeded := false. currentCharacter := stream next. [ self skipWhitespace. currentCharacter == $} ifTrue: [ currentCharacter := stream next. ^result ]. commaNeeded ifFalse: [ commaNeeded := true ] ifTrue: [ currentCharacter == $, ifFalse: [ self error: 'Missing comma' ]. currentCharacter := stream next. self skipWhitespace ]. currentCharacter == $" ifFalse: [ self error: 'Key in dictionary must be string' ]. key := self readString. self skipWhitespace. currentCharacter == $: ifFalse: [ self error: 'Missing colon' ]. currentCharacter := stream next. result at: key put: self readAny ] repeat! ----- Method: Json>>readFrom: (in category 'parsing') ----- readFrom: aStream | result | stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next. result := self readAny. currentCharacter ifNotNil: [ stream skip: -1 ]. "Undo prereading." ^result! ----- Method: Json>>readNumber: (in category 'private') ----- readNumber: negative | result | negative ifFalse: [ stream skip: -1 ]. result := (numberParser ifNil: [ numberParser := JsonNumberParser new on: stream; failBlock: [ self error: 'Invalid number.' ]; yourself ]) nextNumber: negative. currentCharacter := stream next. ^result ! ----- Method: Json>>readString (in category 'private') ----- readString self resetStringBufferStream. [ currentCharacter := stream next ifNil: [self incomplete: 'Unexpected end of string' ]. currentCharacter == $" ifTrue: [ currentCharacter := stream next. ^stringBufferStream contents ]. currentCharacter == $\ ifTrue: [ stringBufferStream nextPut: (self interpretStringEscape: (stream next ifNil: [ self incomplete: 'Unexpected end of string' ])) ] ifFalse: [ stringBufferStream nextPut: currentCharacter ] ] repeat! ----- Method: Json>>resetStringBufferStream (in category 'private') ----- resetStringBufferStream stringBufferStream ifNil: [ stringBufferStream := ReadWriteStream on: (String new: 64) ] ifNotNil: [ stringBufferStream resetToStart ]! ----- Method: Json>>skipWhitespace (in category 'private') ----- skipWhitespace currentCharacter ifNil: [ self incomplete: 'Input stream is empty' ]. [ currentCharacter isSeparator ] whileTrue: [ currentCharacter := stream next ifNil: [ self incomplete: 'Input stream is empty' ]. ]! ----- Method: Json>>stream (in category 'accessing') ----- stream "Answer the value of stream" ^ stream! ----- Method: Json>>stream: (in category 'private') ----- stream: aStream "For testing purposes only" stream := aStream. numberParser ifNotNil: [ numberParser on: stream ]. currentCharacter := stream next! ----- Method: Json>>unescapeUnicode (in category 'private') ----- unescapeUnicode | code digitValue lowSurrogateCode | code := 0. 1 to: 4 do: [ :index | (digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [ self invalid: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ code := code * 16 + digitValue ] ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ]. code < 16rD800 ifTrue: [ ^code asCharacter ]. code > 16rDFFF ifTrue: [ ^code asCharacter ]. code <= 16rDBFF ifFalse: [ self invalid: 'High surrogate value expected' ]. "Parse the escaped low surrogate" (stream next ifNil: [ self incomplete: 'Unexpected end of string' ]) == $\ ifFalse: [ self invalid: 'Escaped low surrogate expected.' ]. (stream next ifNil: [ self incomplete: 'Unexpected end of string' ]) == $u ifFalse: [ self invalid: 'Escaped low surrogate expected.' ]. lowSurrogateCode := 0. 1 to: 4 do: [ :index | (digitValue := (stream next ifNil: [ self incomplete: 'Unexpected end of stream' ]) digitValue) < 0 ifTrue: [ self invalid: 'Invalid hexadecimal digit' ]. digitValue < 16 ifTrue: [ lowSurrogateCode := lowSurrogateCode * 16 + digitValue ] ifFalse: [ self invalid: 'Invalid hexadecimal digit' ] ]. (lowSurrogateCode >= 16rDC00 and: [ lowSurrogateCode <= 16rDFFF ]) ifFalse: [ ^self invalid: 'Escaped low surrogate expected.' ]. ^((code - 16rD800 bitShift: 10) + lowSurrogateCode + '16r2400') asCharacter! 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 ]! Object subclass: #SerializedJson instanceVariableNames: 'jsonString' classVariableNames: '' poolDictionaries: '' category: 'JSON'! ----- Method: SerializedJson class>>on: (in category 'instance creation') ----- on: aString ^self new jsonString: aString; yourself! ----- Method: SerializedJson>>jsonString (in category 'accessing') ----- jsonString ^jsonString ! ----- Method: SerializedJson>>jsonString: (in category 'accessing') ----- jsonString: aString jsonString := aString ! ----- Method: SerializedJson>>jsonWriteOn: (in category 'json-writing') ----- jsonWriteOn: stream stream nextPutAll: jsonString!

1 0

Jump to page: