Heimseite
Seitenübersicht
An/abmeldung
Anschlagbrett
Herunterladen(c) 2005-2024 XLOG Technologies AG
/**
* This file provides JSON reading and writing predicates.
*
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
:- ensure_loaded(library(util/charsio)).
/***************************************************************/
/* Some Convenience */
/***************************************************************/
/**
* json_atom(T, A):
* The predicate succeeds in A with the atom for the JSON term T.
*/
% json_atom(+Json, -Atom)
json_atom(Json, Atom) :- var(Atom), !,
open_output_atom_stream(K),
write_json(K, Json),
flush_output(K),
close_output_atom_stream(K, Atom).
json_atom(Json, Atom) :-
open_input_atom_stream(Atom, K),
sys_receive_token(T, K),
(T = end_of_file ->
throw(error(syntax_error(illegal_eof),_));
sys_input_json(T, X, K),
sys_receive_token(S, K),
(S = end_of_file ->
true;
throw(error(syntax_error(missing_eof),_)))),
Json = X.
/**
* json_object_current(T, K, V):
* The predicate succeeds in V with the value for the key K
* in the JSON term T.
*/
% json_object_current(+Json, +Atom, -Json)
json_object_current({C}, K, V) :-
sys_json_contain(C, K:V), !.
/**
* json_object_set(T, K, V, S):
* The predicate succeeds in S with the JSON term after replacing
* the value for the key K by V in the JSON term T.
*/
% json_object_set(+Json, +Atom, +Json, -Json)
json_object_set({}, K, V, R) :- !, R = {K:V}.
json_object_set({K:_}, K, V, R) :- !, R = {K:V}.
json_object_set({C}, K, V, R) :-
sys_json_delete(C, K:_, D), !,
R = {K:V, D}.
json_object_set({C}, K, V, {K:V, C}).
/**
* json_object_remove(T, K, S):
* The predicate succeeds in S with the JSON term after removing
* the value for the key K in the JSON term T.
*/
% json_object_remove(+Json, +Atom, -Json)
json_object_remove({}, _, R) :- !, R = {}.
json_object_remove({K:_}, K, R) :- !, R = {}.
json_object_remove({C}, K, R) :-
sys_json_delete(C, K:_, D), !,
R = {D}.
json_object_remove(R, _, R) :- R = {_}.
% sys_json_contain(+Json, +Pair)
sys_json_contain(X, X).
sys_json_contain((A,_), X) :- sys_json_contain(A, X).
sys_json_contain((_,B), X) :- sys_json_contain(B, X).
% sys_json_delete(+Json, +Atom, -Json)
sys_json_delete((X,A), X, A).
sys_json_delete((A,X), X, A).
sys_json_delete((A,B), X, (C,B)) :- sys_json_delete(A, X, C).
sys_json_delete((A,B), X, (A,C)) :- sys_json_delete(B, X, C).
/***************************************************************/
/* Unparse JSON */
/***************************************************************/
/**
* write_json(T):
* write_json(S, T):
* The predicate succeeds. As a side effect the JSON term T is written.
* The binary predicate allows specifying an output stream S.
*/
% write_json(+Term)
write_json(T) :-
current_output(S),
sys_print_json(T, S).
% write_json(+Stream, +Term)
write_json(S, T) :-
sys_print_json(T, S).
% sys_print_json(+Term, +Stream)
sys_print_json(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_print_json(X, S) :- atom(X), !,
sys_string_quoted(X, H),
put_atom(S, H).
sys_print_json(X, S) :- number(X), !,
atom_number(H, X),
put_atom(S, H).
sys_print_json(@(X), S) :- sys_json_ident(X), !,
put_atom(S, X).
sys_print_json([], S) :- !,
put_atom(S, '[]').
sys_print_json([X|L], S) :- !,
put_code(S, 0'[),
sys_print_json(X, S),
sys_print_list(L, S),
put_code(S, 0']).
sys_print_json({}, S) :- !,
put_atom(S, '{}').
sys_print_json({M}, S) :- !,
put_code(S, 0'{),
sys_print_map(M, S),
put_code(S, 0'}).
sys_print_json(T, _) :-
throw(error(type_error(json,T),_)).
% sys_print_map(+Map, +Stream)
sys_print_map(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_print_map((P,Q), S) :- !,
sys_print_map(P, S),
put_atom(S, ', '),
sys_print_map(Q, S).
sys_print_map(K:V, S) :- atom(K), !,
sys_print_json(K, S),
put_atom(S, ': '),
sys_print_json(V, S).
sys_print_map(T, _) :-
throw(error(type_error(map,T),_)).
% sys_print_list(+List, +Stream)
sys_print_list(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_print_list([], _) :- !.
sys_print_list([X|L], S) :- !,
put_atom(S, ', '),
sys_print_json(X, S),
sys_print_list(L, S).
sys_print_list(T, _) :-
throw(error(type_error(list,T),_)).
/***************************************************************/
/* String Escape */
/***************************************************************/
% sys_string_quoted(+Atom, -Atom)
sys_string_quoted(X, Y) :-
atom_codes(X, L),
sys_escape_points(L, R, [0'\"]),
atom_codes(Y, [0'\"|R]).
% sys_escape_points(+List, -List, +List)
sys_escape_points([X|L]) -->
sys_escape_point(X),
sys_escape_points(L).
sys_escape_points([]) --> [].
% sys_escape_point(+Integer, -List, +List)
sys_escape_point(X) --> {sys_is_control(Y, X)}, !, [0'\\, Y].
sys_escape_point(X) --> {sys_is_special(X)}, !, [0'\\, X].
sys_escape_point(X) --> {sys_is_cntrl(X)}, !, sys_escape_point2(X).
sys_escape_point(X) --> {sys_is_invalid(X)}, !, sys_escape_point2(X).
sys_escape_point(X) --> [X].
% sys_escape_point2(+Integer, -List, +List)
sys_escape_point2(X) --> {X =< 0xFFFF}, !,
{atom_integer(J, 16, X), atom_codes(J, H), length(H, N), M is 4-N},
[0'\\, 0'u], sys_escape_zeros(M), sys_escape_points2(H).
sys_escape_point2(X) --> {sys_high_surrogate(X, Y), sys_low_surrogate(X, Z)},
sys_escape_point2(Y), sys_escape_point2(Z).
% sys_is_special(+Code)
sys_is_special(0'\").
sys_is_special(0'\\).
sys_is_special(0'/).
% sys_is_control(+Code, -Code)
sys_is_control(0'b, 0'\b).
sys_is_control(0'f, 0'\f).
sys_is_control(0'n, 0'\n).
sys_is_control(0'r, 0'\r).
sys_is_control(0't, 0'\t).
% sys_high_surrogate(+Integer, -Integer)
sys_high_surrogate(X, Y) :- Y is (X >> 10) + 0xD7C0.
% sys_low_surrogate(+Integer, -Integer)
sys_low_surrogate(X, Y) :- Y is (X /\ 0x3FF) + 0xDC00.
/*************************************************************/
/* Character Utility */
/*************************************************************/
% sys_is_cntrl(+Code)
sys_is_cntrl(C) :- code_type(C, T), member(T, [15,16]).
% sys_is_invalid(+Code)
sys_is_invalid(C) :- code_type(C, T), member(T, [0,18,19]).
% sys_escape_points2(+List, -List, +List)
sys_escape_points2([H|T]) --> !, [H], sys_escape_points2(T).
sys_escape_points2([]) --> [].
% sys_escape_zeros(+Integer, -List, +List)
sys_escape_zeros(0) --> !.
sys_escape_zeros(N) --> [0'0], {M is N-1}, sys_escape_zeros(M).
% sys_json_ident(+Atom)
sys_json_ident(null).
sys_json_ident(false).
sys_json_ident(true).
/***************************************************************/
/* Parse JSON */
/***************************************************************/
/**
* read_json(E):
* read_json(S, E):
* The predicate succeeds in E with a JSON term or end_of_file.
* As a side effect, the input position is advanced. The binary
* predicate allows specifying an input stream S.
*/
% read_json(-Term)
read_json(X) :-
current_input(S),
read_json(S, X).
% read_json(+Stream, -Term)
read_json(S, X) :-
sys_receive_token(T, S),
(T = end_of_file ->
X = end_of_file;
sys_input_json(T, Y, S),
X = Y).
/**
* sys_input_json(T, Y, S):
* The predicate succeeds in Y with the next json. The parameter T
* is the current token and the parameter S is the current stream.
*/
% sys_input_json(+Term, -Term, +Stream)
sys_input_json(atom(A), A, _) :- !.
sys_input_json(number(N), N, _) :- !.
sys_input_json(ident(I), @(I), _) :- sys_json_ident(I), !.
sys_input_json('[', L, S) :- !,
sys_receive_token(T, S),
sys_input_list(T, L, S).
sys_input_json('{', M, S) :- !,
sys_receive_token(T, S),
sys_input_map(T, M, S).
sys_input_json(_, _, _) :-
throw(error(syntax_error(illegal_json),_)).
% sys_input_list(+Term, -List, +Stream)
sys_input_list(']', [], _) :- !.
sys_input_list(T, [X|L], S) :-
sys_input_json(T, X, S),
sys_receive_token(R, S),
sys_input_rest(R, L, S).
% sys_input_rest(+Term, -List, +Stream)
sys_input_rest(']', [], _) :- !.
sys_input_rest(',', [X|L], S) :- !,
sys_receive_token(T, S),
sys_input_json(T, X, S),
sys_receive_token(R, S),
sys_input_rest(R, L, S).
sys_input_rest(_, _, _) :-
throw(error(syntax_error(illegal_array),_)).
% sys_input_map(+Term, -Map, +Stream)
sys_input_map('}', {}, _) :- !.
sys_input_map(T, {M}, S) :-
sys_input_pair(T, X, S),
sys_receive_token(R, S),
sys_input_more(R, X, M, S).
% sys_input_more(+Term, +Pair, -Map, +Stream)
sys_input_more('}', X, X, _) :- !.
sys_input_more(',', X, (X,M), S) :- !,
sys_receive_token(T, S),
sys_input_pair(T, Y, S),
sys_receive_token(R, S),
sys_input_more(R, Y, M, S).
sys_input_more(_, _, _, _) :-
throw(error(syntax_error(illegal_object),_)).
% sys_input_pair(+Term, -Term, +Stream)
sys_input_pair(atom(A), A:V, S) :- !,
sys_receive_token(T, S),
sys_input_value(T, V, S).
sys_input_pair(_, _, _) :-
throw(error(syntax_error(illegal_json),_)).
% sys_input_value(+Term, -Term, +Stream)
sys_input_value(':', V, S) :- !,
sys_receive_token(T, S),
sys_input_json(T, V, S).
sys_input_value(_, _, _) :-
throw(error(syntax_error(illegal_json),_)).
/***************************************************************/
/* Tokenizer JSON */
/***************************************************************/
/**
* sys_receive_token(T, S):
* sys_receive_token(C, T, S):
* The predicate succeeds in T with the next token. The parameter C
* is the current character and the parameter S is the current stream.
*/
% sys_receive_token(-Term, +Stream)
sys_receive_token(T, S) :-
get_code(S, C),
sys_receive_token(C, T, S).
% sys_receive_token(+Integer, -Term, +Stream)
sys_receive_token(0'\", atom(A), S) :-
!, get_code(S, H),
sys_receive_string(H, L, S),
atom_codes(A, L).
sys_receive_token(0'-, number(N), S) :-
!, peek_code(S, H),
sys_receive_number(H, L, S),
atom_codes(A, [0'-|L]),
atom_number(A, N).
sys_receive_token(C, number(N), S) :-
sys_json_digit(C), !, peek_code(S, H),
sys_receive_number(H, L, S),
atom_codes(A, [C|L]),
atom_number(A, N).
sys_receive_token(C, T, _) :-
sys_json_punct(C), !,
char_code(T, C).
sys_receive_token(C, T, S) :-
sys_json_white(C), !, get_code(S, H),
sys_receive_token(H, T, S).
sys_receive_token(C, ident(I), S) :-
sys_json_letter(C), !, peek_code(S, H),
sys_receive_name(H, L, S),
atom_codes(I, [C|L]).
sys_receive_token(-1, end_of_file, _) :- !.
sys_receive_token(_, _, _) :-
throw(error(syntax_error(illegal_token),_)).
% sys_receive_number(+Integer, -List, +Stream)
sys_receive_number(0'., [0'.|L], S) :-
!, get_code(S, _), peek_code(S, H),
sys_receive_fraction(H, L, S).
sys_receive_number(0'e, [0'e|L], S) :-
!, get_code(S, _), peek_code(S, H),
sys_receive_exponent(H, L, S).
sys_receive_number(0'E, [0'E|L], S) :-
!, get_code(S, _), peek_code(S, H),
sys_receive_exponent(H, L, S).
sys_receive_number(C, [C|L], S) :-
sys_json_digit(C), !, get_code(S, _), peek_code(S, H),
sys_receive_number(H, L, S).
sys_receive_number(_, [], _).
% sys_receive_fraction(+Integer, -List, +Stream)
sys_receive_fraction(0'e, [0'e|L], S) :-
!, get_code(S, _), peek_code(S, H),
sys_receive_exponent(H, L, S).
sys_receive_fraction(0'E, [0'E|L], S) :-
!, get_code(S, _), peek_code(S, H),
sys_receive_exponent(H, L, S).
sys_receive_fraction(C, [C|L], S) :-
sys_json_digit(C), !, get_code(S, _), peek_code(S, H),
sys_receive_fraction(H, L, S).
sys_receive_fraction(_, [], _).
% sys_receive_exponent(+Integer, -List, +Stream)
sys_receive_exponent(0'+, [0'+|L], S) :-
!, get_code(S, _), peek_code(S, H),
sys_receive_exponent(H, L, S).
sys_receive_exponent(0'-, [0'-|L], S) :-
!, get_code(S, _), peek_code(S, H),
sys_receive_exponent(H, L, S).
sys_receive_exponent(C, [C|L], S) :-
sys_json_digit(C), !, get_code(S, _), peek_code(S, H),
sys_receive_exponent(H, L, S).
sys_receive_exponent(_, [], _).
/***************************************************************/
/* String Tokens JSON */
/***************************************************************/
% sys_receive_string(+Integer, -List, +Stream)
sys_receive_string(0'\", [], _) :- !.
sys_receive_string(0'\\, L, S) :- !,
get_code(S, H),
sys_receive_escape(H, L, S).
sys_receive_string(C, [C|L], S) :-
get_code(S, H),
sys_receive_string(H, L, S).
% sys_receive_escape(+Integer, -List, +Stream)
sys_receive_escape(0'u, [C|L], S) :- !,
sys_receive_hex(4, R, S),
atom_codes(I, R), atom_integer(I, 16, C),
get_code(S, J),
sys_receive_string(J, L, S).
sys_receive_escape(C, [E|L], S) :-
sys_is_control(C, E), !,
get_code(S, H),
sys_receive_string(H, L, S).
sys_receive_escape(C, [C|L], S) :-
sys_is_special(C), !,
get_code(S, H),
sys_receive_string(H, L, S).
sys_receive_escape(_, _, _) :-
throw(error(syntax_error(illegal_escape),_)).
% sys_receive_hex(+Integer, -List, +Stream)
sys_receive_hex(0, [], _) :- !.
sys_receive_hex(K, [C|L], S) :-
get_code(S, C),
sys_json_hex(C), !,
J is K-1,
sys_receive_hex(J, L, S).
sys_receive_hex(_, _, _) :-
throw(error(syntax_error(illegal_escape),_)).
% sys_receive_name(+Integer, -List, +Stream)
sys_receive_name(C, [C|L], S) :-
sys_json_letter(C), !, get_code(S, _), peek_code(S, H),
sys_receive_name(H, L, S).
sys_receive_name(_, [], _).
/***************************************************************/
/* Code Classify JSON */
/***************************************************************/
% sys_json_digit(+Code)
sys_json_digit(C) :- 0'0 =< C, C =< 0'9.
% sys_json_punct(+Code)
sys_json_punct(0'[).
sys_json_punct(0']).
sys_json_punct(0',).
sys_json_punct(0'{).
sys_json_punct(0'}).
sys_json_punct(0':).
% sys_json_white(+Code)
sys_json_white(0' ).
sys_json_white(0'\n).
sys_json_white(0'\r).
sys_json_white(0'\t).
% sys_json_hex(+Code)
sys_json_hex(C) :- 0'0 =< C, C =< 0'9, !.
sys_json_hex(C) :- 0'A =< C, C =< 0'F, !.
sys_json_hex(C) :- 0'a =< C, C =< 0'f.
% sys_json_letter(+Code)
sys_json_letter(C) :- 0'a =< C, C =< 0'z.