|
21 | 21 | # Top level JSON encoder which encodes the given
|
22 | 22 | # value based on the schema
|
23 | 23 | proc json::encode {value {schema str}} {
|
24 |
| - json::encode.[lindex $schema 0] $value [lrange $schema 1 end] |
| 24 | + json::subencode [lindex $schema 0] $value [lrange $schema 1 end] |
25 | 25 | }
|
26 | 26 |
|
27 |
| -# Encode a string |
28 |
| -proc json::encode.str {value {dummy {}}} { |
29 |
| - # Strictly we should be converting \x00 through \x1F to unicode escapes |
30 |
| - # And anything outside the BMP to a UTF-16 surrogate pair |
31 |
| - return \"[string map [list \\ \\\\ \" \\" \f \\f \n \\n / \\/ \b \\b \r \\r \t \\t] $value]\" |
32 |
| -} |
33 |
| -
|
34 |
| -# If no type is given, also encode as a string |
35 |
| -proc json::encode. {args} { |
36 |
| - tailcall json::encode.str {*}$args |
37 |
| -} |
38 |
| -
|
39 |
| -# Encode a number |
40 |
| -proc json::encode.num {value {dummy {}}} { |
41 |
| - if {$value in {Inf -Inf}} { |
42 |
| - append value inity |
43 |
| - } |
44 |
| - return $value |
45 |
| -} |
46 |
| -
|
47 |
| -# Encode a boolean |
48 |
| -proc json::encode.bool {value {dummy {}}} { |
49 |
| - if {$value} { |
50 |
| - return true |
51 |
| - } |
52 |
| - return false |
53 |
| -} |
54 |
| -
|
55 |
| -# Encode an object (dictionary) |
56 |
| -proc json::encode.obj {obj {schema {}}} { |
57 |
| - set result "\{" |
58 |
| - set sep " " |
59 |
| - foreach k [lsort [dict keys $obj]] { |
60 |
| - if {[dict exists $schema $k]} { |
61 |
| - set type [dict get $schema $k] |
62 |
| - } elseif {[dict exists $schema *]} { |
63 |
| - set type [dict get $schema *] |
64 |
| - } else { |
65 |
| - set type str |
| 27 | +# encode the value according to to the given type |
| 28 | +proc json::subencode {type value {schema {}}} { |
| 29 | + switch -exact -- $type { |
| 30 | + str - "" { |
| 31 | + # Strictly we should be converting \x00 through \x1F to unicode escapes |
| 32 | + # And anything outside the BMP to a UTF-16 surrogate pair |
| 33 | + return \"[string map [list \\ \\\\ \" \\" \f \\f \n \\n / \\/ \b \\b \r \\r \t \\t] $value]\" |
66 | 34 | }
|
67 |
| - append result $sep\"$k\": |
68 |
| -
|
69 |
| - append result [json::encode.[lindex $type 0] [dict get $obj $k] [lrange $type 1 end]] |
70 |
| - set sep ", " |
71 |
| - } |
72 |
| - append result " \}" |
73 |
| -} |
74 |
| -
|
75 |
| -# Encode an array (list) |
76 |
| -proc json::encode.list {list {type str}} { |
77 |
| - set result "\[" |
78 |
| - set sep " " |
79 |
| - foreach l $list { |
80 |
| - append result $sep |
81 |
| - append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]] |
82 |
| - set sep ", " |
83 |
| - } |
84 |
| - append result " \]" |
85 |
| -} |
| 35 | + num { |
| 36 | + if {$value in {Inf -Inf}} { |
| 37 | + append value inity |
| 38 | + } |
| 39 | + return $value |
| 40 | + } |
| 41 | + bool { |
| 42 | + if {$value} { |
| 43 | + return true |
| 44 | + } |
| 45 | + return false |
| 46 | + } |
| 47 | + obj { |
| 48 | + set result "\{" |
| 49 | + set sep " " |
| 50 | + foreach k [lsort [dict keys $value]] { |
| 51 | + if {[dict exists $schema $k]} { |
| 52 | + set subtype [dict get $schema $k] |
| 53 | + } elseif {[dict exists $schema *]} { |
| 54 | + set subtype [dict get $schema *] |
| 55 | + } else { |
| 56 | + set subtype str |
| 57 | + } |
| 58 | + append result $sep\"$k\": |
86 | 59 |
|
87 |
| -# Encode a mixed-type array (list) |
88 |
| -# Must be as many types as there are elements of the list |
89 |
| -proc json::encode.mixed {list types} { |
90 |
| - set result "\[" |
91 |
| - set sep " " |
92 |
| - foreach l $list type $types { |
93 |
| - append result $sep |
94 |
| - append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]] |
95 |
| - set sep ", " |
| 60 | + append result [json::subencode [lindex $subtype 0] [dict get $value $k] [lrange $subtype 1 end]] |
| 61 | + set sep ", " |
| 62 | + } |
| 63 | + append result " \}" |
| 64 | + return $result |
| 65 | + } |
| 66 | + list { |
| 67 | + set result "\[" |
| 68 | + set sep " " |
| 69 | + foreach l $value { |
| 70 | + append result $sep |
| 71 | + append result [json::subencode [lindex $schema 0] $l [lrange $schema 1 end]] |
| 72 | + set sep ", " |
| 73 | + } |
| 74 | + append result " \]" |
| 75 | + return $result |
| 76 | + } |
| 77 | + mixed { |
| 78 | + set result "\[" |
| 79 | + set sep " " |
| 80 | + foreach l $value subtype $schema { |
| 81 | + append result $sep |
| 82 | + append result [json::subencode [lindex $subtype 0] $l [lrange $subtype 1 end]] |
| 83 | + set sep ", " |
| 84 | + } |
| 85 | + append result " \]" |
| 86 | + } |
| 87 | + default { |
| 88 | + error "bad type $type" |
| 89 | + } |
96 | 90 | }
|
97 |
| - append result " \]" |
98 | 91 | }
|
99 | 92 |
|
100 | 93 | # vim: se ts=4:
|
0 commit comments