Object subclass: #JSONDumper
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: nil !

ReadWriteStream subclass: #JSONTokenStream
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: nil !

JSONDumper comment:
'I read and write data structures (currently build of OrderedCollection and Dictionary)
from and to JSON (Java Script Object Notation). Note: I will behave badly with circular
data structures.' !

JSONTokenStream comment:
'I''m a helper class for JSONDumper. I know what is considered whitespace
for JSON and have some helper methods JSONDumper uses.' !

!JSONTokenStream methodsFor: 'json'!

peekNonJSONWhitespace
   "I'm peeking for the next non-whitespace character and will drop all whitespace in front of it"
   | c |
   [
     c := self peek.
           c = (Character space)
     or: [ c = (Character tab)
     or: [ c = (Character lf)
     or: [ c = (Character cr)]]]
   ] whileTrue: [
     self next
   ].
   ^self peek
!

skipNonJSONWhitespace
   "I will skil all whitespace characters in the stream until i hit some non-ws. character"
   self nextNonJSONWhitespace.
   ^self
!

nextNonJSONWhitespace
   "I'm returning the next non-whitespace character"
   | c |
   self peekNonJSONWhitespace.
   c := self next.
   c isNil ifTrue: [ ^self error: 'expected character but found end of stream' ].
   ^c
! !

!JSONDumper class methodsFor: 'json'!

toJSON: anObject
   "I'm returning a JSON string which represents the object."
   ^anObject toJSON
!

fromJSON: string
   "I'm responsible for decoding the JSON string to objects."
   ^self fromJSONStream: (JSONTokenStream on: string)
! !

!JSONDumper class methodsFor: 'private'!

fromJSONStream: stream
   "I decode a json stream to a value, which will be one of: nil,
