JSON.apl

⍝!
⍝ RFC 7159 JSON
⍝ klg, Jul 2016
⍝ vim:kmp=apl:

∇JSON∆∆Assert X
  'JSON Syntax Error' ⎕ES (~X)/5 4
∇

∇R←A JSON∆∆Expect J
 ⍝ Match first character or signal error.
  JSON∆∆Assert (⍴,A)>(R←A⍳↑J)-⎕IO
∇

∇R←JSON∆∆CvtHEX X;H
 ⍝ Convert hexadecimal vector to number.
  H←'abcdef0123456789ABCDEF'
  JSON∆∆Assert ∧/X∊H
  R←16⊥16|(H⍳X)-6+⎕IO
∇

∇R←JSON∆∆CvtUTF16 X;I;J
 ⍝ Convert UTF-16 surrogates to proper codepoints.
  X←⎕UCS X
  I←(55296≤X)∧X≤56319
  J←(56320≤X)∧X≤57343
  JSON∆∆Assert (0,I)≡J,0
  (I/X)←9216+(J/X)+1024×(I/X)-55296
  R←⎕UCS (~J)/X
∇

∇R←JSON∆∆Parse∆String J;⎕IO;S;X
 ⍝ Parse JSON string; return value and unconsumed suffix.
  ⎕IO←1
  JSON∆∆Assert '"'=↑J
  S←0⍴ J←1↓J
 NEXT:
  X←⌊/J⍳'\"'
  S←S,(X-1)↑J
 →('"'=J[X])/END
  J←X↓J
  X←'u"\/bfnrt' JSON∆∆Expect J
  S←S,∊X⊃(⊂''),"\"\\/\b\f\n\r\t"
  J←1↓J
 →(1<X)/NEXT
  S←S,⎕UCS JSON∆∆CvtHEX 4↑J
  J←4↓J
 →NEXT
 END:
  S←JSON∆∆CvtUTF16 S
  R←S (X↓J)
∇

∇R←JSON∆∆Parse∆Number J;⎕IO;I;N
 ⍝ Parse JSON number; return value and unconsumed suffix.
  ⎕IO←0
  I←'-'=↑J←,J
  N←J∊'0123456789'
  I←I+(I↓N)⍳0
 →(I≥⍴J)/END
  I←I+'.'=J[I]
  I←I+(I↓N)⍳0
 →(I≥⍴J)/END
  I←I+J[I]∊'Ee'
  I←I+J[I]∊'+-'
  I←I+(I↓N)⍳0
 END:
  JSON∆∆Assert 0<I
  JSON∆∆Assert N[I-1]
  R←('+'≠R)/R←I↑J
  (('-'=R)/R)←'¯'
  R←(⍎R)(I↓J)
∇

∇R←JSON∆∆Parse∆Const J;I
 ⍝ Parse JSON constants; return value and unconsumed suffix.
 ⍝ Boolean values are represented as 0 and 1, null as ⍬.
  I←'ftn'⍳↑J←,J
  JSON∆∆Assert 3>I-⎕IO
  JSON∆∆Assert (I⊃'false' 'true' 'null') ≡ (I⊃5 4 4)↑J
  R←(I⊃0 1,⊂0⍴0)((I⊃5 4 4)↓J)
∇

∇R←JSON∆∆StripWS J
 ⍝ Consume insignificant whitespace.
  R←(((J∊" \t\n\r")⍳0)-⎕IO)↓J
∇

∇R←JSON∆∆Parse∆Array J;X;A
 ⍝ Parse JSON vector; return value and unconsumed suffix.
  A←0⍴''
  JSON∆∆Assert '['=↑J
 NEXT:
  J←JSON∆∆StripWS 1↓J
 →(']'=↑J)/END
  (X J)←JSON∆∆Parse∆Value J
  A←A,⊂X
  J←JSON∆∆StripWS J
 →(','=↑J)/NEXT
 END:
  JSON∆∆Assert ']'=↑J
  R←A (1↓J)
∇

∇R←JSON∆∆Parse∆Object J;O;K;V
 ⍝ Parse JSON object; return value and unconsumed suffix.
 ⍝ Objects are represented as 2-column key-value matrices.
  O←0 2⍴''
  JSON∆∆Assert '{'=↑J
 NEXT:
  J←JSON∆∆StripWS 1↓J
 →('}'=↑J)/END
  (K J)←JSON∆∆Parse∆String J
  J←JSON∆∆StripWS J
  JSON∆∆Assert ':'=↑J
  J←JSON∆∆StripWS 1↓J
  (V J)←JSON∆∆Parse∆Value J
  O←O⍪K V
  J←JSON∆∆StripWS J
 →(','=↑J)/NEXT
 END:
  JSON∆∆Assert '}'=↑J
  R←O (1↓J)
∇

∇R←JSON∆∆Parse∆Value J;S;P
 ⍝ Parse JSON value; return value and unconsumed suffix.
  J←JSON∆∆StripWS,J
  S←'ftn{["-0123456789'
  P←(⍴S)⍴⊂"⎕ES'Not implemented yet'"
  P[S⍳'ftn']←⊂'JSON∆∆Parse∆Const J'
  P[S⍳'0123456789-']←⊂'JSON∆∆Parse∆Number J'
  P[S⍳'"']←⊂'JSON∆∆Parse∆String J'
  P[S⍳'[']←⊂'JSON∆∆Parse∆Array J'
  P[S⍳'{']←⊂'JSON∆∆Parse∆Object J'
  R←⍎(S JSON∆∆Expect J)⊃P
∇

∇R←JSON∆Parse J
 ⍝ Parse JSON data from character vector.
  (R J)←JSON∆∆Parse∆Value J
  JSON∆∆Assert '' ≡ JSON∆∆StripWS J
∇

∇R←JSON∆Read FILE
 ⍝ Read JSON data from named file.
  R←JSON∆Parse 19⎕CR (⎕FIO[26] FILE)
∇

⍝⍝ TODO: Clean up, Test & Fuzz