-
Notifications
You must be signed in to change notification settings - Fork 3
/
JSON.red
141 lines (128 loc) · 3.04 KB
/
JSON.red
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
Red [
Title: "JSON parser"
File: %json.red
Author: "Nenad Rakocevic, Qingtian Xie, Boleslav Březovský"
License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt"
]
json: context [
quoted-char: charset {"\/bfnrt}
exponent: charset "eE"
sign: charset "+-"
digit-nz: charset "123456789"
digit: charset [#"0" - #"9"]
hexa: union digit charset "ABCDEFabcdef"
blank: charset " ^(09)^(0A)^(0D)"
ws: [any blank]
dbl-quote: #"^""
s: e: none
load-str: func [
"Return word if possible, leave untouched when not"
str
/local out
] [
if block? try [out: load str] [out: str]
out
]
decode-str: func [start end /local new rule s][
new: copy/part start back end ;-- exclude ending quote
rule: [
any [
s: remove #"\" [
#"b" (s/1: #"^H")
| #"f" (s/1: #"^(0C)")
| #"n" (s/1: #"^/")
| #"r" (s/1: #"^M")
| #"t" (s/1: #"^-")
| #"u" 4 hexa
]
| skip
]
]
parse new rule
new
]
encode-str: func [str [string!] buffer [string!] /local start rule s][
append buffer #"^""
start: tail buffer
append buffer str
rule: [
any [
change #"^H" "\b"
| change #"^(0C)" "\f"
| change #"^/" "\n"
| change #"^M" "\r"
| change #"\" "\\"
| change #"^-" "\t"
| change #"^"" {\"}
| skip
]
]
parse start rule
append buffer #"^""
]
value: [
string keep (decode-str s e)
| number keep (load copy/part s e)
| "true" keep (true)
| "false" keep (false)
| "null" keep (none)
| object-rule
| array
]
number: [s: opt #"-" some digit opt [dot some digit opt [exponent sign 1 3 digit]] e:]
string: [dbl-quote s: any [#"\" [quoted-char | #"u" 4 hexa] | dbl-quote break | skip] e:]
couple: [ws string keep (load-str decode-str s e) ws #":" ws value]
object-rule: [
#"{" collect set list opt [any [couple #","] couple] ws #"}"
keep (make map! list)
]
array: [#"[" collect opt [ws value any [ws #"," ws value]] ws #"]"]
decode: function [data [string!] return: [block! object!]][
output: parse data [collect any [blank | object-rule | array | value]]
either equal? 1 length? output [first output] [output]
]
encode-into: function [data [any-type!] buffer [string!]][
case [
any [map? data object? data] [
append buffer #"{"
either zero? length? words-of data [
append buffer #"}"
][
foreach word words-of data [
encode-into word buffer
append buffer #":"
encode-into data/:word buffer
append buffer #","
]
change back tail buffer #"}"
]
]
block? data [
append buffer #"["
either empty? data [
append buffer #"]"
][
foreach v data [
encode-into v buffer
append buffer #","
]
change back tail buffer #"]"
]
]
string? data [
encode-str data buffer
]
any [logic? data number? data][
append buffer mold data
]
true [
encode-into mold data buffer
]
]
]
encode: function [data return: [string!]][
buffer: make string! 1000
encode-into data buffer
buffer
]
]