Prolog "spin"

Admin User, erstellt 22. Feb. 2024
         
/**
* 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)).
/*******************************************************************/
/* HTTP Client */
/*******************************************************************/
/**
* open(P, M, S, O): [ISO 8.11.5.4]
* The built-in succeeds in S with a new stream for the path P
* and the mode M and open options O.
*/
% open(+Atom, +Atom, -Stream, +List)
open(P, M, S, List) :-
ir_object_new(Map),
sys_open_opts(List, Map),
sys_open(P, M, Map, S).
% sys_open(+Atom, +Atom, +Map, -Stream)
sys_open(P, read, Map, S) :- current_prolog_flag(read_async, on), !,
os_open_promise_opts(P, Map, S, Q),
'$YIELD'(Q).
sys_open(P, M, Map, S) :-
os_open_sync_opts(P, M, Map, S).
% sys_open_opts(+List, +Map)
sys_open_opts(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_open_opts([X|L], Map) :- !,
sys_open_opt(X, Map),
sys_open_opts(L, Map).
sys_open_opts([], _) :- !.
sys_open_opts(L, _) :-
throw(error(type_error(list,L),_)).
% sys_open_opt(+Term, +Map)
sys_open_opt(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_open_opt(method(M), Map) :- !,
sys_check_atom(M),
ir_object_set(Map, method, M).
sys_open_opt(headers(H), Map) :- !,
ir_object_new(Map2),
sys_http_headers(H, Map2),
ir_object_set(Map, headers, Map2).
sys_open_opt(body(B), Map) :- !,
sys_check_atom(B),
ir_object_set(Map, body, B).
sys_open_opt(O, _) :-
throw(error(type_error(open_option,O),_)).
/*******************************************************************/
/* HTTP Server */
/*******************************************************************/
/**
* http_server_on(S, T, L, G):
* The predicate succeeds. As a side effect it adds a type T stackfull event
* handler with formal paramaters L and callback goal G to the HTTP server S.
**/
% http_server_on(+Server, +Atom, +List, +Goal)
http_server_on(Server, Type, Paras, Goal) :-
Head =.. [''|Paras],
sys_frost_horn((Head :- sys_call_print(Goal)), Native),
sys_http_server_on(Server, Type, Native).
/*******************************************************************/
/* HTTP Request */
/*******************************************************************/
/**
* url_search_params(U, P, L):
* The predicate succeeds in P with the non-query part of U and
* in L with the query part of U decoded into a key-value list.
*/
% url_search_params(+Atom, -Atom, -List)
url_search_params(Url, Path2, List) :-
sub_atom(Url, Pos, _, Pos2, '?'), !,
sub_atom(Url, 0, Pos, _, Path),
sub_atom(Url, _, Pos2, 0, Query),
percent_encode(Path2, Path),
url_search_params_query(Query, List).
url_search_params(Url, Url2, []) :-
percent_encode(Url2, Url).
% url_search_params_query(+Atom, -List)
url_search_params_query(Query, [Pair|List]) :-
sub_atom(Query, Pos, _, Pos2, '&'), !,
sub_atom(Query, 0, Pos, _, Component),
sub_atom(Query, _, Pos2, 0, Rest),
url_search_params_pair(Component, Pair),
url_search_params_query(Rest, List).
url_search_params_query(Query, [Pair]) :-
url_search_params_pair(Query, Pair).
% url_search_params_pair(+Atom, -Pair)
url_search_params_pair(Component, Key2-Value2) :-
sub_atom(Component, Pos, _, Pos2, '='), !,
sub_atom(Component, 0, Pos, _, Key),
sub_atom(Component, _, Pos2, 0, Value),
percent_encode(Key2, Key),
percent_encode(Value2, Value).
url_search_params_pair(Component, Component2-'') :-
percent_encode(Component2, Component).
/**
* http_input_new(S, R):
* The predicate succeeds in R with a new text reader for the HTTP request S.
*/
% http_input_new(+Request, -Stream)
http_input_new(S, R) :- current_prolog_flag(read_async, on), !,
http_input_promise(S, R, Q),
'$YIELD'(Q).
http_input_new(S, R) :-
http_input_sync(S, R).
/*******************************************************************/
/* HTTP Response */
/*******************************************************************/
/**
* http_write_head(S, C, H):
* The predicate succeeds. As a side effect it writes the status
* code C and the headers map H to the HTTP response S.
*/
% http_write_head(+Response, +Integer, +List)
http_write_head(Res, Code, List) :-
ir_object_new(Map),
sys_http_headers(List, Map),
sys_http_write_head(Res, Code, Map).
% sys_http_headers(+List, +Map)
sys_http_headers(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_http_headers([X|L], Map) :- !,
sys_http_header(X, Map),
sys_http_headers(L, Map).
sys_http_headers([], _) :- !.
sys_http_headers(L, _) :-
throw(error(type_error(list,L),_)).
% sys_http_header(+Term, +Map)
sys_http_header(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_http_header(K-V, Map) :- !,
sys_check_atom(K),
sys_check_atom(V),
ir_object_set(Map, K, V).
sys_http_header(O, _) :-
throw(error(type_error(pair,O),_)).
/*******************************************************************/
/* Foreign Predicates */
/*******************************************************************/
% os_open_promise_opts(P, L, S, Q)
% defined in foreign(util/httplib)
% os_open_sync_opts(P, M, L, S)
% defined in foreign(util/httplib)
% http_server_new(F)
% defined in foreign(util/httplib)
% sys_http_server_on(F, C)
% defined in foreign(util/httplib)
% http_server_listen(F, P)
% defined in foreign(util/httplib)
% http_current_method(F, G)
% defined in foreign(util/httplib)
% http_current_path(F, G)
% defined in foreign(util/httplib)
% sys_http_write_head(F, G, H)
% defined in foreign(util/httplib)
% http_text_new(F, G)
% defined in foreign(util/httplib)
:- ensure_loaded(foreign(util/httplib)).