Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 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)).
:- ensure_loaded(library(misc/dict)).
/***************************************************************/
/* Some Convenience */
/***************************************************************/
/**
* json_atom(T, A):
* The predicate succeeds in A with the atom for the JSON 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.
/***************************************************************/
/* Unparse JSON */
/***************************************************************/
/**
* write_json(T):
* write_json(S, T):
* The predicate succeeds. As a side effect the JSON 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_check_ident(X),
put_atom(S, X).
sys_print_json([], S) :- !,
put_atom(S, '[]').
sys_print_json([X|L], S) :- !,
put_atom(S, '['),
sys_print_json(X, S),
sys_print_list(L, S),
put_atom(S, ']').
sys_print_json({}, S) :- !,
put_atom(S, '{}').
sys_print_json({M}, S) :- !,
put_atom(S, '{'),
sys_print_map(M, S),
put_atom(S, '}').
sys_print_json(T, _) :-
throw(error(type_error(json,T),_)).
% sys_check_ident(+Atom)
sys_check_ident(V) :- var(V),
throw(error(instantiation_error,_)).
sys_check_ident(null) :- !.
sys_check_ident(false) :- !.
sys_check_ident(true) :- !.
sys_check_ident(A) :-
throw(error(type_error(ident,A),_)).
% 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),_)).
% sys_print_map(+Map, +Stream)
sys_print_map(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_print_map((M,Q), S) :- !,
sys_print_member(M, S),
put_atom(S, ', '),
sys_print_map(Q, S).
sys_print_map(M, S) :-
sys_print_member(M, S).
% sys_print_member(+Pair, +Stream)
sys_print_member(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_print_member(K:V, S) :- !,
sys_string_quoted(K, H),
put_atom(S, H),
put_atom(S, ': '),
sys_print_json(V, S).
sys_print_member(T, _) :-
throw(error(type_error(member,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_category(C, T), member(T, [15,16]).
% sys_is_invalid(+Code)
sys_is_invalid(C) :- code_category(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).
/***************************************************************/
/* Parse JSON */
/***************************************************************/
/**
* read_json(E):
* read_json(S, E):
* The predicate succeeds in E with a JSON 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_check_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_member),_)).
% 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.
/****************************************************************/
/* Error Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile strings/3.
strings('type_error.json', de, 'Argument sollte JSON Data sein, gefunden $.').
strings('type_error.member', de, 'Argument sollte JSON Member sein, gefunden $.').
strings('type_error.object', de, 'Argument sollte JSON Objekt sein, gefunden $.').
strings('type_error.ident', de, 'Argument sollte JSON Ident sein, gefunden $.').
strings('syntax_error.illegal_json', de, 'Kein JSON Data.').
strings('syntax_error.illegal_array', de, 'Kein JSON Array.').
strings('syntax_error.illegal_member', de, 'Kein JSON Member.').
strings('syntax_error.illegal_object', de, 'Kein JSON Objekt.').
strings('syntax_error.illegal_token', de, 'Kein JSON Token.').
strings('type_error.json', de, 'Argument should be some JSON data, gefunden $.').
strings('type_error.member', de, 'Argument should be a JSON member, gefunden $.').
strings('type_error.object', '', 'Argument should be a JSON object, found $.').
strings('type_error.ident', '', 'Argument should be a JSON ident, found $.').
strings('syntax_error.illegal_json', '', 'Not some JSON data.').
strings('syntax_error.illegal_array', '', 'Not a JSON array.').
strings('syntax_error.illegal_member', '', 'Not a JSON member.').
strings('syntax_error.illegal_object', '', 'Not a JSON object.').
strings('syntax_error.illegal_token', '', 'Not a JSON token.').