json_parser

array(Array) --> ws, !, array(Array).

array([]) --> "]", !.

array([H|T]) -->
    json1(H), !,
    spaces,
    array1(T).

array(_) --> !, fail_with_error("json value or \"]\" in array").

array1([]) --> "]", !.

array1([H|T]) -->
    check_string(","),
    spaces,
    json1(H), !,
    spaces,
    array1(T).

array1(_) --> !, fail_with_error("\",\" json value or \"]\" in array").

check_string(List) --> [Char], {member(Char, List)}, !.

check_string(List) --> !, fail_with_error(List).

convert_char(9, Res) :- !, Res = "".

convert_char(10, Res) :- !, Res = "".

convert_char(13, Res) :- !, Res = "".

convert_char(Char, Res) :- number(Char), !, Res = [Char].

convert_char(_, Res) :- !, Res = "".

convert_chars([], Res) :- !, Res = "".

convert_chars([Char|_], Res) :- !, convert_char(Char, Res).

convert_chars(Char, Res) :- !, convert_char(Char, Res).

digit_table( C ) :- zero( C ).

digit_table( C ) :- digit_table_1to9( C ).

digit_table_1to9( 0'1 ).

digit_table_1to9( 0'2 ).

digit_table_1to9( 0'3 ).

digit_table_1to9( 0'4 ).

digit_table_1to9( 0'5 ).

digit_table_1to9( 0'6 ).

digit_table_1to9( 0'7 ).

digit_table_1to9( 0'8 ).

digit_table_1to9( 0'9 ).

dot( 0'. ).

escape_char( 0'\x22\ ) --> [0'\x22\], !. " 34 decimal"

escape_char( 0'\x5C\ ) --> [0'\x5C\], !. %\

escape_char( 0'\x2F\ ) --> [0'\x2F\], !. %/

escape_char( 0'\x08\ ) --> [0'\x62\], !. %b

escape_char( 0'\x0C\ ) --> [0'\x66\], !. %f

escape_char( 0'\x0A\ ) --> [0'\x6E\], !. %n

escape_char( 0'\x0D\ ) --> [0'\x72\], !. %r

escape_char( 0'\x09\ ) --> [0'\x74\], !. %t

escape_char( Code ) -->
    "u",
    hex_digit_char( H1 ),
    hex_digit_char( H2 ),
    hex_digit_char( H3 ),
    hex_digit_char( H4 ),
    {HighSurrogate is (((H1 << 4 + H2) << 4 + H3) << 4 + H4)},
    {HighSurrogate >= 0xD800, HighSurrogate =< 0xDBFF},
    "\\u",
    hex_digit_char( H5 ),
    hex_digit_char( H6 ),
    hex_digit_char( H7 ),
    hex_digit_char( H8 ),
    {LowSurrogate is (((H5 << 4 + H6) << 4 + H7) << 4 + H8)},
    {LowSurrogate >= 0xDC00, LowSurrogate =< 0xDFFF},
    !,
    {Code is 0x10000 + (0x400 * (HighSurrogate - 0xD800)) + (LowSurrogate - 0xDC00)}.

escape_char( Code ) -->
    "u",
    !,
    hex_digit_char( H1 ),
    hex_digit_char( H2 ),
    hex_digit_char( H3 ),
    hex_digit_char( H4 ),
    { Code is (((H1 << 4 + H2) << 4 + H3) << 4 + H4) }.

exp( 0'e ).

exp( 0'E ).

fail_with_error(ExpectedString, Codes, _) :- !, generate_json_error(ExpectedString, Codes), fail.

from_hex_code(C, N) :- C >= 48, C =< 57, !, N is C-48.

from_hex_code(C, N) :- C >= 97, C =< 102, !, N is (C-97)+10.

from_hex_code(C, N) :- C >= 65, C =< 70, !, N is (C-65)+10.

generate_json_error(ExpectedString, Char) :-
    cur_line(LineNr),
    number_codes(LineNr,LC),
    convert_chars(Char,CStr),
    append(["JSON error in line ",LC,": expected ",ExpectedString,", but got ",CStr],Codes),
    atom_codes(Msg,Codes),
    add_error(json_parser,Msg).

hex_digit_char( N ) --> [C], {from_hex_code(C, N)}, !.

inc_line_nr :- cur_line(N), !, retractall(cur_line(_)), N1 is N+1, assertz(cur_line(N1)).

indent(" ").

json(Json) --> try_json(Json), !.

json(_) --> !, fail_with_error("json value").

json1(@(Literal)) -->
    {valid_literal(Literal), atom_codes(Literal, LiteralCodes)},
    LiteralCodes,
    !.

json1(number(Number)) --> parse_number(Number), !.

json1(string(String)) -->
    json_start_string_quote(Quote), !,
    string2(Codes, Quote),
    {strings_as_atoms(true) -> atom_codes(String, Codes) ; String = Codes}.

json1(array(Array)) -->
    "[", !,
    array(Array).

json1(json(Object)) -->
    "{", !,
    pairs(Object).

json_escape_string_atom(Atom, EscapedAtom) :-
    \+ atom(Atom),
    !,
    add_error('Cannot escape: ', json_escape_string_atom(Atom, EscapedAtom)),
    Atom = EscapedAtom.

json_escape_string_atom(Atom, EscapedAtom) :-
    atom_codes(Atom, Codes),
    json_escape_string_codes(Codes, EscapedCodes),
    atom_codes(EscapedAtom, EscapedCodes).

json_escape_string_codes(Codes, EscapedCodes) :-
    json_escape_string_codes(Codes, EscapedCodes, []).

json_escape_string_codes(Codes, EscapedCodes, Options) :-
    reset_options,
    reset_line_nr,
    maplist(process_option, Options),
    json_escape_string_codes0(Codes, EscapedCodes).

json_escape_string_codes0([], []) :- !.

json_escape_string_codes0([34|T], [92,34|ET]) :- !, json_escape_string_codes0(T, ET). % double quote

json_escape_string_codes0([92|T], [92,92|ET]) :- !, json_escape_string_codes0(T, ET). % backslash

json_escape_string_codes0([8|T], [92,98|ET]) :- !, json_escape_string_codes0(T, ET). % b(ackspace)

json_escape_string_codes0([12|T], [92,102|ET]) :- !, json_escape_string_codes0(T, ET). % f(orm feed)

json_escape_string_codes0([10|T], [92,110|ET]) :- !, json_escape_string_codes0(T, ET). % n(ew line)

json_escape_string_codes0([13|T], [92,114|ET]) :- !, json_escape_string_codes0(T, ET). % (carriage) r(eturn)

json_escape_string_codes0([9|T], [92,116|ET]) :- !, json_escape_string_codes0(T, ET). % (horizontal) t(ab)

json_escape_string_codes0([N|T], [92,117,H4,H3,H2,H1|ET]) :-
    (N >= 0, N =< 31 ; ascii(true), N >= 0x7f, N =< 0x10000), % non-ascii/non-printable (u)nicode codepoints
    !,
    to_4_hex_codes(N, H4, H3, H2, H1),
    json_escape_string_codes0(T, ET).

json_escape_string_codes0([N|T], [92,117,H4,H3,H2,H1,92,117,H8,H7,H6,H5|ET]) :- % escape as surrogate pair
    ascii(true), N >= 0x10000, N =< 0x10FFFF, % maximum unicode codepoint
    !,
    LowSurrogate is ((N-65536) mod 0x400) + 0xDC00,
    HighSurrogate is ((N-65536) div 0x400) + 0xD800,
    to_4_hex_codes(HighSurrogate, H4, H3, H2, H1),
    to_4_hex_codes(LowSurrogate, H8, H7, H6, H5),
    json_escape_string_codes0(T, ET).

json_escape_string_codes0([N|T], [N|ET]) :- !, json_escape_string_codes0(T, ET). % the rest

json_parse(Chars, Json) :-
    json_parse(Chars, Json, []).

json_parse(Chars, Json, Options) :-
    reset_options,
    reset_line_nr,
    maplist(process_option, Options),
    (member(rest(ExpectedRest), Options) -> true ; ExpectedRest = ""),
    json(Json, Chars, Rest), !,
    (ExpectedRest = Rest
    -> true
    ; (ExpectedRest = "" -> ExpectedString = "" ; ExpectedString = ExpectedRest),
    generate_json_error(ExpectedString, Rest),
    fail
).

json_parse_file(File, Json) :-
    json_parse_file(File, [], Json).

json_parse_file(File, Options, Json) :-
    catch(read_file(File,Codes), error(existence_error(_,_),_E),
    (add_error(json_parse_file,'JSON file does not exist:',File),fail)),
    (json_parse(Codes,Json,Options) -> true
    ; add_error(json_parse_file,'Could not parse JSON file:',File),fail
).

json_start_string_quote(0'\x22\) --> """", !. % regular JSON string syntax

json_write(Json, Chars) :-
    json_write(Json, Chars, []).

json_write(Json, Chars, Options) :-
    reset_options,
    reset_line_nr,
    maplist(process_option, Options),
    json_write0(Json, 0, Chars, []).

json_write0(Json, Indent) -->
    json_write_indent(Indent),
    json_write1(Json, Indent),
    json_write_newline.

json_write1(@(Literal), _Indent) -->
    {valid_literal(Literal), atom_codes(Literal, LiteralCodes)},
    !,
    LiteralCodes.

json_write1(number(Number), _Indent) -->
    {lenient_number_codes(Number, NumberCodes)},
    !,
    NumberCodes.

json_write1(string(String), _Indent) -->
    {lenient_atom_codes(String, StringCodes)},
    !,
    json_write_string(StringCodes).

json_write1(json(Object), Indent) -->
    !,
    "{",
    {Indent1 is Indent+1},
    json_write_object(Object, Indent1),
    "}".

json_write1(array(Array), Indent) -->
    !,
    "[",
    {Indent1 is Indent+1},
    json_write_array(Array, Indent1),
    "]".

json_write1(Json, _Indent) -->
    {add_error(json_write, 'Unknown json term: ', Json), fail}.

json_write_array([], _Indent) --> !, [].

json_write_array([H|T], Indent) -->
    !,
    json_write_newline,
    json_write_indent(Indent),
    json_write1(H, Indent),
    json_write_array1(T, Indent).

json_write_array1([], Indent) -->
    !,
    json_write_newline,
    {Indent1 is Indent-1},
    json_write_indent(Indent1).

json_write_array1([H|T], Indent) -->
    !,
    ",",
    json_write_newline,
    json_write_indent(Indent),
    json_write1(H, Indent),
    json_write_array1(T, Indent).

json_write_indent(_) --> {pretty(false)}, !, "".

json_write_indent(0) --> !, "".

json_write_indent(N) --> !, {indent(I)}, I, {N1 is N-1}, json_write_indent(N1).

json_write_newline --> {pretty(false)}, !, "".

json_write_newline --> !, "\n".

json_write_object([], _Indent) --> !, [].

json_write_object([H|T], Indent) -->
    !,
    json_write_pair(H, Indent),
    json_write_object1(T, Indent).

json_write_object1([], Indent) -->
    !,
    json_write_newline,
    {Indent1 is Indent-1},
    json_write_indent(Indent1).

json_write_object1([H|T], Indent) -->
    !,
    ",",
    json_write_pair(H, Indent),
    json_write_object1(T, Indent).

json_write_pair(Pair, Indent) -->
    json_write_newline,
    json_write_indent(Indent),
    {Pair =.. [_, K, V | _], atom_codes(K, KCodes)}, % leniency: accept every term with at least two arguments
    json_write_string(KCodes),
    ":",
    json_write_pretty_whitespace,
    json_write1(V, Indent).

json_write_pretty_whitespace --> {pretty(false)}, !, "".

json_write_pretty_whitespace --> !, " ".

json_write_stream(Json) :-
    json_write_stream(current_output, Json).

json_write_stream(Stream, Json) :-
    json_write_stream(Stream, Json, []).

json_write_stream(Stream, Json, Options) :-
    json_write(Json, Chars, Options),
    format(Stream, '~s', [Chars]).

json_write_string(StringCodes) -->
    {json_escape_string_codes0(StringCodes, EscCodes)},
    """",
    EscCodes,
    """".

lenient_atom_codes(Value, Codes) :- atom(Value), !, atom_codes(Value, Codes).

lenient_atom_codes(Value, Codes) :- number(Value), !, number_codes(Value, Codes).

lenient_atom_codes(Value, Codes) :- Value=[], !, Codes=[].

lenient_atom_codes(Value, Codes) :- Value=[C|_], number(C), !, Codes = Value.

lenient_number_codes(Value, Codes) :- number(Value), !, number_codes(Value, Codes).

lenient_number_codes(Value, Codes) :-
    atom(Value),
    atom_codes(Value, VCodes),
    safe_number_codes(_, VCodes),
    !,
    Codes = VCodes.

lenient_number_codes(Value, Codes) :-
    Value = [C|_],
    number(C),
    safe_number_codes(_, Value),
    !,
    Codes = Value.

minus( 0'- ).

new_line --> "\n",{inc_line_nr}.

nm_exp([H|T]) -->
    [H], {sign(H)}, !,
    nm_exp0(T).

nm_exp(T) --> !, nm_exp0(T).

nm_exp0([H|T]) -->
    [H], {digit_table(H)}, !,
    nm_exp1(T).

nm_exp1([H|T]) -->
    [H], {digit_table(H)}, !,
    nm_exp1(T).

nm_exp1([]) --> !, "".

nm_frac([H|T]) -->
    [H], {digit_table(H)}, !,
    nm_frac1(T).

nm_frac1([H|T]) -->
    [H], {exp(H)}, !,
    nm_exp(T).

nm_frac1([H|T]) -->
    [H], {digit_table(H)}, !,
    nm_frac1(T).

nm_frac1([]) --> !, "".

nm_int([H|T]) -->
    [H], {zero(H)}, !,
    nm_int0(T).

nm_int([H|T]) -->
    [H], {digit_table_1to9(H)}, !,
    nm_int1(T).

nm_int0([H|T]) -->
    [H], {dot(H)}, !,
    nm_frac(T).

nm_int0([]) --> !, "".

nm_int1([H|T]) -->
    [H], {digit_table(H)}, !,
    nm_int1(T).

nm_int1([H|T]) -->
    [H], {dot(H)}, !,
    nm_frac(T).

nm_int1([]) --> !, "".

nm_token([H|T]) -->
    [H], {minus(H)}, !,
    nm_int(T).

nm_token(T) --> !, nm_int(T).

pair(ResPair) -->
    spaces,
    {position_infos(true)
    -> position_start(Pos), ResPair = '='(Name, Value, Pos)
    ; ResPair = '='(Name, Value)},
    (json_start_string_quote(Quote) -> {true} ; fail_with_error("string quote")),
    string2(Codes, Quote),
    {atom_codes(Name, Codes)},
    spaces, check_string(":"), spaces,
    json1(Value),
    {position_infos(true) -> position_end(Pos) ; true},
    spaces.

pairs(List) --> ws, !, pairs(List).

pairs([]) --> "}", !.

pairs([H|T]) -->
    pair(H), !,
    pairs1(T).

pairs(_) --> !, fail_with_error("string \":\" json value or \"}\" in object").

pairs1([]) --> "}", !.

pairs1([H|T]) -->
    check_string(","),
    pair(H), !,
    pairs1(T).

pairs1(_) --> !, fail_with_error("\",\" string \":\" json value or \"}\" in object").

parse_number(Number) -->
    nm_token(NmCodes), !,
    {number_codes(Number, NmCodes)}.

plus( 0'+ ).

position_end(_-End) :- !, cur_line(End).

position_start(Start-_) :- !, cur_line(Start).

process_option(rest(_)) :- !. % handled separately

process_option(position_infos(X)) :- atom(X), !, retractall(position_infos(_)), assertz(position_infos(X)).

process_option(strings_as_atoms(X)) :- atom(X), !, retractall(strings_as_atoms(_)), assertz(strings_as_atoms(X)).

process_option(multiline_strings(X)) :- atom(X), !, retractall(multiline_strings(_)), assertz(multiline_strings(X)).

process_option(pretty(X)) :- atom(X), !, retractall(pretty(_)), assertz(pretty(X)).

process_option(ascii(X)) :- atom(X), !, retractall(ascii(_)), assertz(ascii(X)).

process_option(O) :- add_warning(json_parser, 'Unrecognized option:', O).

read_codes(S,Codes) :-
    get_code(S,Code),
    ( Code < 0 ->
    Codes = []
    ;
    Codes = [Code|Rest],
    read_codes(S,Rest)).

read_file(Filename,Codes) :-
    open(Filename,read,S,[encoding(utf8)]),
    read_codes(S,Codes),
    close(S).

reset_line_nr :- retractall(cur_line(_)), assertz(cur_line(1)).

reset_options :-
    % by default we expect no rest (unparsed suffix), but callers can use rest(Var) to capture the rest to do their own handling
    % (rest/1 handled separately)
   
    % if true we add FromLineNr-ToLineNr as extra argument to attribute key-value terms in objects (=/3 instead of =/2, default false)
    retractall(position_infos(_)), assertz(position_infos(false)),
   
    % if true compatible with SICStus library (converted to atom); otherwise use codes directly (might cause problems with number arrays without tags, default true)
    retractall(strings_as_atoms(_)), assertz(strings_as_atoms(true)),
   
    % if true allow newlines in strings when parsing (default false)
    retractall(multiline_strings(_)), assertz(multiline_strings(false)),
   
    % write json strings using pretty print (include new lines and indent, default false)
    retractall(pretty(_)), assertz(pretty(false)),
   
    % write json strings as ascii only (default false)
    retractall(ascii(_)), assertz(ascii(false)).

safe_number_codes(N, C) :-
    catch(number_codes(N, C), _, fail),
    number(C).

sign( C ) :- minus( C ).

sign( C ) :- plus( C ).

spaces --> ws,!,spaces.

spaces --> "".

string2([],EndQuote) -->
    [EndQuote],
    !.

string2([EscapedChar|T],EndQuote) -->
    [0'\x5C\],!, % \
    escape_char(EscapedChar),
    string2(T,EndQuote).

string2([C|T],EndQuote) -->
    [C],
    {C=10;C=13},
    !,
    ({multiline_strings(true)} -> {true} ; fail_with_error("string content")),
    {C=10 -> inc_line_nr ; true},
    string2(T,EndQuote).

string2([H|T],EndQuote) -->
    [H],
    string2(T,EndQuote).

to_4_hex_codes(N1, H4, H3, H2, H1) :-
    D1 is (N1 mod 16), N2 is N1 div 16,
    D2 is (N2 mod 16), N3 is N2 div 16,
    D3 is (N3 mod 16), N4 is N3 div 16,
    D4 is (N4 mod 16),
    to_hex_code(D1, H1),
    to_hex_code(D2, H2),
    to_hex_code(D3, H3),
    to_hex_code(D4, H4).

to_hex_code(N, C) :- N >= 0, N < 10, !, C is 48+N. % 48 is '0'

to_hex_code(N, C) :- N >= 10, N < 16, !, C is 97+(N-10). % 97 is 'a'

try_json(Json) --> ws, !, try_json(Json).

try_json(Json) --> json1(Json), !, spaces.

valid_literal(null).

valid_literal(true).

valid_literal(false).

ws --> new_line, !.

ws --> " "; "\t" ; "\r".

zero( 0'0 ).