Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: timfel/JSON-st
base: master
...
head fork: lm/json-gst
compare: master
Checking mergeability… Don't worry, you can still create the pull request.
  • 13 commits
  • 35 files changed
  • 0 commit comments
  • 1 contributor
Showing with 650 additions and 828 deletions.
  1. +0 −15 Extensions/Association.st
  2. +0 −14 Extensions/Collection.st
  3. +0 −18 Extensions/Dictionary.st
  4. +0 −9 Extensions/False.st
  5. +0 −9 Extensions/Integer.st
  6. +0 −9 Extensions/Number.st
  7. +0 −9 Extensions/Object.st
  8. +0 −15 Extensions/String.st
  9. +0 −9 Extensions/True.st
  10. +0 −9 Extensions/UndefinedObject.st
  11. +0 −9 Extensions/WriteStream.st
  12. +0 −317 JSON/Json.st
  13. +0 −72 JSON/JsonDummyTestObject.st
  14. +0 −111 JSON/JsonObject.st
  15. +0 −6 JSON/JsonSyntaxError.st
  16. +0 −150 JSON/JsonTests.st
  17. +284 −0 Json/Json.st
  18. +6 −0 Json/JsonSyntaxError.st
  19. +14 −0 Json/extensions/Association.st
  20. +12 −0 Json/extensions/CharacterArray.st
  21. +14 −0 Json/extensions/Collection.st
  22. +21 −0 Json/extensions/Dictionary.st
  23. +10 −0 Json/extensions/False.st
  24. +10 −0 Json/extensions/Integer.st
  25. +42 −0 Json/extensions/Number.st
  26. +10 −0 Json/extensions/Object.st
  27. +10 −0 Json/extensions/True.st
  28. +10 −0 Json/extensions/UndefinedObject.st
  29. +10 −0 Json/extensions/WriteStream.st
  30. +0 −8 README
  31. +9 −0 package
  32. +20 −39 package.xml
  33. +2 −0  readme.txt
  34. +151 −0 tests/JsonTest.st
  35. +15 −0 tests/run