true, false, OrderedCollection, Dictionary, String or Number
(i will return Integer or Float depending on the input)."
   | c |
   c := stream peekNonJSONWhitespace.
   (c = $n) ifTrue: [ stream next: 4. ^nil   ].
   (c = $t) ifTrue: [ stream next: 4. ^true  ].
   (c = $f) ifTrue: [ stream next: 5. ^false ].
   (c = ${) ifTrue: [ ^self objectFromJSONStream: stream ].
   (c = $[) ifTrue: [ ^self arrayFromJSONStream: stream  ].
   (c = $") ifTrue: [ ^self stringFromJSONStream: stream ].
   ^self numberFromJSONStream: stream
!

arrayFromJSONStream: stream
   "I decode JSON arrays from the stream and will return a OrderedCollection for them."
   | c obj value |
   obj := OrderedCollection new.
   stream skipNonJSONWhitespace.
   c := stream peekNonJSONWhitespace.
   [ ((c = $]) not) or: [ c = $, ] ] whileTrue: [
      (c = $,) ifTrue: [ stream skip: 1. ].
      value := self fromJSONStream: stream.
      obj add: value.
      c := stream peekNonJSONWhitespace.
   ].
   stream skipNonJSONWhitespace.
   ^obj
!

objectFromJSONStream: stream
   "I decode JSON objects from the stream and will return a Dictionary containing all the key/value pairs."
   | c obj key value |
   obj := Dictionary new.
   stream skipNonJSONWhitespace.
   c := stream peekNonJSONWhitespace.
   [ (c = $}) not or: [ c = $, ] ] whileTrue: [
      (c = $,) ifTrue: [ stream skip: 1. ].

      key := self stringFromJSONStream: stream.

      c := stream nextNonJSONWhitespace.
      c = $: ifFalse: [
         self error: ('unexpected character found where name-seperator '':'' expected, found: %1' bindWith: c)
      ].

      value := self fromJSONStream: stream.

      obj at: key put: value.
      c := stream peekNonJSONWhitespace.
   ].
   stream skipNonJSONWhitespace.
   ^obj
!

stringFromJSONStream: stream
   "I'm extracting a JSON string from the stream and return them as String."
   | c obj str |
   str := WriteStream on: (String new).
   stream skipNonJSONWhitespace.
   c := stream nextNonJSONWhitespace.
   [ c = $" ] whileFalse: [
      c = $\
         ifTrue: [
            c := stream next.
            c isNil ifTrue:
               [ ^self error: 'expected character, found end of stream' ].
            c = $u
               ifTrue: [ str nextPut: ((Integer readFrom: (ReadStream on: (stream next: 4)) radix: 16) asCharacter) ];
               ifFalse: [ str nextPut: c ].
         ];
         ifFalse: [ str nextPut: c ].
      c := stream nextNonJSONWhitespace.
   ].
   ^str contents
!

numberFromJSONStream: stream
   "I'm extracting a number in JSON format from the stream and return Integer or Float depending on the input."
   | c num sgn int intexp frac exp isfloat |
   num := WriteStream on: (String new).

   isfloat := false.
   sgn     := 1.
   int     := 0.
   intexp  := 1.

   c := stream peek.
   (c isNil) ifTrue: [ ^self error: 'expected number or -sign, but found end of stream' ].
   c = $- ifTrue: [ sgn := -1. stream next. ].

   c := stream peek.
   (c isNil) ifTrue: [ ^self error: 'expected number, but found end of stream' ].

   [ c notNil and: [ c isDigit ] ] whileTrue: [
      stream next.
      int := sgn * (c digitValue) + (int * 10).
      c := stream peek
   ].
   (c isNil) ifTrue: [ ^int ].

   c = $. ifTrue: [
      stream next.
      isfloat := true.
      [ c := stream peek. c notNil and: [ c isDigit ] ] whileTrue: [
         sgn := sgn / 10.
         int := sgn * (c digitValue) + int.
         stream next
      ]
   ].

   exp := 0.
   ((c = $e) or: [ c = $E ]) ifTrue: [
      stream next.
      c := stream peek.
      (c isNil) ifTrue: [ ^int ].
      sgn := 1.
      c = $+ ifTrue: [ sgn :=  1. stream next ].
      c = $- ifTrue: [ sgn := -1. stream next ].

      [ c := stream peek. c notNil and: [ c isDigit ] ] whileTrue: [
         exp := (c digitValue) + (exp * 10).
         stream next
      ].

      (1 to: exp) do: [ :i |
         sgn > 0
            ifTrue: [
               int := int * 10.
            ];
            ifFalse: [
               int := int / 10.
            ]
      ]
   ].

   isfloat ifTrue:  [ ^int asFloat ];
           ifFalse: [ ^int asInteger ]
! !

!Number methodsFor: 'json'!

toJSON
   "I return the Number in a JSON compatible format as String."
   ^(self asFloat) printString
! !

!Integer methodsFor: 'json'!

toJSON
   "I return the Integer in a JSON compatible format as String."
   ^self printString
! !

!Dictionary methodsFor: 'json'!

toJSON
   "I encode my contents (key/value pairs) to a JSON object and return it as String."
   | ws f |
   ws := WriteStream on: (String new).
   ws nextPut: ${.
   f := true.
   self keysAndValuesDo: [ :key :val |
      f ifFalse: [ ws nextPut: $, ].
      ws nextPutAll: (key toJSON).
      ws nextPut: $:.
      ws nextPutAll: val toJSON.
      f := false
   ].
   ws nextPut: $}.
   ^ws contents
! !

!String methodsFor: 'json'!

toJSON
   "I will encode me as JSON String and return a String containing my encoded version."
   | i c rs ws |
   rs := ReadStream  on: self.
   ws := WriteStream on: (String new).

   [ c := rs next. c notNil ] whileTrue: [
      i := c asInteger.
      (((i = 16r20
         or: [ i = 16r21 ])
         or: [ i >= 16r23 and: [ i <= 16r5B ] ])
         or: [ i >= 16r5D ])
            ifTrue: [ ws nextPut: c ];
            ifFalse: [ | f |
               f := false.
               ws nextPut: $\.
               i = 16r22 ifTrue: [ f := true. ws nextPut: c ].
               i = 16r5C ifTrue: [ f := true. ws nextPut: c ].
               i = 16r2F ifTrue: [ f := true. ws nextPut: c ].
               i = 16r08 ifTrue: [ f := true. ws nextPut: $b ].
               i = 16r0C ifTrue: [ f := true. ws nextPut: $f ].
               i = 16r0A ifTrue: [ f := true. ws nextPut: $n ].
               i = 16r0D ifTrue: [ f := true. ws nextPut: $r ].
               i = 16r09 ifTrue: [ f := true. ws nextPut: $t ].
               f ifFalse: [ ^self error: ('Unrecognized character found while encoding string to JSON, character: %1' bindWith: c) ]
            ]
   ].
   ^('"', (ws contents), '"')
! !

!SequenceableCollection methodsFor: 'json'!

toJSON
   "I'm returning a JSON encoding of my contents as String."
   | ws f |
   ws := WriteStream on: (String new).
   ws nextPut: $[.
   f := true.
   self do: [ :val |
      f ifFalse: [ ws nextPut: $, ].
      ws nextPutAll: (val toJSON).
      f := false
   ].
   ws nextPut: $].
   ^ws contents
! !

!UndefinedObject methodsFor: 'json'!

toJSON
   "I'm returning my corresponding value as JSON String."
   ^'null'
! !

!True methodsFor: 'json'!

toJSON
   "I'm returning the JSON String for trueness."
   ^'true'
! !

!False methodsFor: 'json'!

toJSON
   "I'm returning the JSON String for falseness."
   ^'false'
! !