1		:- module( json, [ json_parse/2, json_parse/3,
2		json_parse_file/2
3		] ).
4		% based on https://github.com/yoroto/pl-json
5		% have added line counting and error reporting, reading directly from file
6		% fixed a few issues with whitespace and avoid backtracking
7		% return strings using string(.) wrapper to avoid ambiguity with arrays of integers
8
9		% parse a JSON file
10		json_parse_file(File, Json) :-
11		read_file(File,Codes),
12		%format('Read:~n~s~n',[Codes]),
13		json_parse(Codes,Json).
14
15		read_file(Filename,Codes) :-
16		open(Filename,read,S,[encoding('UTF-8')]),
17		read_codes(S,Codes),
18		close(S).
19		read_codes(S,Codes) :-
20		get_code(S,Code),
21		( Code < 0 ->
22		Codes = []
23		; otherwise ->
24		Codes = [Code|Rest],
25		read_codes(S,Rest)).
26
27		% --------------
28
29		json_parse( Chars, Json ) :-
30		json_parse( Chars, Json, [] ).
31
32		json_parse( Chars, Json, _Options ) :-
33		reset_line_nr,
34		json(Json, Chars, _).
35
36		json(Json) --> ws,!,json(Json).
37		json(Json) -->
38		json1(Json),
39		!,
40		spaces.
41		json(Json) --> {var(Json)},check_string("?"), {fail}. % generate error message
42		%json(Json) --> {ground(Json)}, json(JSon2), {format('### Mismatch:~n ~w~n~w~n',[Json,Json2]),fail}.
43
44		% a version that does not print an error message
45		try_json(Json) --> ws,!,try_json(Json).
46		try_json(Json) -->
47		json1(Json),
48		!,
49		spaces.
50
51		json1(null) --> "null",!.
52		json1(true) --> "true",!.
53		json1(false) --> "false",!.
54
55		json1(Number) --> number(Number),!.
56
57		json1(string(Codes)) -->
58		"""",!,
59		%{print_info(start_string)},
60		string(Codes). %, {atom_codes(String,Codes)}.
61
62		json1(Array) -->
63		"[",!,
64		%{print_info(start_array)},
65		array(Array),
66		check_string("]").
67
68		json1(obj(Pairs)) -->
69		"{",!,
70		%{print_info(start_object)},
71		spaces,
72		pairs(Pairs),
73		spaces,
74		check_string("}").
75
76		number(Number) -->
77		nm_token(NmCodes),
78		{ number_codes(Number, NmCodes) }.
79
80		nm_token([H|T]) -->
81		[H],
82		{ minus(H);digit_table(H) },
83		nm_token1(T).
84
85		nm_token1([0'\x2E\|T]) -->
86		".",!,
87		nm_frac(T).
88
89		nm_token1([H|T]) -->
90		[H],
91		{ digit_table(H) }, !,
92		nm_token1(T).
93
94		nm_token1([]) --> [].
95
96
97		nm_frac([0'\x45\,H|T]) -->
98		("e";"E"),!,
99		[H], {minus(H);plus(H)},
100		nm_exp(T).
101
102		nm_frac([H|T]) -->
103		[H],
104		{ digit_table(H) }, !,
105		nm_frac(T).
106
107		nm_frac([]) --> [].
108
109		nm_exp([H|T]) -->
110		[H],
111		{ digit_table(H) }, !,
112		nm_exp1(T).
113
114		nm_exp1([H|T]) -->
115		[H],
116		{ digit_table(H) }, !,
117		nm_exp1(T).
118
119		nm_exp1([]) --> [].
120
121		string(X) --> string2(X).
122
123		string2([]) --> [0'\x22\],
124		!.
125		string2([EscapedChar|T]) -->
126		[0'\x5C\],!,
127		escape_char(EscapedChar),
128		string2(T).
129		string2([H|T]) -->
130		[H],
131		string2(T).
132
133		escape_char( 0'\x22\ ) --> [0'\x22\].
134		escape_char( 0'\x5C\ ) --> [0'\x5C\].
135		escape_char( 0'\x2F\ ) --> [0'\x2F\].
136		escape_char( 0'\x08\ ) --> [0'\x62\]. %b
137		escape_char( 0'\x0C\ ) --> [0'\x66\]. %f
138		escape_char( 0'\x0A\ ) --> [0'\x6E\]. %n
139		escape_char( 0'\x0D\ ) --> [0'\x72\]. %r
140		escape_char( 0'\x09\ ) --> [0'\x74\]. %t
141
142		escape_char( Code ) -->
143		"u",
144		hex_digit_char( H1 ),
145		hex_digit_char( H2 ),
146		hex_digit_char( H3 ),
147		hex_digit_char( H4 ),
148		{ Code is (((H1 << 4 + H2) << 4 + H3) << 4 + H4) }.
149
150		hex_digit_char( 0 ) --> "0".
151		hex_digit_char( 1 ) --> "1".
152		hex_digit_char( 2 ) --> "2".
153		hex_digit_char( 3 ) --> "3".
154		hex_digit_char( 4 ) --> "4".
155		hex_digit_char( 5 ) --> "5".
156		hex_digit_char( 6 ) --> "6".
157		hex_digit_char( 7 ) --> "7".
158		hex_digit_char( 8 ) --> "8".
159		hex_digit_char( 9 ) --> "9".
160		hex_digit_char( 10 ) --> "A".
161		hex_digit_char( 11 ) --> "B".
162		hex_digit_char( 12 ) --> "C".
163		hex_digit_char( 13 ) --> "D".
164		hex_digit_char( 14 ) --> "E".
165		hex_digit_char( 15 ) --> "F".
166		hex_digit_char( 10 ) --> "a".
167		hex_digit_char( 11 ) --> "b".
168		hex_digit_char( 12 ) --> "c".
169		hex_digit_char( 13 ) --> "d".
170		hex_digit_char( 14 ) --> "e".
171		hex_digit_char( 15 ) --> "f".
172
173		array([H|T]) -->
174		try_json(H), !,{print_info(first_array)},
175		array1(T).
176		array([]) --> [], {print_info(end_array)}.
177
178		array1([H|T]) -->
179		",", !,
180		json(H),!, {print_info(next_array)},
181		array1(T).
182		array1([]) --> [], {print_info(empty_array)}.
183
184		pair(pair(Name, Value),Optional) -->
185		spaces,
186		({Optional=optional} -> opt_pair_name(Codes) ; pair_name(Codes)),
187		check_string(":"),
188		{ atom_codes(Name, Codes) },
189		{print_info(pair_value_for(Name))},
190		json(Value),
191		{print_info(found_value_vor(Name,Value))}.
192
193		opt_pair_name(Name) --> """", string(Name), spaces.
194		pair_name(Name) --> check_string(""""), string(Name), spaces.
195
196
197		pairs(List) --> ws,!,pairs(List).
198		pairs([H|T]) -->
199		pair(H,optional), !,
200		pairs1(T).
201		pairs([]) --> [], {print_info(empty_pairs)}.
202
203		pairs1(List) --> ws,!,pairs1(List).
204		pairs1([H|T]) -->
205		",", !,
206		pair(H,required),!,
207		pairs1(T).
208		pairs1([]) --> [], {print_info(end_pairs)}.
209
210		check_string(List) --> ws,!,check_string(List).
211		check_string([Char]) --> [Char],!.
212		check_string(String, [Char|_],_) :-
213		cur_line(LineNr),
214		format(user_error,'! Error on line ~w: expecting ~s obtained ~s~n',[LineNr,String,[Char]]),
215		%trace,
216		fail.
217
218		minus( 0'- ).
219		plus( 0'+ ).
220		digit_table( 0'0 ).
221		digit_table( 0'1 ).
222		digit_table( 0'2 ).
223		digit_table( 0'3 ).
224		digit_table( 0'4 ).
225		digit_table( 0'5 ).
226		digit_table( 0'6 ).
227		digit_table( 0'7 ).
228		digit_table( 0'8 ).
229		digit_table( 0'9 ).
230
231
232		spaces --> ws,!,spaces.
233		spaces --> [].
234
235		% whitespace
236		ws --> new_line,!.
237		ws --> " "; "\t" ; [10] ; [13].
238
239		new_line --> "\n",{inc_line_nr}.
240
241		% use a fact to keep track of line numbers
242		:- dynamic cur_line/1.
243		cur_line(1).
244		inc_line_nr :- retract(cur_line(N)), N1 is N+1, assert(cur_line(N1)).
245		reset_line_nr :- retract(cur_line(_)), assert(cur_line(1)).
246
247		print_info(_) :- !.
248		print_info(Error) :- print_error(Error).
249		print_error(Error) :-
250		cur_line(LineNr),
251		current_output(X),
252		set_output(user_error),
253		nl,
254		write('! Line: '),write_term(LineNr,[]),nl,
255		(var(Error) -> print_message(error,'_')
256		; write('! '),write_term(Error,[max_depth(20),numbervars(true)]),nl),
257		%% flush_output(user_error), %%
258		set_output(X).