View
15 Extensions/Association.st
@@ -1,15 +0,0 @@
-Association extend [
-
- jsonWriteOn: aStream [
- <category: '*JSON-writing'>
- ((self key isCollection and: [self key isString not])
- ifTrue: ['#', self key printString]
- ifFalse: [self key asString]) jsonWriteOn: aStream.
- aStream
- nextPut: $:;
- space.
- self value jsonWriteOn: aStream
- ]
-
-]
-
View
14 Extensions/Collection.st
@@ -1,14 +0,0 @@
-Collection extend [
-
- jsonWriteOn: aStream [
- "By default, use array braces"
-
- <category: '*json'>
- aStream nextPut: $[.
- self do: [:each | each jsonWriteOn: aStream]
- separatedBy: [aStream nextPut: $,].
- aStream nextPut: $]
- ]
-
-]
-
View
18 Extensions/Dictionary.st
@@ -1,18 +0,0 @@
-Dictionary extend [
-
- jsonWriteOn: aStream [
- <category: '*JSON-writing'>
- | 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: $}
- ]
-
-]
-
View
9 Extensions/False.st
@@ -1,9 +0,0 @@
-False extend [
-
- jsonWriteOn: aStream [
- <category: '*JSON-writing'>
- aStream nextPutAll: 'false'
- ]
-
-]
-
View
9 Extensions/Integer.st
@@ -1,9 +0,0 @@
-Integer extend [
-
- jsonWriteOn: aWriteStream [
- <category: '*JSON-writing'>
- ^self printOn: aWriteStream base: 10
- ]
-
-]
-
View
9 Extensions/Number.st
@@ -1,9 +0,0 @@
-Number extend [
-
- jsonWriteOn: aWriteStream [
- <category: '*JSON-writing'>
- self printOn: aWriteStream base: 10
- ]
-
-]
-
View
9 Extensions/Object.st
@@ -1,9 +0,0 @@
-Object extend [
-
- asJsonString [
- <category: '*JSON'>
- ^String streamContents: [:str | self jsonWriteOn: str]
- ]
-
-]
-
View
15 Extensions/String.st
@@ -1,15 +0,0 @@
-String extend [
-
- jsonWriteOn: aStream [
- <category: '*JSON-writing'>
- | replacement |
- aStream nextPut: $".
- self do:
- [:ch |
- replacement := (Json escapeForCharacter: ch) asString.
- aStream nextPutAll: replacement].
- aStream nextPut: $"
- ]
-
-]
-
View
9 Extensions/True.st
@@ -1,9 +0,0 @@
-True extend [
-
- jsonWriteOn: aStream [
- <category: '*JSON-writing'>
- aStream nextPutAll: 'true'
- ]
-
-]
-
View
9 Extensions/UndefinedObject.st
@@ -1,9 +0,0 @@
-UndefinedObject extend [
-
- jsonWriteOn: aWriteStream [
- <category: '*JSON-writing'>
- aWriteStream nextPutAll: 'null'
- ]
-
-]
-
View
9 Extensions/WriteStream.st
@@ -1,9 +0,0 @@
-WriteStream extend [
-
- jsonPrint: anObject [
- <category: '*json-printing'>
- anObject jsonWriteOn: self
- ]
-
-]
-
View
317 JSON/Json.st
@@ -1,317 +0,0 @@
-Object subclass: Json [
- | stream ctorMap |
-
- <category: 'JSON'>
- <comment: 'This class reads and writes JSON format data - strings, numbers, boolean, nil, arrays and dictionaries. See http://www.crockford.com/JSON/index.html. It has been extended with syntax for invoking a prearranged list of constructors on read objects.'>
-
- Json class [
- | escapeArray |
-
- ]
-
- Json class >> escapeForCharacter: c [
- | index |
- ^(index := c asciiValue + 1) <= escapeArray size
- ifTrue: [escapeArray at: index]
- ifFalse: [c]
- ]
-
- Json class >> initialize [
- "Json initialize."
-
- | tmpStr |
- escapeArray := (1 to: 128) collect: [:i | Character value: i - 1].
- (0 to: 31) , #(127) do:
- [:each |
- tmpStr := String streamContents: [:str | each printOn: str base: 16].
- escapeArray at: each + 1
- put: '\u' , (String new: (4 - tmpStr size max: 0) withAll: $0) , tmpStr].
-
- {$" -> '\"'.
- $\ -> '\\'.
- Character backspace -> '\b'.
- Character lf -> '\n'.
- Character newPage -> '\f'.
- Character cr -> '\r'.
- Character tab -> '\t'}
- do: [:each | escapeArray at: each key asciiValue + 1 put: each value]
- ]
-
- Json class >> mimeType [
- ^'application/x-json'
- ]
-
- Json class >> 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
- ]
-
- Json class >> numbersMayContain: aChar [
- ^aChar isDigit or: [#($- $+ $. $e $E) includes: aChar]
- ]
-
- Json class >> readFrom: aStream [
- ^self new readFrom: aStream
- ]
-
- Json class >> render: anObject [
- | s |
- s := WriteStream on: String new.
- anObject jsonWriteOn: s.
- ^s contents
- ]
-
- Json class >> render: anObject withConstructor: aConstructorName on: aStream [
- aStream nextPutAll: '@' , aConstructorName.
- anObject jsonWriteOn: aStream
- ]
-
- Json class >> 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
- ]
-
- consume: aString returning: anObject [
- <category: 'private'>
- aString do:
- [:c |
- stream next == c
- ifFalse: [JsonSyntaxError signal: 'Expected ''' , aString , '''']].
- ^anObject
- ]
-
- interpretStringEscape [
- <category: 'private'>
- | c |
- c := stream next.
- c == $b ifTrue: [^Character backspace asString].
- c == $n ifTrue: [^Character lf asString].
- c == $f ifTrue: [^Character newPage asString].
- c == $r ifTrue: [^Character cr asString].
- c == $t ifTrue: [^Character tab asString].
- c == $u ifTrue: [^self unescapeUnicode asUnicodeString asString].
- ^c asUnicodeString asString
- ]
-
- readArray [
- <category: 'private'>
- | a |
- a := OrderedCollection new.
- self skipWhitespace.
- (stream peekFor: $]) ifTrue: [^#()].
-
- [a add: self readAny.
- self skipWhitespace.
- (stream peekFor: $]) ifTrue: [^a asArray].
- (stream peekFor: $,) ifFalse: [JsonSyntaxError signal: 'Missing comma']]
- repeat
- ]
-
- readConstructor [
- <category: 'private'>
- | s c v ctor |
- s := WriteStream on: ''.
-
- [c := stream peek.
- c
- ifNil: [JsonSyntaxError signal: 'Premature EOF reading constructor name'].
- (c == $. or: [c isLetter])
- ifTrue:
- [s nextPut: c.
- stream next]
- ifFalse:
- [v := self readAny.
- s := s contents.
- ctor := ctorMap ifNotNil: [:foo | ctor := ctorMap at: s ifAbsent: [nil]].
- ctor ifNil: [JsonSyntaxError signal: 'Unknown ctor ' , s].
- ^ctor constructFromJson: v]]
- repeat
- ]
-
- readDictionary [
- <category: 'private'>
- | m k v needComma |
- m := JsonObject new.
- needComma := false.
-
- [self skipWhitespace.
- (stream peekFor: $}) ifTrue: [^m].
- needComma
- ifTrue:
- [(stream peekFor: $,) ifFalse: [JsonSyntaxError signal: 'Missing comma'].
- self skipWhitespace]
- ifFalse: [needComma := true].
- "k := self readAny."
- (stream peekFor: $")
- ifFalse: [JsonSyntaxError signal: 'Key in dictionary must be string'].
- k := self readString.
- self skipWhitespace.
- (stream peekFor: $:) ifFalse: [JsonSyntaxError signal: 'Missing colon'].
- v := self readAny.
- m at: k put: v]
- repeat
- ]
-
- readNumber [
- <category: 'private'>
- | acc c |
- acc := WriteStream on: ''.
-
- [c := stream peek.
- (c isNil not and: [Json numbersMayContain: c])
- ifFalse:
- [[^acc contents asNumber] on: Error
- do: [JsonSyntaxError signal: 'Invalid number']].
- acc nextPut: c.
- stream next]
- repeat
- ]
-
- readString [
- <category: 'private'>
- | s c |
- s := WriteStream on: ''.
-
- [c := stream next.
- c == $\
- ifTrue: [s nextPutAll: self interpretStringEscape]
- ifFalse:
- [c == $" ifTrue: [^s contents].
- s nextPut: c]]
- repeat
- ]
-
- skipComment [
- <category: 'private'>
- stream peek == $/
- ifTrue:
- [stream next.
- stream peek == $/
- ifTrue: [self skipToEndOfLine]
- ifFalse:
- [stream peek == $*
- ifTrue:
- [stream next.
- self skipCommentBody]
- ifFalse: [JsonSyntaxError signal: 'Invalid comment syntax']]]
- ]
-
- skipCommentBody [
- <category: 'private'>
-
- [[stream next == $*] whileFalse.
- stream peek == $/] whileFalse.
- stream next. "skip that last slash"
- self skipWhitespace
- ]
-
- skipToEndOfLine [
- <category: 'private'>
- | cr lf |
- cr := Character cr.
- lf := Character lf.
-
- [| c |
- (c := stream peek) == cr or: [c == lf]] whileFalse: [stream next].
- self skipWhitespace
- ]
-
- skipWhitespace [
- <category: 'private'>
- [stream peek isSeparator] whileTrue: [stream next].
- self skipComment
- ]
-
- unescapeUnicode [
- <category: 'private'>
- | string |
- string := (String
- with: stream next
- with: stream next
- with: stream next
- with: stream next) asUppercase.
- ^Character codePoint: (Integer readFrom: string readStream radix: 16)
- ]
-
- ctorMap [
- <category: 'accessing'>
- ^ctorMap
- ]
-
- ctorMap: m [
- <category: 'accessing'>
- ctorMap := m
- ]
-
- stream [
- "Answer the value of stream"
-
- <category: 'accessing'>
- ^stream
- ]
-
- stream: anObject [
- "Set the value of stream"
-
- <category: 'accessing'>
- stream := anObject.
- (stream respondsTo: #reset) ifTrue: [stream reset]
- ]
-
- readAny [
- "This is the main entry point for the JSON parser. See also readFrom: on the class side."
-
- <category: 'parsing'>
- | c |
- self skipWhitespace.
- c := stream peek asLowercase.
- c == ${
- ifTrue:
- [stream next.
- ^self readDictionary].
- c == $[
- ifTrue:
- [stream next.
- ^self readArray].
- c == $"
- ifTrue:
- [stream next.
- ^self readString].
- c == $t ifTrue: [^self consume: 'true' returning: true].
- c == $f ifTrue: [^self consume: 'false' returning: false].
- c == $n ifTrue: [^self consume: 'null' returning: nil].
- c == $@
- ifTrue:
- [stream next.
- ^self readConstructor].
- (Json numbersMayContain: c) ifTrue: [^self readNumber].
- JsonSyntaxError signal: 'Unknown Json input'
- ]
-
- readFrom: aStream [
- <category: 'parsing'>
- self stream: aStream.
- ^self readAny
- ]
-]
-
-
-
-Eval [
- Json initialize
-]
-
View
72 JSON/JsonDummyTestObject.st
@@ -1,72 +0,0 @@
-Object subclass: JsonDummyTestObject [
- | a b c |
-
- <category: 'JSON'>
- <comment: nil>
-
- JsonDummyTestObject class >> constructFromJson: j [
- ^(self new)
- a: (j at: 'a');
- b: (j at: 'b');
- c: (j at: 'c');
- yourself
- ]
-
- = other [
- ^other class == self class
- and: [a = other a and: [b = other b and: [c = other c]]]
- ]
-
- jsonWriteOn: s [
- Json
- renderInstanceVariables:
- {#a.
- #b.
- #c}
- of: self
- on: s
- ]
-
- a [
- "Answer the value of a"
-
- <category: 'accessing'>
- ^a
- ]
-
- a: anObject [
- "Set the value of a"
-
- <category: 'accessing'>
- a := anObject
- ]
-
- b [
- "Answer the value of b"
-
- <category: 'accessing'>
- ^b
- ]
-
- b: anObject [
- "Set the value of b"
-
- <category: 'accessing'>
- b := anObject
- ]
-
- c [
- "Answer the value of c"
-
- <category: 'accessing'>
- ^c
- ]
-
- c: anObject [
- "Set the value of c"
-
- <category: 'accessing'>
- c := anObject
- ]
-]
-
View
111 JSON/JsonObject.st
@@ -1,111 +0,0 @@
-Object subclass: JsonObject [
- | dictionary |
-
- <category: 'JSON'>
- <comment: nil>
-
- JsonObject class >> fromAssociations: collectionOfAssociations [
- | result |
- result := Dictionary new.
- collectionOfAssociations do: [:each | result at: each key put: each value].
- ^(self new)
- dictionary: result;
- yourself
- ]
-
- at: aKey [
- "make it work more like javascript objects"
-
- <category: 'accessing'>
- ^self at: aKey ifAbsent: [nil]
- ]
-
- dictionary [
- <category: 'accessing'>
- dictionary ifNil: [dictionary := Dictionary new].
- ^dictionary
- ]
-
- dictionary: aDictionary [
- <category: 'accessing'>
- aDictionary ifNotNil: [:foo | dictionary := aDictionary]
- ]
-
- = aJsonObject [
- <category: 'overrides-to-dictionary'>
- ^aJsonObject dictionary = self dictionary
- ]
-
- at: aKey put: aValue [
- "override cause object defines this"
-
- <category: 'overrides-to-dictionary'>
- ^self dictionary at: aKey put: aValue
- ]
-
- bindingOf: varName [
- <category: 'overrides-to-dictionary'>
- ^self dictionary bindingOf: varName
- ]
-
- flattenOnStream: aStream [
- <category: 'overrides-to-dictionary'>
- ^self dictionary flattenOnStream: aStream
- ]
-
- isDictionary [
- <category: 'overrides-to-dictionary'>
- ^true
- ]
-
- javascriptOn: aStream [
- <category: 'overrides-to-dictionary'>
- self dictionary javascriptOn: aStream
- ]
-
- jsonOn: aStream [
- <category: 'overrides-to-dictionary'>
- self dictionary jsonOn: aStream
- ]
-
- name [
- "override 'cause Object defines this"
-
- <category: 'overrides-to-dictionary'>
- ^self at: 'name'
- ]
-
- storeOn: aStream [
- <category: 'overrides-to-dictionary'>
- ^self dictionary storeOn: aStream
- ]
-
- value [
- "override 'cause Object defines this"
-
- <category: 'overrides-to-dictionary'>
- ^self at: 'value'
- ]
-
- doesNotUnderstand: aMessage [
- | key result |
-
- [result := aMessage sendTo: self dictionary.
- ^result]
- on: MessageNotUnderstood
- do:
- [key := aMessage selector.
- key isUnary ifTrue: [^self at: key].
- ^(key isKeyword and: [(key occurrencesOf: $:) = 1])
- ifTrue:
- [key := key allButLast asSymbol.
- self dictionary at: key put: aMessage arguments first]
- ifFalse: [super doesNotUnderstand: aMessage]]
- ]
-
- initialize [
- super initialize.
- dictionary := Dictionary new
- ]
-]
-
View
6 JSON/JsonSyntaxError.st
@@ -1,6 +0,0 @@
-Error subclass: JsonSyntaxError [
-
- <category: 'JSON'>
- <comment: 'Class Json signals instances of me when an input stream contains invalid JSON input.'>
-]
-
View
150 JSON/JsonTests.st
@@ -1,150 +0,0 @@
-TestCase subclass: JsonTests [
-
- <comment: 'I provide a number of test cases for class Json.'>
- <category: 'JSON'>
-
- json: aString equals: aValue [
- | readValue |
- readValue := self readFrom: aString.
- self assert: readValue = aValue
- description: readValue printString , ' = ' , aValue printString
- ]
-
- readFrom: aString [
- ^(Json newWithConstructors: {JsonDummyTestObject})
- readFrom: aString readStream
- ]
-
- render: anObject equals: aString [
- self assert: (Json render: anObject) = aString
- description: 'Json render ' , anObject printString , ' = ' , aString
- ]
-
- simpleDummyObject [
- ^(JsonDummyTestObject new)
- a: 1;
- b: 2;
- c: 3;
- yourself
- ]
-
- 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))
- ]
-
- testAtomFalse [
- self json: 'false' equals: false.
- self json: ' false' equals: false.
- self json: 'false ' equals: false.
- self json: ' false ' equals: false
- ]
-
- testAtomNull [
- self json: 'null' equals: nil.
- self json: ' null' equals: nil.
- self json: 'null ' equals: nil.
- self json: ' null ' equals: nil
- ]
-
- 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 negated}
- ]
-
- testAtomString [
- self json: '"hi"' equals: 'hi'.
- self json: '"\""' equals: '"'.
- self json: '"\\"' equals: '\'.
- self json: '""' equals: ''.
- self json: '"a\u0004b"'
- equals: (String from:
- {$a.
- Character value: 4.
- $b}).
- self json: '"a\nb"' equals: (String from:
- {$a.
- Character lf.
- $b})
- ]
-
- testAtomTrue [
- self json: 'true' equals: true.
- self json: ' true' equals: true.
- self json: 'true ' equals: true.
- self json: ' true ' equals: true
- ]
-
- testCtor [
- self json: '@JsonDummyTestObject {"a": 1, "b": 2, "c": 3}'
- equals: self simpleDummyObject.
- self json: (Json render: self simpleDummyObject)
- equals: self simpleDummyObject
- ]
-
- 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)
- ]
-
- testMissingCtor [
- self should: [self readFrom: '@Missing[]'] raise: JsonSyntaxError
- ]
-
- testMissingCtorNoMap [
- self should: [Json new readFrom: '@Missing[]' readStream]
- raise: JsonSyntaxError
- ]
-
- testStringWithUnicode [
- self json: '"\u263A"'
- equals: (Character codePoint: 9786) asUnicodeString asString.
- self render: (Character codePoint: 9786) asUnicodeString asString
- equals: '"\u263A"'
- ]
-
- 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'
- ]
-
- testWriteString [
- self render: '"' equals: '"\""'.
- self render: '\' equals: '"\\"'.
- self render: 'hi' equals: '"hi"'.
- self render: (String from:
- {$a.
- Character lf.
- $b})
- equals: '"a\nb"'.
- self render: (String from:
- {$a.
- Character value: 4.
- $b})
- equals: '"a\u0004b"'
- ]
-]
-
View
284 Json/Json.st
@@ -0,0 +1,284 @@
+Object subclass: Json [
+ | stream line linePosition |
+
+ <category: 'json'>
+ <comment: 'This class reads and writes JSON format data - strings, numbers, boolean, nil, arrays and dictionaries. See http://json.org.'>
+
+ LastEncodedCharacter := Character space.
+
+ Json class >> readFrom: aStream [
+ <category: 'parsing'>
+
+ | parser result |
+
+ parser := self new initializeStream: aStream.
+ result := parser next.
+
+ parser nextSeparator.
+ aStream atEnd ifFalse: [parser errorExpected: 'end of input' was: aStream peek].
+
+ ^result
+ ]
+
+ Json class >> parse: aString [
+ <category: 'parsing'>
+
+ ^self readFrom: aString readStream
+ ]
+
+ Json class >> stringify: anObject [
+ <category: 'storing'>
+
+ | stream |
+
+ stream := WriteStream on: String new.
+ anObject storeAsJsonOn: stream.
+ ^stream contents
+ ]
+
+ Json class >> mimeType [
+ <category: 'utilities'>
+
+ ^'application/x-json'
+ ]
+
+ Json class >> putEscapedCharacter: aCharacter on: aStream [
+ <category: 'utilities'>
+
+ (aCharacter < LastEncodedCharacter or: [aCharacter codePoint = 127])
+ ifTrue: [
+ Character backspace = aCharacter ifTrue: [^aStream nextPutAll: '\b'].
+ Character tab = aCharacter ifTrue: [^aStream nextPutAll: '\t'].
+ Character lf = aCharacter ifTrue: [^aStream nextPutAll: '\n'].
+ Character ff = aCharacter ifTrue: [^aStream nextPutAll: '\f'].
+ Character cr = aCharacter ifTrue: [^aStream nextPutAll: '\r'].
+ aStream nextPutAll: '\u'.
+ aCharacter codePoint printOn: aStream paddedWith: $0 to: 4 base: 16]
+ ifFalse: [
+ $" = aCharacter ifTrue: [^aStream nextPutAll: '\"'].
+ $\ = aCharacter ifTrue: [^aStream nextPutAll: '\\'].
+ aStream nextPut: aCharacter]
+ ]
+
+ initializeStream: anObject [
+ <category: 'initialising'>
+
+ stream := anObject.
+ line := 1.
+ linePosition := 0.
+ ]
+
+ stream [
+ <category: 'accessing'>
+
+ ^stream
+ ]
+
+ next [
+ <category: 'private'>
+
+ | char |
+
+ self nextSeparator.
+ char := stream peek.
+
+ char = $" ifTrue: [^self nextString].
+ char = ${ ifTrue: [^self nextDictionary].
+ char = $[ ifTrue: [^self nextArray].
+ char = $t ifTrue: [self nextExpect: 'true'. ^true].
+ char = $f ifTrue: [self nextExpect: 'false'. ^false].
+ char = $n ifTrue: [self nextExpect: 'null'. ^nil].
+ (char = $- or: [char notNil and: [char isDigit]]) ifTrue: [^self nextNumber].
+
+ self errorExpected: 'string, object, array, true, false, null or digit' was: char.
+ ]
+
+ nextString [
+ <category: 'private'>
+
+ | writeStream char |
+
+ writeStream := WriteStream on: ''.
+ (stream peekFor: $") ifFalse: [self errorExpected: 'string' was: stream peek].
+
+ [(char := stream next) isNil or: [char = $"]] whileFalse: [
+ char < LastEncodedCharacter ifTrue: [
+ self errorExpected: 'printable character' was: 'control character'].
+
+ char = $\
+ ifTrue: [writeStream nextPutAll: self nextEscapedCharacter]
+ ifFalse: [writeStream nextPut: char]
+ ].
+
+ char ifNil: [self errorExpected: 'character' was: nil].
+ ^writeStream contents
+ ]
+
+ nextEscapedCharacter [
+ <category: 'private'>
+
+ | char |
+
+ char := stream next.
+ char == $" ifTrue: [^'"'].
+ char == $\ ifTrue: [^'\'].
+ char == $/ ifTrue: [^'/'].
+ char == $b ifTrue: [^Character backspace asString].
+ char == $n ifTrue: [^Character lf asString].
+ char == $f ifTrue: [^Character newPage asString].
+ char == $r ifTrue: [^Character cr asString].
+ char == $t ifTrue: [^Character tab asString].
+ char == $u ifTrue: [^self nextUnicodeEscapedCharacter asString].
+
+ self errorExpected: '", \, /, b, n, f, r, t, u' was: char asString.
+ ]
+
+ nextUnicodeEscapedCharacter [
+ <category: 'private'>
+
+ | codePoint |
+
+ (codePoint := stream nextAvailable: 4) size < 4 ifTrue: [
+ self errorExpected: '4 hex digits' was: codePoint].
+
+ ^Character codePoint: (Integer readFrom: codePoint readStream radix: 16)
+ ]
+
+ nextSeparator [
+ <category: 'private'>
+
+ | char |
+
+ [(char := stream peek) notNil and: [char isSeparator]] whileTrue: [
+ stream next = Character nl ifTrue: [
+ line := line + 1.
+ linePosition := stream position]].
+ ]
+
+ nextDictionary [
+ <category: 'private'>
+
+ | result expectComma key |
+
+ result := Dictionary new.
+ expectComma := false.
+ stream next.
+
+ [
+ self nextSeparator.
+ stream peek = $}.
+ ] whileFalse: [
+ expectComma ifTrue: [self nextComma; nextSeparator].
+ expectComma := true.
+
+ key := self nextString.
+ self nextSeparator; nextExpect: ':'; nextSeparator.
+ result at: key put: self next.
+ ].
+
+ stream next.
+ ^result
+ ]
+
+ nextArray [
+ <category: 'private'>
+
+ | result expectComma |
+
+ result := OrderedCollection new.
+ expectComma := false.
+ stream next.
+
+ [
+ self nextSeparator.
+ stream peek = $].
+ ] whileFalse: [
+ expectComma ifTrue: [self nextComma; nextSeparator].
+ expectComma := true.
+
+ result add: self next.
+ ].
+
+ stream next.
+ ^result asArray
+ ]
+
+ nextComma [
+ <category: 'private'>
+
+ (stream peekFor: $,) ifFalse: [
+ self errorExpected: ',' was: stream peek].
+ ]
+
+ nextExpect: aString [
+ <category: 'private'>
+
+ | unexpected |
+
+ (unexpected := stream nextAvailable: aString size) = aString ifFalse: [
+ self errorExpected: aString was: (unexpected isEmpty ifTrue: [] ifFalse: [unexpected])].
+ ]
+
+ nextNumber [
+ <category: 'private'>
+
+ | sign number |
+
+ sign := (stream peekFor: $-) ifTrue: [-1] ifFalse: [1].
+
+ (stream peekFor: $0)
+ ifTrue: [number := 0]
+ ifFalse: [number := self nextInteger].
+
+ (stream peekFor: $.) ifTrue: [number := number + self nextFloat].
+
+ number := number * sign.
+
+ ((stream peekFor: $e) or: [stream peekFor: $E]) ifTrue: [
+ sign := (stream peekFor: $-) ifTrue: [-1] ifFalse: [1].
+ number := number * (10 raisedTo: self nextInteger * sign)].
+
+ ^number
+ ]
+
+ nextInteger [
+ <category: 'private'>
+
+ | char number |
+
+ number := 0.
+
+ [(char := stream peek) notNil and: [char isDigit]] whileTrue: [
+ number := number * 10 + stream next digitValue].
+
+ number = 0 ifTrue: [self errorExpected: 'digit' was: stream peek].
+ ^number
+ ]
+
+ nextFloat [
+ <category: 'private'>
+
+ | char number i |
+
+ number := 0.
+ i := 1.
+
+ [(char := stream peek) notNil and: [char isDigit]] whileTrue: [
+ i := i * 10.
+ number := stream next digitValue / i + number].
+
+ i = 1 ifTrue: [self errorExpected: 'digit' was: stream peek].
+ ^number asFloat
+ ]
+
+ errorExpected: aString was: currrentString [
+ <category: 'error raising'>
+
+ JsonSyntaxError signal:
+ 'Expected %1 but %2 found on line %3 column %4' %
+ {aString.
+ currrentString ifNil: ['end of input'].
+ line.
+ stream position - linePosition}
+ ]
+]
View
6 Json/JsonSyntaxError.st
@@ -0,0 +1,6 @@
+Error subclass: JsonSyntaxError [
+
+ <category: 'json'>
+ <comment: 'Class Json signals instances of me when an input stream contains invalid JSON input.'>
+]
+
View
14 Json/extensions/Association.st
@@ -0,0 +1,14 @@
+Association extend [
+
+ storeAsJsonOn: aStream [
+ <category: 'json-storing'>
+
+ self key asString storeAsJsonOn: aStream.
+ aStream
+ nextPut: $:;
+ space.
+ self value storeAsJsonOn: aStream
+ ]
+
+]
+
View
12 Json/extensions/CharacterArray.st
@@ -0,0 +1,12 @@
+CharacterArray extend [
+
+ storeAsJsonOn: aStream [
+ <category: 'json-storing'>
+
+ aStream nextPut: $".
+ self asString do: [ :char | Json putEscapedCharacter: char on: aStream].
+ aStream nextPut: $".
+ ]
+
+]
+
View
14 Json/extensions/Collection.st
@@ -0,0 +1,14 @@
+Collection extend [
+
+ storeAsJsonOn: aStream [
+ "By default, use array braces"
+
+ <category: 'json-storing'>
+
+ aStream nextPut: $[.
+ self do: [:each | each storeAsJsonOn: aStream] separatedBy: [aStream nextPutAll: ', '].
+ aStream nextPut: $]
+ ]
+
+]
+
View
21 Json/extensions/Dictionary.st
@@ -0,0 +1,21 @@
+Dictionary extend [
+
+ storeAsJsonOn: aStream [
+ <category: 'json-storing'>
+
+ | isFirst |
+
+ isFirst := true.
+ aStream nextPut: ${.
+
+ self associationsDo: [ :association |
+ isFirst ifFalse: [
+ isFirst := false.
+ aStream nextPutAll: ', '].
+ association storeAsJsonOn: aStream].
+
+ aStream nextPut: $}
+ ]
+
+]
+
View
10 Json/extensions/False.st
@@ -0,0 +1,10 @@
+False extend [
+
+ storeAsJsonOn: aStream [
+ <category: 'json-storing'>
+
+ aStream nextPutAll: 'false'
+ ]
+
+]
+
View
10 Json/extensions/Integer.st
@@ -0,0 +1,10 @@
+Integer extend [
+
+ storeAsJsonOn: aWriteStream [
+ <category: 'json-storing'>
+
+ ^self printOn: aWriteStream base: 10
+ ]
+
+]
+
View
42 Json/extensions/Number.st
@@ -0,0 +1,42 @@
+Number extend [
+
+ storeAsJsonOn: aWriteStream [
+ <category: 'json-storing'>
+
+ self printOn: aWriteStream
+ ]
+
+]
+
+Float extend [
+
+ storeAsJsonOn: aWriteStream [
+ <category: 'json-storing'>
+
+ self isFinite
+ ifTrue: [super storeAsJsonOn: aWriteStream]
+ ifFalse: [aWriteStream nextPutAll: 'null'].
+ ]
+
+]
+
+Fraction extend [
+
+ storeAsJsonOn: aWriteStream [
+ <category: 'json-storing'>
+
+ self asFloat storeAsJsonOn: aWriteStream.
+ ]
+
+]
+
+ScaledDecimal extend [
+
+ storeAsJsonOn: aWriteStream [
+ <category: 'json-storing'>
+
+ self asFloat storeAsJsonOn: aWriteStream.
+ ]
+
+]
+
View
10 Json/extensions/Object.st
@@ -0,0 +1,10 @@
+Object extend [
+
+ asJsonString [
+ <category: '*JSON'>
+
+ ^String streamContents: [ :string | self storeAsJsonOn: string]
+ ]
+
+]
+
View
10 Json/extensions/True.st
@@ -0,0 +1,10 @@
+True extend [
+
+ storeAsJsonOn: aStream [
+ <category: 'json-storing'>
+
+ aStream nextPutAll: 'true'
+ ]
+
+]
+
View
10 Json/extensions/UndefinedObject.st
@@ -0,0 +1,10 @@
+UndefinedObject extend [
+
+ storeAsJsonOn: aWriteStream [
+ <category: 'json-storing'>
+
+ aWriteStream nextPutAll: 'null'
+ ]
+
+]
+
View
10 Json/extensions/WriteStream.st
@@ -0,0 +1,10 @@
+WriteStream extend [
+
+ jsonPrint: anObject [
+ <category: 'json-storing'>
+
+ anObject storeAsJsonOn: self
+ ]
+
+]
+
View
8 README
@@ -1,8 +0,0 @@
-This is a Gnu Smalltalk port of Squeak JSON which is used for the SCouchDB
-driver (www.squeaksource.com/SCouchDB).
-
-It uses Gitocello to track Squeak JSON in the squeakJson branch. I try to
-keep the code in Squeak mostly compatible. Gnu Smalltalk specific changes
-that cannot be easily incorporated into the Squeak package are in the master
-branch.
-
View
9 package
@@ -0,0 +1,9 @@
+#!/bin/bash
+
+dir=`dirname $0`
+
+if echo $dir | grep -v ^/ > /dev/null; then
+ dir=` pwd `/$dir
+fi
+
+gst-package -t ~/.st "$dir/package.xml"
View
59 package.xml
@@ -1,40 +1,21 @@
<package>
-<!-- THIS FILE IS GENERATED! EDITS _WILL_ BE LOST ON UPDATE! -->
-<name>JSON</name>
-<prereq>Seaside</prereq>
-<test>
-<filein>JSON/JsonTests.st</filein>
-<sunit>JsonTests</sunit>
-</test>
-<filein>Extensions/Association.st</filein>
-<filein>Extensions/Collection.st</filein>
-<filein>Extensions/Dictionary.st</filein>
-<filein>Extensions/False.st</filein>
-<filein>Extensions/Integer.st</filein>
-<filein>JSON/Json.st</filein>
-<filein>JSON/JsonDummyTestObject.st</filein>
-<filein>JSON/JsonObject.st</filein>
-<filein>JSON/JsonSyntaxError.st</filein>
-<filein>Extensions/Number.st</filein>
-<filein>Extensions/Object.st</filein>
-<filein>Extensions/String.st</filein>
-<filein>Extensions/True.st</filein>
-<filein>Extensions/UndefinedObject.st</filein>
-<filein>Extensions/WriteStream.st</filein>
-<file>Extensions/Association.st</file>
-<file>Extensions/Collection.st</file>
-<file>Extensions/Dictionary.st</file>
-<file>Extensions/False.st</file>
-<file>Extensions/Integer.st</file>
-<file>JSON/Json.st</file>
-<file>JSON/JsonDummyTestObject.st</file>
-<file>JSON/JsonObject.st</file>
-<file>JSON/JsonSyntaxError.st</file>
-<file>JSON/JsonTests.st</file>
-<file>Extensions/Number.st</file>
-<file>Extensions/Object.st</file>
-<file>Extensions/String.st</file>
-<file>Extensions/True.st</file>
-<file>Extensions/UndefinedObject.st</file>
-<file>Extensions/WriteStream.st</file>
-</package>
+ <name>Json</name>
+ <prereq>Iconv</prereq>
+ <test>
+ <filein>tests/JsonTest.st</filein>
+ <sunit>JsonTest</sunit>
+ </test>
+ <filein>Json/extensions/Association.st</filein>
+ <filein>Json/extensions/Collection.st</filein>
+ <filein>Json/extensions/Dictionary.st</filein>
+ <filein>Json/extensions/False.st</filein>
+ <filein>Json/extensions/Integer.st</filein>
+ <filein>Json/Json.st</filein>
+ <filein>Json/JsonSyntaxError.st</filein>
+ <filein>Json/extensions/Number.st</filein>
+ <filein>Json/extensions/Object.st</filein>
+ <filein>Json/extensions/CharacterArray.st</filein>
+ <filein>Json/extensions/True.st</filein>
+ <filein>Json/extensions/UndefinedObject.st</filein>
+ <filein>Json/extensions/WriteStream.st</filein>
+</package>
View
2  readme.txt
@@ -0,0 +1,2 @@
+JSON implementation for GNU Smalltalk, originally based on Squeak
+implementation www.squeaksource.com/SCouchDB.
View
151 tests/JsonTest.st
@@ -0,0 +1,151 @@
+TestCase subclass: JsonTest [
+
+ <comment: 'I provide a number of test cases for class Json.'>
+ <category: 'json'>
+
+ testParseNull [
+ self
+ parseJson: 'null' equals: nil;
+ parseJson: ' null' equals: nil;
+ parseJson: 'null ' equals: nil;
+ parseJson: ' null ' equals: nil.
+ ]
+
+ testParseTrue [
+ self
+ parseJson: 'true' equals: true;
+ parseJson: ' true' equals: true;
+ parseJson: 'true ' equals: true;
+ parseJson: ' true ' equals: true.
+ ]
+
+ testParseFalse [
+ self
+ parseJson: 'false' equals: false;
+ parseJson: ' false' equals: false;
+ parseJson: 'false ' equals: false;
+ parseJson: ' false ' equals: false.
+ ]
+
+ testParseNumber [
+ self
+ parseJson: '1' equals: 1;
+ parseJson: '1.23e2' equals: 123;
+ parseJson: '-1.23e2' equals: -123;
+ parseJson: '1e-2' equals: 1/100;
+ parseJson: '-1e-2' equals: -1/100;
+ parseJson: '-1' equals: -1;
+ parseJson: '-0' equals: 0;
+ parseJson: '-1.2' equals: -1.2.
+ ]
+
+ testParseString [
+ self
+ parseJson: '"hi"' equals: 'hi';
+ parseJson: '"\""' equals: '"';
+ parseJson: '"\\"' equals: '\';
+ parseJson: '""' equals: '';
+ parseJson: '"a\u0004b"' equals: (String from: {$a. $<4>. $b});
+ parseJson: '"a\nb"' equals: (String from: {$a. Character lf. $b});
+ parseJson: '"\u263A"' equals: (Character codePoint: 16r263A) asString
+ ]
+
+ testParseArray [
+ self
+ parseJson: '[]' equals: #();
+ parseJson: '[[]]' equals: #(#());
+ parseJson: '[[], []]' equals: #(#() #());
+ parseJson: '["hi", "there"]' equals: #('hi' 'there');
+ parseJson: '[["a", "b", null]]' equals: #(#('a' 'b' nil)).
+ ]
+
+ testParseDictionary [
+ self
+ parseJson: '{}' equals: Dictionary new;
+ parseJson: '{"a": "a"}' equals: (Dictionary with: 'a' -> 'a');
+ parseJson: '{"a": [[]]}' equals: (Dictionary with: 'a' -> #(#()));
+ parseJson: '{"a":"b", "b":"a"}' equals: (Dictionary with: 'a' -> 'b' with: 'b' -> 'a').
+ ]
+
+ testStringifyBoolean [
+ self
+ stringify: true equals: 'true';
+ stringify: false equals: 'false'.
+ ]
+
+ testStringifyNil [
+ self stringify: nil equals: 'null'.
+ ]
+
+ testStringifyNumber [
+ self
+ stringify: 1 equals: '1';
+ stringify: 1.1 equals: '1.1';
+ stringify: 1e10 equals: '1.0e10';
+ stringify: 1e-10 equals: '1.0e-10';
+ stringify: FloatD infinity equals: 'null';
+ stringify: FloatD infinity negated equals: 'null';
+ stringify: 1/2 equals: '0.5';
+ stringify: (1 asScaledDecimal: 1) equals: '1.0'.
+ ]
+
+ testStringifyString [
+ | string expected |
+
+ string := ((0 to: 128) collect: [ :code | Character codePoint: code]) asUnicodeString.
+ expected := '"\u0000\u0001\u0002\u0003\u0004\u0005\u0006\u0007\b\t\n\u000B\f\r\u000E',
+ '\u000F\u0010\u0011\u0012\u0013\u0014\u0015\u0016\u0017\u0018\u0019\u001A\u001B',
+ '\u001C\u001D\u001E\u001F !\"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRS',
+ 'TUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\u007F', (Character codePoint: 128) asString, '"'.
+
+ self stringify: string equals: expected.
+ ]
+
+ testStringifyArray [
+ self stringify: #() equals: '[]'.
+ self
+ stringify: {true. false. nil. 'foo'. 2. #(). #(1). Dictionary new}
+ equals: '[true, false, null, "foo", 2, [], [1], {}]'.
+ ]
+
+ testStringifyDictionary [
+ self
+ stringify: (Dictionary with: 'key' -> 'value') equals: '{"key": "value"}';
+ stringify: (Dictionary with: 42 -> 2) equals: '{"42": 2}'.
+ ]
+
+ testErrorMessages [
+ self
+ parseJson: '[' error: 'Expected string, object, array, true, false, null or digit but end of input found on line 1 column 1';
+ parseJson: '{' error: 'Expected string but end of input found on line 1 column 1';
+ parseJson: '{""' error: 'Expected : but end of input found on line 1 column 3';
+ parseJson: 't' error: 'Expected true but t found on line 1 column 1';
+ parseJson: 'f' error: 'Expected false but f found on line 1 column 1';
+ parseJson: 'n' error: 'Expected null but n found on line 1 column 1';
+ parseJson: '"s' error: 'Expected character but end of input found on line 1 column 2';
+ parseJson: '"', Character nl asString, '"' error: 'Expected printable character but control character found on line 1 column 2';
+ parseJson: '"\uA' error: 'Expected 4 hex digits but A found on line 1 column 4';
+ parseJson: '"\x' error: 'Expected ", \, /, b, n, f, r, t, u but x found on line 1 column 3';
+ parseJson: '0 1' error: 'Expected end of input but 1 found on line 1 column 2'.
+ ]
+
+ parseJson: aString error: aMessageString [
+ [Json parse: aString.
+ self assert: false]
+ on: JsonSyntaxError do: [ :e | self assert: aMessageString = e messageText].
+ ]
+
+ parseJson: aString equals: aValue [
+ | value |
+
+ value := Json parse: aString.
+ self assert: value = aValue description: value printString, ' = ', aValue printString
+ ]
+
+ stringify: anObject equals: aString [
+ self
+ assert: (Json stringify: anObject) = aString
+ description: (Json stringify: anObject), ' = ', aString
+ ]
+]
+
View
15 tests/run
@@ -0,0 +1,15 @@
+#!/bin/bash
+
+dir=`dirname $0`
+
+if echo $dir | grep -v ^/ > /dev/null; then
+ dir=` pwd `/$dir
+fi
+
+dir=`dirname $dir`
+dir=`dirname $dir`
+
+cd $dir
+
+$dir/package > /dev/null
+gst-sunit -p Json

No commit comments for this range

Something went wrong with that request. Please try again.