SystemOrganization addCategory: #JSON!

!SequenceableCollection methodsFor: '*JSON-writing' stamp: 'tonyg 8/17/2005 00:40'!
jsonWriteOn: aStream
	| needComma |
	needComma := false.
	aStream nextPut: $[.
	self do: [:v |
		needComma
			ifTrue: [ aStream nextPutAll: ', ' ]
			ifFalse: [ needComma := true ].
		v jsonWriteOn: aStream.
	].
	aStream nextPut: $].! !

!Dictionary methodsFor: '*JSON-writing' stamp: 'lr 10/8/2010 08:32'!
jsonWriteOn: aStream
	| needComma |
	needComma := false.
	aStream nextPut: ${.
	self keysAndValuesDo: [:k :v |
		needComma
			ifTrue: [ aStream nextPutAll: ', ' ]
			ifFalse: [ needComma := true ].
		k asString jsonWriteOn: aStream.
		aStream nextPutAll: ': '.
		v jsonWriteOn: aStream.
	].
	aStream nextPut: $}.! !

!WriteStream methodsFor: '*json-printing' stamp: 'cwp 10/25/2006 12:27'!
jsonPrint: anObject
	anObject jsonWriteOn: self! !

!Number methodsFor: '*JSON-writing' stamp: 'tonyg 8/17/2005 00:41'!
jsonWriteOn: aWriteStream 
	aWriteStream nextPutAll: self asString.! !

!String methodsFor: '*JSON-writing' stamp: 'lr 10/8/2010 08:32'!
jsonWriteOn: aStream
	| replacement |
	aStream nextPut: $".
	self do: [:ch |
		replacement := Json escapeForCharacter: ch.
		replacement
			ifNil: [ aStream nextPut: ch ]
			ifNotNil: [ aStream nextPut: $\; nextPut: replacement ].
	].
	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.!

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 11/29/2005 18:03'!
json: aString equals: aValue
	| readValue |
	readValue := self readFrom: aString.
	self assert: readValue = aValue.! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 11/29/2005 18:03'!
readFrom: aString
	^ (Json newWithConstructors: {JsonDummyTestObject.}) readFrom: aString readStream
! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 8/17/2005 16:24'!
render: anObject equals: aString
	self assert: (Json render: anObject) = aString! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 11/29/2005 17:51'!
simpleDummyObject
	^ JsonDummyTestObject new a: 1; b: 2; c: 3; yourself! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 8/16/2005 23:51'!
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)).! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 8/16/2005 23:42'!
testAtomFalse
	self json: 'false' equals: false.
	self json: '  false' equals: false.
	self json: 'false  ' equals: false.
	self json: '  false  ' equals: false.
! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 8/16/2005 23:43'!
testAtomNull
	self json: 'null' equals: nil.
	self json: '  null' equals: nil.
	self json: 'null  ' equals: nil.
	self json: '  null  ' equals: nil.
! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 8/17/2005 09:10'!
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).! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 8/16/2005 23:46'!
testAtomString
	self json: '"hi"' equals: 'hi'.
	self json: '"\""' equals: '"'.
	self json: '"\\"' equals: '\'.
	self json: '""' equals: ''.! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 8/16/2005 23:36'!
testAtomTrue
	self json: 'true' equals: true.
	self json: '  true' equals: true.
	self json: 'true  ' equals: true.
	self json: '  true  ' equals: true.
! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 11/29/2005 17:58'!
testCtor
	self json: '@JsonDummyTestObject {"a": 1, "b": 2, "c": 3}' equals: self simpleDummyObject.
	self json: (Json render: self simpleDummyObject) equals: self simpleDummyObject.! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 8/17/2005 00:00'!
