-
Notifications
You must be signed in to change notification settings - Fork 1
/
rjson.bmx
1729 lines (1549 loc) · 57.8 KB
/
rjson.bmx
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Rem
bmx-rjson
reflection-based JSON encoder/decoder
by Tyler W.R. Cole
written according to the JSON specification
http://www.json.org
Note the following deviations from the standard(s):
* when parsing, a semicolon is an acceptable substitute for a comma
* when parsing, the '#' character outside of a string is treated as a single-line comment
* when parsing, it is okay for string values to be unquoted, as long as they only contain the following characters:
A-Za-z_0-9, and do not start with a number (suitable for 'enums')
* when parsing, trailing commas in object field-lists and array item-lists are ignored
* when parsing, it is okay for floating-point numbers to have a trailing 'f'
* when parsing, it is okay for numbers to have any number of leading zeroes
Note: this system does not support USER-DEFINED cyclic data structures,
but it does support the following BlitzMax built-in types which are cyclic:
* TList
* TMap
///////////////////////////////////
The following intermediate types are used for storage during stringifying/parsing
and are used to control Transformations that can override the default field mappings:
* TNull Extends TValue
* TBoolean Extends TValue
* TNumber Extends TValue
* TString Extends TValue
* TArray Extends TValue
* TObject Extends TValue
A separate set of mapping functions is used to map these very simple objects
to arbitrary BlitzMax types, via reflection.
///////////////////////////////////
Transformations are imperatives applied to a subset of data contained in a TValue.
They thus can transform the parsed or stringified JSON data mid-way through the process.
Filtering is performed via case-sensitive Selector strings, for example:
":string" --> any TString belonging to the root-level container
"$field" --> root-level TObject's field named "field"
"@5" --> root-level TArray's element at position 5
"" --> (wildcard) every root-level field or element
Any given Transformation must also specify whether it is to be applied during parse or stringify.
All Transformations are globally applied, but can be added/removed at any time.
Transformations can optionally specify a condition function that determines at run time whether an
imperative for a selected object should actually run; in this way they can vary based on arbitrary
user-defined conditions.
Supported transformation type selectors:
null
boolean
number
string
array
object
Supported transformation imperatives:
* XJ_DELETE
* XJ_RENAME( new_field_name )
* XJ_CONVERT( new_json_type_code )
EndRem
SuperStrict
Module twrc.rjson
Import brl.reflection
Import brl.retro
Import brl.linkedlist
Import brl.map
Type json
'Global settings
Global error_level% = 2 'legend 2: as strict as possible 1: ignore warnings 0: ignore errors & warnings
Global ext_logging_fn( msg$ ) 'function that can be externalized for logging
'Encode settings
Global formatted% = True 'false: compact, true: indented; global setting
Global formatted_array% = True 'false: compact, true: indented; global setting
Global empty_container_as_null% = False 'false: [] {} "", true: null
Global indent_size% = 2 'spaces per indent level, if formatted is true; global setting
Global precision% = 6 'cstdio.h default floating-point precision; can be overridden per field/object/instance/item/value
'Transformations
Global transformations:TMap = CreateMap()
'Generate a JSON-Encoded String from an arbitrary Object
Function stringify:String( source_object:Object, transforms_set$ = Null )
If Not source_object Then Return TValue.VALUE_NULL ' --> "null"
Local source_object_converted:TValue = reflect_to_TValue( source_object )
execute_transforms( transforms_set, source_object_converted )
Return source_object_converted.Encode( 0, precision )
EndFunction
'Generate an Object of the given type name from a JSON-Encoded String
Function parse:Object( encoded$, type_id$ = Null, transforms_set$ = Null )
If encoded = Null Then Return Null
Local cursor% = 0
Local intermediate_object:TValue = allocate_TValue( encoded, cursor )
If intermediate_object = Null Then Return Null
intermediate_object.Decode( encoded, cursor )
CheckLeftovers( encoded, cursor )
execute_transforms( transforms_set, intermediate_object )
If type_id <> Null
Local destination_type_id:TTypeId = TTypeId.ForName( type_id )
If destination_type_id
Local destination_object:Object = initialize_object( intermediate_object, destination_type_id )
Return destination_object
Else
json_error( json.LOG_ERROR + " Type ID not found: " + type_id )
EndIf
Else 'type_id not provided
Return intermediate_object
EndIf
EndFunction
Function add_transform( set_name$, selector$, imperative_id%, argument:Object = Null, condition_func%( val:TValue, root:TValue ) = Null )
Local xform:TValue_Transformation
xform = TValue_Transformation.Create( selector, imperative_id, argument, condition_func )
Local set:TList = TList( transformations.ValueForKey( set_name ) )
If Not set
set = CreateList()
transformations.Insert( set_name, set )
EndIf
set.AddLast( xform )
EndFunction
Function execute_transforms( set_name$, val:TValue )
If set_name
Local xform_set:TList = TList( transformations.ValueForKey( set_name ) )
If xform_set
For Local xform:TValue_Transformation = EachIn xform_set
If xform
xform.Execute( val ) 'Execute any available transformations
EndIf
Next
EndIf
EndIf
EndFunction
Function clear_transforms( set_name$=Null )
If set_name = Null
transformations.Clear()
Else
transformations.Remove( set_name )
EndIf
EndFunction
'transformations ////////////////////////////////////////////////////////////
Const XJ_DELETE% = 86
Const XJ_RENAME% = 102
Const XJ_CONVERT% = 1199
'Selector Type Codes
Const SEL_NULL$ = "null"
Const SEL_BOOLEAN$ = "boolean"
Const SEL_NUMBER$ = "number"
Const SEL_STRING$ = "string"
Const SEL_ARRAY$ = "array"
Const SEL_OBJECT$ = "object"
Const SEL_EMUN$ = "emun"
'////////////////////////////////////////////////////////////////////////////
Function allocate_TValue:TValue( encoded$, cursor% )
Local jsontype% = TValue.PredictJSONType( encoded, cursor )
If jsontype = TValue.JSONTYPE_INVALID Then Return Null
Local intermediate_object:TValue
Select jsontype
Case TValue.JSONTYPE_NULL
intermediate_object = New TNull
Case TValue.JSONTYPE_BOOLEAN
intermediate_object = New TBoolean
Case TValue.JSONTYPE_NUMBER
intermediate_object = New TNumber
Case TValue.JSONTYPE_STRING
intermediate_object = New TString
Case TValue.JSONTYPE_ARRAY
intermediate_object = New TArray
Case TValue.JSONTYPE_OBJECT
intermediate_object = New TObject
Case TValue.JSONTYPE_ENUM
intermediate_object = New TEnum
EndSelect
Return intermediate_object
EndFunction
'Nested Array Types (e.g.: Int[][][] ) ARE supported
'Single Arrays with Multiple Dimensions (e.g.: Int[4,3,5] ) are NOT supported
Function reflect_to_TValue:TValue( source_object:Object, explicit_source_object_type_id:TTypeId = Null )
If source_object = Null ..
And (json.empty_container_as_null = True Or explicit_source_object_type_id = Null)
Return New TNull
EndIf
Local converted_object:TValue = TValue( source_object )
If Not converted_object 'requires reflection-based conversion
Local source_object_type_id:TTypeId
If explicit_source_object_type_id
source_object_type_id = explicit_source_object_type_id
Else
source_object_type_id = TTypeId.ForObject( source_object )
EndIf
'Check for cyclic built-in types; process them in a special way for convenience
If source_object_type_id = TMap_TTypeId
converted_object = New TObject
If source_object <> Null
For Local key$ = EachIn TMap(source_object).Keys()
TObject(converted_object).fields.Insert( key, reflect_to_TValue( TMap(source_object).ValueForKey( key )))
Next
EndIf
ElseIf source_object_type_id = TList_TTypeId
converted_object = New TArray
If source_object <> Null
For Local item:Object = EachIn TList(source_object)
TArray(converted_object).elements.AddLast( reflect_to_TValue( item ))
Next
EndIf
Else
If source_object_type_id.ElementType() = Null
'Not Array
If source_object_type_id = StringTypeId
'String
converted_object = New TString
If source_object <> Null
TString(converted_object).value = String(source_object)
EndIf
Else
'Non-array Non-string: User Defined Object
'Get list of fields in type hierarchy
converted_object = New TObject
If source_object <> Null
Local source_object_fields:TList = enumerate_fields( source_object_type_id )
Local field_count% = source_object_fields.Count()
If field_count > 0
Local field_value:TValue
'For every field of the SOURCE OJBECT:
For Local source_object_field:TField = EachIn source_object_fields
Select source_object_field.TypeId()
Case IntTypeId, ShortTypeId, ByteTypeId
field_value = New TNumber
TNumber(field_value).value = source_object_field.GetInt( source_object )
Case LongTypeId
field_value = New TNumber
TNumber(field_value).value = source_object_field.GetLong( source_object )
Case FloatTypeId
field_value = New TNumber
TNumber(field_value).value = source_object_field.GetFloat( source_object )
Case DoubleTypeId
field_value = New TNumber
TNumber(field_value).value = source_object_field.GetDouble( source_object )
Default
field_value = reflect_to_TValue( source_object_field.Get( source_object ), source_object_field.TypeId() )
EndSelect
TObject(converted_object).fields.Insert( source_object_field.Name(), field_value )
Next
EndIf
EndIf
EndIf
Else ' source_object_type_id.ElementType() <> Null
'Is Array
converted_object = New TArray
If source_object <> Null
Local array_length% = source_object_type_id.ArrayLength( source_object )
If array_length > 0
Local element:Object
Local element_value:TValue
Local source_object_element_type_id:TTypeId = source_object_type_id.ElementType()
'For every element of the SOURCE ARRAY:
For Local i% = 0 Until array_length
element = source_object_type_id.GetArrayElement( source_object, i )
Select source_object_element_type_id
Case IntTypeId, ShortTypeId, ByteTypeId, LongTypeId, FloatTypeId, DoubleTypeId
element_value = New TNumber
TNumber(element_value).value = String( element ).ToDouble()
Default
element_value = reflect_to_TValue( element, source_object_element_type_id )
EndSelect
TArray(converted_object).elements.AddLast( element_value )
Next
EndIf
EndIf
EndIf
EndIf
EndIf
Return converted_object
EndFunction
'fields defined by the destination type are OPTIONAL by default;
' extra data or data not found will only generate warnings
Function initialize_object:Object( source:TValue, type_id:TTypeId )
If TNull(source) Or source = Null Then Return Null
Local source_mapped:Object
If type_id = TTypeId.ForName("TValue") ..
Or type_id.SuperType() = TTypeId.ForName("TValue") ..
Or type_id = TTypeId.ForName("Object")
source_mapped = source
Else
Local source_object_type_id:TTypeId = TTypeId.ForObject( source )
'Check for cyclic built-in types; process them in a special way for convenience
If type_id = TMap_TTypeId And TObject(source)
source_mapped = TObject(source).fields
'TODO: provide a way to specify a conversion type for these
ElseIf type_id = TList_TTypeId And TArray(source)
source_mapped = TArray(source).elements
'TODO: provide a way to specify a conversion type for these
ElseIf type_id.ElementType() = Null
'Not Array Type
If type_id = StringTypeId
'String
If TString(source)
source_mapped = TString(source).value
Else
json_error( json.LOG_WARN+" could not initialize "+type_id.Name()+" from "+source_object_type_id.Name() )
EndIf
Else
'Non-array Non-string: User Defined Object
If TObject(source)
'Object data type provided (ideal)
source_mapped = type_id.NewObject()
Local source_mapped_field:TField
Local source_field_value:TValue
For Local field_name$ = EachIn TObject(source).fields.Keys()
source_mapped_field = type_id.FindField( field_name )
If source_mapped_field <> Null
source_field_value = TValue(TObject(source).fields.ValueForKey( field_name ))
Select source_mapped_field.TypeId()
Case IntTypeId, ShortTypeId, ByteTypeId
If TNumber(source_field_value)
source_mapped_field.SetInt( source_mapped, Int(TNumber(source_field_value).value) )
ElseIf TBoolean(source_field_value)
source_mapped_field.SetInt( source_mapped, Int(TBoolean(source_field_value).value) )
ElseIf TString(source_field_value)
source_mapped_field.SetInt( source_mapped, Int(TString(source_field_value).value.ToInt()) )
Else
json_error( json.LOG_WARN+" could not initialize "+source_mapped_field.TypeId().Name()+" from "+TTypeId.ForObject( source_field_value ).Name() )
EndIf
Case LongTypeId
If TNumber(source_field_value)
source_mapped_field.SetLong( source_mapped, Long(TNumber(source_field_value).value) )
ElseIf TBoolean(source_field_value)
source_mapped_field.SetLong( source_mapped, Long(TBoolean(source_field_value).value) )
ElseIf TString(source_field_value)
source_mapped_field.SetLong( source_mapped, Long(TString(source_field_value).value.ToLong()) )
Else
json_error( json.LOG_WARN+" could not initialize "+source_mapped_field.TypeId().Name()+" from "+TTypeId.ForObject( source_field_value ).Name() )
EndIf
Case FloatTypeId
If TNumber(source_field_value)
source_mapped_field.SetFloat( source_mapped, Float(TNumber(source_field_value).value) )
ElseIf TBoolean(source_field_value)
source_mapped_field.SetFloat( source_mapped, Float(TBoolean(source_field_value).value) )
ElseIf TString(source_field_value)
source_mapped_field.SetFloat( source_mapped, Float(TString(source_field_value).value.ToFloat()) )
Else
json_error( json.LOG_WARN+" could not initialize "+source_mapped_field.TypeId().Name()+" from "+TTypeId.ForObject( source_field_value ).Name() )
EndIf
Case DoubleTypeId
If TNumber(source_field_value)
source_mapped_field.SetDouble( source_mapped, Double(TNumber(source_field_value).value) )
ElseIf TBoolean(source_field_value)
source_mapped_field.SetDouble( source_mapped, Double(TBoolean(source_field_value).value) )
ElseIf TString(source_field_value)
source_mapped_field.SetDouble( source_mapped, Double(TString(source_field_value).value.ToDouble() ) )
Else
json_error( json.LOG_WARN+" could not initialize "+source_mapped_field.TypeId().Name()+" from "+TTypeId.ForObject( source_field_value ).Name() )
EndIf
Default
'Recurse
source_mapped_field.Set( source_mapped, initialize_object( source_field_value, source_mapped_field.TypeId() ) )
EndSelect
Else
json_error( json.LOG_WARN+" could not find field name "+field_name+" in object of type "+type_id.Name() )
EndIf
Next
Else
'Some other type of TValue provided
json_error( json.LOG_WARN+" could not initialize "+type_id.Name()+" from "+source_object_type_id.Name() )
EndIf
EndIf
Else ' type_id.ElementType() <> Null
'Array Type
If TArray(source)
Local element_type_id:TTypeId = type_id.ElementType()
Local size% = TArray(source).elements.Count()
source_mapped = type_id.NewArray( size )
Local index% = 0
For Local source_element_value:TValue = EachIn TArray(source).elements
If source_element_value <> Null
Select element_type_id
Case IntTypeId, ShortTypeId, ByteTypeId, LongTypeId
If TNumber(source_element_value)
type_id.SetArrayElement( source_mapped, index, TNumber(source_element_value).Encode( 0, 0 ))
Else
json_error( json.LOG_WARN+" could not initialize "+element_type_id.Name()+" from "+TTypeId.ForObject( source_element_value ).Name() )
EndIf
Case FloatTypeId, DoubleTypeId
If TNumber(source_element_value)
type_id.SetArrayElement( source_mapped, index, TNumber(source_element_value).Encode( 0, json.precision ))
Else
json_error( json.LOG_WARN+" could not initialize "+element_type_id.Name()+" from "+TTypeId.ForObject( source_element_value ).Name() )
EndIf
Default
'Recurse
type_id.SetArrayElement( source_mapped, index, initialize_object( source_element_value, element_type_id ) )
EndSelect
EndIf
index :+ 1
Next
Else
json_error( json.LOG_WARN+" could not initialize "+type_id.Name()+" from "+source_object_type_id.Name() )
EndIf
EndIf
EndIf
Return source_mapped
EndFunction
'////////////////////////////////////////////////////////////////////////////
Function enumerate_fields:TList( type_id:TTypeId )
Local fields:TList = CreateList()
Local type_cursor:TTypeId = type_id
Repeat
type_cursor.EnumFields( fields )
type_cursor = type_cursor.SuperType()
Until type_cursor = Null
Return fields
EndFunction
'////////////////////////////////////////////////////////////////////////////
Function FormatDouble:String( value:Double, precision:Int=-1 )
'trims trailing zeroes and decimal separator
Extern "C"
Function snprintf_:Int( s:Byte Ptr, n:Int, Format$z, p:Int, v1:Double) = "snprintf"
EndExtern
Const CHAR_0:Byte = Asc("0")
Const CHAR_DOT:Byte = Asc(".")
Const STR_FMT:String = "%.*f"
If precision = -1 Then precision = json.precision
Local i:Double
Local buf:Byte[256]
Local sz:Int = snprintf_( buf, buf.Length, STR_FMT, precision, value)
sz :- 1
While (sz > 0) And (buf[sz] = CHAR_0) And precision > 0
sz :- 1
Wend
If (sz < buf.Length) And buf[sz] <> CHAR_DOT
sz :+ 1
EndIf
If sz > 0
Return String.FromBytes( buf, sz )
Else
Return "0"
EndIf
EndFunction
Function EatWhitespace( encoded$, cursor% Var )
' advance cursor to first printable character
Local cursor_char$, comment% = False
While cursor < encoded.Length
cursor_char = Chr( encoded[cursor] )
If Chr( encoded[cursor] ) = "#"
comment = True
Else If Chr( encoded[cursor] ) = "~r" Or Chr( encoded[cursor] ) = "~n"
comment = False
End If
If comment Or Not IsPrintable( cursor_char )
cursor :+ 1
Else
Exit 'done
End If
End While
EndFunction
Function EatSpecific%( encoded$, cursor% Var, char_filter$, limit% = - 1, require% = - 1 )
Local cursor_start% = cursor
Local contained_in_filter% = True
While cursor < encoded.Length And contained_in_filter
contained_in_filter = False
For Local c% = 0 Until char_filter.Length
If encoded[cursor] = char_filter[c]
contained_in_filter = True
Exit
End If
Next
If contained_in_filter
cursor :+ 1
End If
If limit <> - 1 And (cursor - cursor_start) >= limit
Exit
End If
End While
If require <> - 1 And (cursor - cursor_start) < require
json_error( json.LOG_ERROR+" expected at least "+require+" characters from the set ["+char_filter+"]" )
End If
Return cursor - cursor_start
EndFunction
Function CheckLeftovers( encoded$, cursor% Var )
If cursor < encoded.Length
EatWhitespace( encoded, cursor )
If cursor < encoded.Length
json_error( json.LOG_ERROR+" unexpected data following root-level entity: "+Chr(encoded[cursor]) )
EndIf
EndIf
EndFunction
Function RepeatSpace$( count% )
Return LSet( "", count )
EndFunction
Function Escape$( str$ )
Return str.Replace( "\", "\\" ).Replace( "~q", "\~q" ).Replace( "~r", "\r" ).Replace( "~n", "\n" ).Replace( "~t", "\t" )
EndFunction
Function IsNumeric%( char$ )
If char.Length > 1 Then char = char[0..1]
Local ascii_code% = Asc( char )
Return (ascii_code >= Asc( "0" ) And ascii_code <= Asc( "9" )) ..
Or (ascii_code = Asc("-") Or ascii_code = Asc("+")) ..
Or (ascii_code = Asc("."))
End Function
Function IsAlphaNumericOrUnderscore%( char$ )
If char.length > 1 Then char = char[0..1]
Local ascii_code% = Asc( char )
Return (ascii_code >= Asc( "A" ) And ascii_code <= Asc( "Z" )) ..
Or (ascii_code >= Asc( "a" ) And ascii_code <= Asc( "z" )) ..
Or (ascii_code >= Asc( "0" ) And ascii_code <= Asc( "9" )) ..
Or ascii_code = Asc( "_" )
End Function
Function IsPrintable%( char$ )
If char.Length > 1 Then char = char[0..1]
Local ascii_code% = Asc( char )
Return ascii_code > 32 And ascii_code <> 127
EndFunction
Function ShowPosition$( encoded$, cursor% )
If cursor >= 0 And cursor < encoded.Length
Local encoded_line$ = Chr(encoded[cursor])
Local indicator$ = "^"
Local cR% = cursor + 1
Local cL% = cursor - 1
Local cR_done_early% = False
Local cL_done_early% = False
While encoded_line.Length < 80 And Not (cR_done_early And cL_done_early)
If cR < encoded.Length And Chr(encoded[cR]) <> "~r" And Chr(encoded[cR]) <> "~n"
If Chr(encoded[cR]) <> "~t"
encoded_line = encoded_line + Chr(encoded[cR])
indicator = indicator + " "
Else 'tab
encoded_line = encoded_line + " "
indicator = indicator + " "
EndIf
cR :+ 1
Else
cR_done_early = True
EndIf
If cL >= 0 And Chr(encoded[cL]) <> "~r" And Chr(encoded[cL]) <> "~n"
If Chr(encoded[cL]) <> "~t"
encoded_line = Chr(encoded[cL]) + encoded_line
indicator = " " + indicator
Else 'tab
encoded_line = " " + encoded_line
indicator = " " + indicator
EndIf
cL :- 1
Else
cL_done_early = True
EndIf
EndWhile
Return "~n"+encoded_line+"~n"+indicator
Else
Return ""
EndIf
EndFunction
'logging/exceptions /////////////////////////////////////////////////////////
Const LOG_WARN$ = " [WARN]"
Const LOG_ERROR$ = " [ERROR]"
'supported built-in cyclic data types ///////////////////////////////////////
Global TMap_TTypeId:TTypeId = TTypeId.ForName("TMap")
Global TList_TTypeId:TTypeId = TTypeId.ForName("TList")
'////////////////////////////////////////////////////////////////////////////
?Debug
Function ObjectInfo$( obj:Object )
If obj <> Null
Return "$" + Hex( Int( Byte Ptr( obj ))) + ":" + TTypeId.ForObject( obj ).Name()
Else
Return "$" + Hex( 0 )
End If
End Function
'////
Function PathInfo$( path:TValue_Selector_Token[] )
Local s$ = ""
If path
For Local i% = 0 Until path.Length
If i > 0 Then s :+ "/"
s :+ path[i].ToString()
Next
EndIf
Return s
EndFunction
'////
Function PathIndent$( path:TValue_Selector_Token[] )
If Not path Then Return "" Else Return LSet("",path.Length*2)
EndFunction
?
End Type
'////////////////////////////////////////////////////////////////////////////
Function json_error( message$ )
Select json.error_level
Case 2 ' strict
If message.StartsWith( json.LOG_ERROR ) Or message.StartsWith( json.LOG_WARN )
Throw message
EndIf
Case 1 ' ignore warnings
If message.StartsWith( json.LOG_ERROR )
Throw message
Else
If json.ext_logging_fn
json.ext_logging_fn( message )
EndIf
EndIf
Case 0 ' ignore all
If json.ext_logging_fn
json.ext_logging_fn( message )
EndIf
EndSelect
EndFunction
'////////////////////////////////////////////////////////////////////////////
'////////////////////////////////////////////////////////////////////////////
'////////////////////////////////////////////////////////////////////////////
Type TValue
Field value_type%
Method Encode:String( indent%, precision% ) Abstract
Method Decode( encoded$, cursor% Var ) Abstract
Method Copy:TValue() Abstract
Method Equals%( val:Object ) Abstract
Function Create:TValue( other:TValue ) Abstract
'////////////////////////////////////////////////////////////////////////////
Method ToString:String()
Return Encode( 0, json.precision )
EndMethod
Method GetSelectorCode$()
Select value_type
Case JSONTYPE_NULL
Return json.SEL_NULL
Case JSONTYPE_BOOLEAN
Return json.SEL_BOOLEAN
Case JSONTYPE_NUMBER
Return json.SEL_NUMBER
Case JSONTYPE_STRING
Return json.SEL_STRING
Case JSONTYPE_ARRAY
Return json.SEL_ARRAY
Case JSONTYPE_OBJECT
Return json.SEL_OBJECT
Case JSONTYPE_ENUM
Return json.SEL_EMUN
Default
Return Null
EndSelect
EndMethod
'////////////////////////////////////////////////////////////////////////////
'this method is used to select an appropriate intermediate type to decode into
' given only the encoded JSON data
Function PredictJSONType%( encoded$, cursor% )
If encoded = Null Or encoded = "" Then Return JSONTYPE_NULL
json.EatWhitespace( encoded, cursor )
encoded = encoded[cursor..(cursor + SCAN_DISTANCE)]
If encoded.StartsWith( VALUE_NULL )
Return JSONTYPE_NULL
ElseIf encoded.StartsWith( VALUE_TRUE ) Or encoded.StartsWith( VALUE_FALSE )
Return JSONTYPE_BOOLEAN
ElseIf json.IsNumeric( encoded )
Return JSONTYPE_NUMBER
ElseIf encoded.StartsWith( STRING_BEGIN )
Return JSONTYPE_STRING
ElseIf encoded.StartsWith( ARRAY_BEGIN )
Return JSONTYPE_ARRAY
ElseIf encoded.StartsWith( OBJECT_BEGIN )
Return JSONTYPE_OBJECT
ElseIf json.IsAlphaNumericOrUnderscore( encoded )
Return JSONTYPE_ENUM 'unquoted string that should be a emun item.
Else
Return JSONTYPE_INVALID
EndIf
EndFunction
'Internal Type Enums
Const JSONTYPE_INVALID% = -1
Const JSONTYPE_NULL% = 0
Const JSONTYPE_BOOLEAN% = 1
Const JSONTYPE_NUMBER% = 2
Const JSONTYPE_STRING% = 3
Const JSONTYPE_ARRAY% = 4
Const JSONTYPE_OBJECT% = 5
Const JSONTYPE_ENUM% = 6
'ASCII Literals
Const OBJECT_BEGIN$ = "{"
Const OBJECT_END$ = "}"
Const MEMBER_SEPARATOR$ = ","
Const PAIR_SEPARATOR$ = ":"
Const ARRAY_BEGIN$ = "["
Const ARRAY_END$ = "]"
Const VALUE_SEPARATOR$ = ","
Const VALUE_SEPARATOR_ALTERNATE$ = ";"
Const VALUE_TRUE$ = "true"
Const VALUE_FALSE$ = "false"
Const VALUE_NULL$ = "null"
Const STRING_BEGIN$ = "~q"
Const STRING_END$ = "~q"
Const STRING_ESCAPE_SEQUENCE_BEGIN$ = "\"
Const STRING_ESCAPE_QUOTATION$ = "~q"
Const STRING_ESCAPE_REVERSE_SOLIDUS$ = "\"
Const STRING_ESCAPE_SOLIDUS$ = "/"
Const STRING_ESCAPE_BACKSPACE$ = "b"
Const STRING_ESCAPE_FORMFEED$ = "f"
Const STRING_ESCAPE_NEWLINE$ = "n"
Const STRING_ESCAPE_CARRIAGE_RETURN$ = "r"
Const STRING_ESCAPE_HORIZONTAL_TAB$ = "t"
Const STRING_ESCAPE_UNICODE_BEGIN$ = "u"
Const SCAN_DISTANCE% = 5 'the most number of characters that we'd ever have to look ahead by
EndType
Type TNull Extends TValue
Method New()
value_type = JSONTYPE_NULL
EndMethod
Method Encode:String( indent%, precision% )
Return VALUE_NULL
EndMethod
Method Decode( encoded$, cursor% Var )
json.EatWhitespace( encoded, cursor )
If encoded[cursor..(cursor+VALUE_NULL.Length)] = VALUE_NULL
cursor :+ VALUE_NULL.Length
EndIf
EndMethod
Method Copy:TValue()
Return New TNull
EndMethod
Method Equals%( other:Object )
Return (TNull(other) <> Null And TNull(other).value_type = JSONTYPE_NULL)
EndMethod
Function Create:TValue( other:TValue )
Return New TNull
EndFunction
EndType
Type TBoolean Extends TValue
Field value:Int
Method New()
value_type = JSONTYPE_BOOLEAN
EndMethod
Method Encode:String( indent%, precision% )
If value = 0
Return VALUE_FALSE
Else
Return VALUE_TRUE
EndIf
EndMethod
Method Decode( encoded$, cursor% Var )
json.EatWhitespace( encoded, cursor )
If encoded[cursor..(cursor+VALUE_FALSE.Length)] = VALUE_FALSE
value = False
cursor :+ VALUE_FALSE.Length
ElseIf encoded[cursor..(cursor+VALUE_TRUE.Length)] = VALUE_TRUE
value = True
cursor :+ VALUE_TRUE.Length
EndIf
EndMethod
Method Copy:TValue()
Local val:TBoolean = New TBoolean
val.value = value
Return val
EndMethod
Method Equals%( other:Object )
Return (TBoolean(other) <> Null And TBoolean(other).value_type = JSONTYPE_BOOLEAN And TBoolean(other).value = Self.value)
EndMethod
Function Create:TValue( other:TValue )
Local val:TBoolean = New TBoolean
Select other.value_type
Case JSONTYPE_NULL
val.value = False
Case JSONTYPE_BOOLEAN
val.value = TBoolean(other).value
Case JSONTYPE_NUMBER
val.value = (TNumber(other).value <> 0)
Case JSONTYPE_STRING
val.value = (TString(other).value <> "")
Case JSONTYPE_ARRAY
val.value = (Not TArray(other).elements.IsEmpty())
Case JSONTYPE_OBJECT
val.value = (Not TObject(other).fields.IsEmpty())
Case JSONTYPE_ENUM
val.value = (TEnum(other).value <> "")
EndSelect
Return val
EndFunction
EndType
Type TNumber Extends TValue
Field value:Double
Method New()
value_type = JSONTYPE_NUMBER
EndMethod
Method Encode:String( indent%, precision% )
Return json.FormatDouble( value, precision )
EndMethod
Method Decode( encoded$, cursor% Var )
'(untested) roughly equivalent regular expression:
' [+-.]?\d+(:?[.]\d+)?(:?[eE][+-]?\d+)?f?
json.EatWhitespace( encoded, cursor )
Local cursor_start% = cursor
Local floating_point% = False
json.EatSpecific( encoded, cursor, "+-", 1 ) 'positive/negative
If json.EatSpecific( encoded, cursor, ".", 1 ) 'leading decimal pt.
floating_point = True
End If
json.EatSpecific( encoded, cursor, "0123456789",, 1 )
If Not floating_point And json.EatSpecific( encoded, cursor, ".", 1 ) 'middle decimal pt.
floating_point = True
json.EatSpecific( encoded, cursor, "0123456789",, 1 ) 'digits following decimal point
End If
If json.EatSpecific( encoded, cursor, "eE", 1 ) 'scientific notation
floating_point = True
json.EatSpecific( encoded, cursor, "+-", 1 ) 'mantissa
json.EatSpecific( encoded, cursor, "0123456789",, 1 )
End If
If json.EatSpecific( encoded, cursor, "f", 1, 0 ) 'trailing f (floating point, java)
floating_point = True
End If
If (cursor - cursor_start) > 0
Local encoded_number$ = encoded[cursor_start..cursor]
If encoded_number And encoded_number.length > 0
value = encoded_number.ToDouble()
End If
End If
EndMethod
Method Copy:TValue()
Local val:TNumber = New TNumber
val.value = value
Return val
EndMethod
Method Equals%( other:Object )
Return (TNumber(other) <> Null And TNumber(other).value_type = JSONTYPE_NUMBER And TNumber(other).value = Self.value)
EndMethod
Function Create:TValue( other:TValue )
Local val:TNumber = New TNumber
Select other.value_type
Case JSONTYPE_NULL
val.value = 0
Case JSONTYPE_BOOLEAN
val.value = Double(TBoolean(other).value)
Case JSONTYPE_NUMBER
val.value = TNumber(other).value
Case JSONTYPE_STRING
val.value = TString(other).value.ToDouble()
Case JSONTYPE_ARRAY
val.value = 0
Case JSONTYPE_OBJECT
val.value = 0
Case JSONTYPE_ENUM
val.value = TEnum(other).value.ToDouble()
EndSelect
Return val
EndFunction
EndType
Type TString Extends TValue
Field value:String
Method New()
value_type = JSONTYPE_STRING
EndMethod
Method Encode:String( indent%, precision% )
If value = Null And json.empty_container_as_null
Return VALUE_NULL
Else
Return STRING_BEGIN + json.Escape( value ) + STRING_END
EndIf
EndMethod
Method Decode( encoded$, cursor% Var )
Local decoded_value$ = ""
Local unquoted_mode_active% = False
json.EatWhitespace( encoded, cursor )
Local char$, char_temp$
If cursor >= (encoded.length) Then Return
char = Chr(encoded[cursor]); cursor :+ 1
If char <> STRING_BEGIN
If json.IsAlphaNumericOrUnderscore( char )
decoded_value :+ char 'NORMAL STRING CHARACTER
unquoted_mode_active = True
Else
json_error( json.LOG_ERROR + " expected string at position " + (cursor - 1) + json.ShowPosition(encoded, (cursor - 1) ) )
EndIf
End If
If Not unquoted_mode_active
'Normal, Quoted String Mode
Repeat
char = Chr(encoded[cursor]); cursor :+ 1
If char = STRING_END
Exit
End If
If char = "~r" Or char = "~n"
json_error( json.LOG_ERROR+" unescaped newline in string at position "+(cursor-1)+json.ShowPosition(encoded,(cursor-1)) )
ElseIf char = "~t"
json_error( json.LOG_ERROR+" unescaped horizontal-tab in string at position "+(cursor-1)+json.ShowPosition(encoded,(cursor-1)) )
ElseIf char <> STRING_ESCAPE_SEQUENCE_BEGIN
decoded_value :+ char 'NORMAL STRING CHARACTER
Else
If cursor >= encoded.Length
json_error( json.LOG_ERROR+" unterminated string literal" )
End If
char_temp = Chr(encoded[cursor]); cursor :+ 1
Select char_temp
Case STRING_ESCAPE_QUOTATION
decoded_value :+ "~q"
Case STRING_ESCAPE_REVERSE_SOLIDUS
decoded_value :+ "\"
Case STRING_ESCAPE_SOLIDUS
decoded_value :+ "/"
Case STRING_ESCAPE_BACKSPACE
'ignore
Case STRING_ESCAPE_FORMFEED
'ignore
Case STRING_ESCAPE_NEWLINE
decoded_value :+ "~n"
Case STRING_ESCAPE_CARRIAGE_RETURN
decoded_value :+ "~r"
Case STRING_ESCAPE_HORIZONTAL_TAB
decoded_value :+ "~t"
Case STRING_ESCAPE_UNICODE_BEGIN
'ignore
cursor :+ 4
Default