testDictionary
	self json: '{}' equals: (Dictionary new).
	self json: '{"a": "a"}' equals: (Dictionary new at: 'a' put: 'a'; yourself).
	self json: '{"a": [[]]}' equals: (Dictionary new at: 'a' put: #(#()); yourself).
	self json: '{"a":"b", "b":"a"}' equals: ({'a'->'b'. 'b'->'a'} as: Dictionary).! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'cwp 10/19/2006 19:06'!
testMissingCtor
	self 
		should: [self readFrom: '@Missing[]']
		raise: JsonSyntaxError
! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'cwp 10/19/2006 19:06'!
testMissingCtorNoMap
	self 
		should: [Json new readFrom: '@Missing[]' readStream]
		raise: JsonSyntaxError! !

!JsonTests methodsFor: 'as yet unclassified' stamp: 'tonyg 8/17/2005 16:25'!
testWriteString
	self render: '"' equals: '"\""'.
	self render: '\' equals: '"\\"'.
	self render: 'hi' equals: '"hi"'.
	self render: ({$a. Character lf. $b} as: String) equals: '"a\nb"'.! !

!True methodsFor: '*JSON-writing' stamp: 'tonyg 8/17/2005 00:44'!
jsonWriteOn: aStream
	aStream nextPutAll: 'true'! !

!UndefinedObject methodsFor: '*JSON-writing' stamp: 'tonyg 8/17/2005 00:45'!
jsonWriteOn: aWriteStream 
	aWriteStream nextPutAll: 'null'! !

!False methodsFor: '*JSON-writing' stamp: 'tonyg 8/17/2005 00:43'!
jsonWriteOn: aStream
	aStream nextPutAll: 'false'! !

!Text methodsFor: '*json-printing' stamp: 'cwp 10/26/2006 22:25'!
jsonWriteOn: aStream
	self string jsonWriteOn: aStream! !

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.!

Object subclass: #Json
	instanceVariableNames: 'stream ctorMap'
	classVariableNames: 'CharacterEscapeMap'
	poolDictionaries: ''
	category: 'JSON'!

!Json commentStamp: '<historical>' prior: 0!
This class reads and writes JSON format data - strings, numbers, boolean, nil, arrays and dictionaries. See http://www.crockford.com/JSON/index.html. It has been extended with syntax for invoking a prearranged list of constructors on read objects.!

!Json class methodsFor: 'as yet unclassified' stamp: 'tonyg 8/17/2005 16:20'!
escapeForCharacter: c
	^ CharacterEscapeMap at: c ifAbsent: [nil]! !

!Json class methodsFor: 'as yet unclassified' stamp: 'tonyg 8/17/2005 16:19'!
initialize
	"Json initialize."
	CharacterEscapeMap := Dictionary newFrom: {
		$" -> $".
		$\ -> $\.
		Character backspace -> $b.
		Character lf -> $n.
		Character newPage -> $f.
		Character cr -> $r.
		Character tab -> $t.
	}.! !

!Json class methodsFor: 'as yet unclassified' stamp: 'tonyg 8/24/2005 14:48'!
mimeType
	^ 'application/x-json'! !

!Json class methodsFor: 'as yet unclassified' stamp: 'lr 10/8/2010 08:32'!
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 methodsFor: 'as yet unclassified' stamp: 'tonyg 8/17/2005 09:09'!
numbersMayContain: aChar
	^ aChar isDigit or: [#($- $+ $. $e $E) includes: aChar]! !

!Json class methodsFor: 'as yet unclassified' stamp: 'tonyg 11/29/2005 17:45'!
readFrom: aStream
	^ self new readFrom: aStream.! !

!Json class methodsFor: 'as yet unclassified' stamp: 'tonyg 8/17/2005 07:45'!
render: anObject
	| s |
	s := WriteStream on: String new.
	anObject jsonWriteOn: s.
	^ s contents.! !

!Json class methodsFor: 'as yet unclassified' stamp: 'lr 10/8/2010 08:32'!
render: anObject withConstructor: aConstructorName on: aStream
	aStream
		nextPutAll: '@';
		nextPutAll: aConstructorName.
	anObject jsonWriteOn: aStream! !

!Json class methodsFor: 'as yet unclassified' stamp: 'lr 10/8/2010 08:32'!
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! !

!Json methodsFor: 'private' stamp: 'tonyg 8/16/2005 23:41'!
consume: aString returning: anObject
	aString do: [:c | self next == c ifFalse: [JsonSyntaxError signal: 'Expected ''', aString, ''''] ].
	^ anObject! !

!Json methodsFor: 'accessing' stamp: 'tonyg 11/29/2005 11:40'!
ctorMap
	^ ctorMap! !

!Json methodsFor: 'accessing' stamp: 'lr 10/8/2010 08:32'!
ctorMap: m
	ctorMap := m! !

!Json methodsFor: 'private' stamp: 'tonyg 8/16/2005 21:08'!
interpretStringEscape
	| c |
	c := self next.
	c == $b ifTrue: [^ Character backspace].
	c == $n ifTrue: [^ Character lf].
	c == $f ifTrue: [^ Character newPage].
	c == $r ifTrue: [^ Character cr].
	c == $t ifTrue: [^ Character tab].
	^ c.! !

!Json methodsFor: 'private' stamp: 'tonyg 8/16/2005 20:22'!
next
	^ self stream next! !

!Json methodsFor: 'private' stamp: 'tonyg 8/16/2005 20:21'!
peek
	^ self stream peek! !

!Json methodsFor: 'parsing' stamp: 'tonyg 11/29/2005 11:31'!
readAny
	"This is the main entry point for the JSON parser. See also readFrom: on the class side."
	| c |
	self skipWhitespace.
	c := self peek asLowercase.
	c == ${ ifTrue: [self next. ^ self readDictionary].
	c == $[ ifTrue: [self next. ^ self readArray].
	c == $" ifTrue: [self next. ^ self readString].
	c == $t ifTrue: [^ self consume: 'true' returning: true].
	c == $f ifTrue: [^ self consume: 'false' returning: false].
	c == $n ifTrue: [^ self consume: 'null' returning: nil].
	c == $@ ifTrue: [self next. ^ self readConstructor].
	(Json numbersMayContain: c) ifTrue: [^ self readNumber].
	JsonSyntaxError signal: 'Unknown Json input'! !

!Json methodsFor: 'private' stamp: 'lr 10/8/2010 08:32'!
readArray
	| a needComma |
	a := OrderedCollection new.
	needComma := false.
	[
		self skipWhitespace.
		self peek == $] ifTrue: [self next. ^ a asArray].
		needComma
			ifTrue: [self peek == $, ifFalse: [JsonSyntaxError signal: 'Missing comma'].
					self next.]
			ifFalse: [needComma := true]. 
		a add: self readAny.
	] repeat.
! !

!Json methodsFor: 'private' stamp: 'lr 10/8/2010 08:32'!
readConstructor
	| s c v ctor |
	s := WriteStream on: ''.
	[
		c := self peek.
		c ifNil: [JsonSyntaxError signal: 'Premature EOF reading constructor name'].
		((c == $.) or: [c isLetter])
			ifTrue: [s nextPut: c. self next]
			ifFalse: [
				v := self readAny.
				s := s contents.
				ctor := ctorMap ifNotNil: [ctor := ctorMap at: s ifAbsent: [nil]].
				ctor ifNil: [JsonSyntaxError signal: 'Unknown ctor ', s].
				^ ctor constructFromJson: v]
	] repeat.
! !

!Json methodsFor: 'private' stamp: 'lr 10/8/2010 08:32'!
readDictionary
	| m k v needComma |
	m := JsonObject new.
	needComma := false.
	[
		self skipWhitespace.
		self peek == $} ifTrue: [self next. ^ m].
		needComma
			ifTrue: [self peek == $, ifFalse: [JsonSyntaxError signal: 'Missing comma'].
					self next. self skipWhitespace]
			ifFalse: [needComma := true.].
		self next == $" ifFalse: [JsonSyntaxError signal: 'Key in dictionary must be string'].
		k := self readString.
		self skipWhitespace.
		self peek == $: ifFalse: [JsonSyntaxError signal: 'Missing colon'].
		self next.
		v := self readAny.
		m at: k put: v.
	] repeat.
! !

!Json methodsFor: 'parsing' stamp: 'tonyg 11/29/2005 17:44'!
readFrom: aStream
	self stream: aStream.
	^ self readAny! !

!Json methodsFor: 'private' stamp: 'tonyg 8/17/2005 09:10'!
readNumber
	| acc c |
	acc := WriteStream on: ''.
	[
		c := self peek.
		(c isNil not and: [Json numbersMayContain: c]) ifFalse: [
			[^ acc contents asNumber] on: Error do: [JsonSyntaxError signal: 'Invalid number']].
		acc nextPut: c.
		self next.
	] repeat.! !

!Json methodsFor: 'private' stamp: 'tonyg 8/16/2005 21:09'!
readString
	| s c |
	s := WriteStream on: ''.
	[
		c := self next.
		c == $\
			ifTrue: [s nextPut: self interpretStringEscape.]
			ifFalse: [c == $" ifTrue: [^ s contents.].
					s nextPut: c]
	] repeat.! !

!Json methodsFor: 'private' stamp: 'lr 10/8/2010 08:32'!
skipComment
	self peek == $/
		ifFalse: [ ^ self ].
	self next.
	self peek == $/
		ifTrue: [ self skipToEndOfLine ]
		ifFalse: [ 
			self peek == $*
				ifTrue: [ 
					self next.
					self skipCommentBody ]
				ifFalse: [ JsonSyntaxError signal: 'Invalid comment syntax' ] ]! !

!Json methodsFor: 'private' stamp: 'tonyg 8/17/2005 00:19'!
skipCommentBody
	[
		[self next == $*] whileFalse.
		self peek == $/
	] whileFalse.
	self next. "skip that last slash"
	self skipWhitespace.! !

!Json methodsFor: 'private' stamp: 'tonyg 8/16/2005 20:35'!
skipToEndOfLine
	[self peek == Character cr or: [self peek == Character lf]] whileFalse: [self next].
	self skipWhitespace! !

!Json methodsFor: 'private' stamp: 'tonyg 8/16/2005 20:24'!
skipWhitespace
	[self peek isSeparator] whileTrue: [self next].
	self skipComment.! !

!Json methodsFor: 'accessing' stamp: 'tonyg 8/16/2005 20:20'!
stream
	"Answer the value of stream"

	^ stream! !

!Json methodsFor: 'accessing' stamp: 'lr 10/8/2010 08:32'!
stream: anObject
	"Set the value of stream"

	stream := anObject! !

Object subclass: #JsonDummyTestObject
	instanceVariableNames: 'a b c'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'JSON'!

!JsonDummyTestObject class methodsFor: 'as yet unclassified' stamp: 'tonyg 11/29/2005 17:49'!
constructFromJson: j
	^ self new a: (j at: 'a'); b: (j at: 'b'); c: (j at: 'c'); yourself! !

!JsonDummyTestObject methodsFor: 'as yet unclassified' stamp: 'tonyg 11/29/2005 17:56'!
= other
	^ other class == self class and: [
		a = other a and: [
		b = other b and: [
		c = other c]]]! !

!JsonDummyTestObject methodsFor: 'accessing' stamp: 'tonyg 11/29/2005 17:48'!
a
	"Answer the value of a"

	^ a! !

!JsonDummyTestObject methodsFor: 'accessing' stamp: 'lr 10/8/2010 08:32'!
a: anObject
	"Set the value of a"

	a := anObject! !

!JsonDummyTestObject methodsFor: 'accessing' stamp: 'tonyg 11/29/2005 17:48'!
b
	"Answer the value of b"

	^ b! !

!JsonDummyTestObject methodsFor: 'accessing' stamp: 'lr 10/8/2010 08:32'!
b: anObject
	"Set the value of b"

	b := anObject! !

!JsonDummyTestObject methodsFor: 'accessing' stamp: 'tonyg 11/29/2005 17:48'!
c
	"Answer the value of c"

	^ c! !

!JsonDummyTestObject methodsFor: 'accessing' stamp: 'lr 10/8/2010 08:32'!
c: anObject
	"Set the value of c"

	c := anObject! !

!JsonDummyTestObject methodsFor: 'as yet unclassified' stamp: 'tonyg 11/30/2005 16:42'!
jsonWriteOn: s
	Json renderInstanceVariables: {#a. #b. #c} of: self on: s
! !

Object subclass: #JsonObject
	instanceVariableNames: 'properties'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'JSON'!

!JsonObject methodsFor: 'as yet unclassified' stamp: 'cwp 8/2/2007 01:03'!
at: key ifAbsent: aBlock
	^ (properties detect: [:ea | ea key = key] ifNone: [^ aBlock value]) value! !

!JsonObject methodsFor: 'as yet unclassified' stamp: 'cwp 7/13/2007 23:21'!
at: key put: value
	properties add: key -> value! !

!JsonObject methodsFor: 'as yet unclassified' stamp: 'cwp 7/13/2007 23:24'!
doesNotUnderstand: aMessage
	| key |
	key := aMessage selector.
	key isUnary ifTrue: [^ self at: key ifAbsent: [super doesNotUnderstand: aMessage]].
	^ (key isKeyword and: [(key occurrencesOf: $:) = 1])
		ifTrue: [key := key allButLast asSymbol.
				self at: key put: aMessage arguments first]
		ifFalse: [super doesNotUnderstand: aMessage]
				
	! !

!JsonObject methodsFor: 'as yet unclassified' stamp: 'cwp 7/13/2007 23:25'!
initialize
	properties := OrderedCollection new! !

!JsonObject methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2007 00:03'!
jsonWriteOn: aStream
	aStream nextPut: ${.
	properties
		do: 
			[:ea | 
			ea key asString jsonWriteOn: aStream.
			aStream nextPutAll: ': '.
			ea value jsonWriteOn: aStream]
		separatedBy: [aStream nextPutAll: ', '].
	aStream nextPut: $}.! !
Json initialize!