Skip to content

GitLab

Commit a7bf59b4 authored by Siebers, Michael's avatar Siebers, Michael
Browse files

Merge remote-tracking branch 'origin/master' into explanation_integration 

# Conflicts:
#	web_api.pl
parents e39e9b0a 8852cf87
Hide whitespace changes
Inline Side-by-side
include/common/api_response.pl
View file @ a7bf59b4
% :- module(api_response, []).
/** Provide response formatting
/*
This include provides simple formatting predicates that form a json response.
%To Discuss - codes used correctly?
200 -> gets
201 -> created
202 -> accepted (still working)
......@@ -10,20 +12,37 @@
501 -> not implemented
*/
action_reply_success(Code, Msg, Reply) :-
format('Status: ~q~n', Code),
format('Content-type: text/plain~n~n'),
format(atom(Reply), 'Action: ~q', [Msg]).
action_reply_success_dict(Code, Dict) :-
reply_json_dict(Dict, [status(Code)]).
action_reply_success(Code, Msg, Details, Reply) :-
format('Status: ~q~n', Code),
format('Content-type: text/plain~n~n'),
format(atom(Reply), 'Action: ~q, Details: ~q', [Msg, Details]).
/** Remove later
action_reply_success(Code, Msg) :-
format(atom(Reply), 'Endpoint: ~q', [Msg]),
reply_json(Reply, [status(Code)]).
action_reply_success(Code, Endpoint, Action) :-
Reply =_{endpoint:Endpoint,action:Action},
reply_json(Reply, [status(Code)]).
*/
generic_reply(Method, Pred, Info) :-
format('Status: 201~n'),
format('Content-type: text/plain~n~n'),
format('Content-Type: text/plain~n~n'),
concat(Method, ' ', SP),
concat(SP, Pred, Details),
format(atom(Info), 'Not yet implemented. Endpoint is: ~q', Details).
generic_reply_html(Code, Request) :-
format('Status: ~q~n', Code),
format('Content-Type: text/html~n~n', []),
format('<html>~n', []),
format('<table border=1>~n'),
print_request(Request),
format('~n</table>~n'),
format('</html>~n', []).
print_request([]).
print_request([H|T]) :-
H =.. [Name, Value],
format('<tr><td>~w<td>~w~n', [Name, Value]),
print_request(T).
\ No newline at end of file
include/common/generic_handlers.pl 0 → 100644
View file @ a7bf59b4
echo(_Req) :-
format('Status: 204~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Could not match url: ~q", ''),
reply_json(Reply).
toProlog(InProlog, OutTerm, OutBindings) :-
atom_to_term(InProlog, OutTerm, OutBindings).
read_json_request(InRequest, OutProlog) :-
http_read_json(InRequest, JSON),
json_to_prolog(JSON, OutProlog).
handle_add(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, _),
assert(Term),
format('Status: 201~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Added fact to base: ~q", Term),
reply_json(Reply).
jsonize(X, Y) :-
Y = json( X ).
evaluate_query(InTerm, InBindings, OutStringResult) :-
Goal =.. [findall, InBindings, InTerm, IR],
call(Goal),
sort(IR, Result),
maplist(jsonize, Result, OutStringResult).
handle_query(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, Bindings),
evaluate_query(Term, Bindings, Result),
reply_json(Result,
[
serialize_unknown(true)
]).
handle_remove(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, _),
(
(Term = _/_, abolish(Term)) ;
retract(Term)
),
format('Status: 200~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Removed fact: ~q", Term),
reply_json(Reply).
run.pl
View file @ a7bf59b4
......@@ -8,3 +8,6 @@
% :- initialization(guitracer).
:- initialization(server_main).
%% convenience in user module
h :- web_api:http_stop, halt.
\ No newline at end of file
theory_bg.pl 0 → 100644
View file @ a7bf59b4
:- module(theory_bg,
[item/2,
add_item/2,
rem_item/2
]).
:- use_module(library(persistency)).
%% ToDo - Doku
%! theory_bg:item(+Abs_path,Dict) is det.
:- persistent(item_(path:atom, item:dict)).
:- initialization(db_attach('theory_bg.db', [])).
item(Path, Dict) :- item_(Path, Dict).
add_item(Path, Dict) :-
with_mutex(theory_bg, (retractall_item_(Path,_), assert_item_(Path, Dict))).
rem_item(Path, Dict) :-
with_mutex(theory_bg, retract_item_(Path, Dict)).
/* Helpers */
get_size(X) :- persistency:db_size(theory_bg,X).
\ No newline at end of file
web_api.pl
View file @ a7bf59b4
......@@ -3,6 +3,7 @@
:- include(include/common/api_response).
:- include('include/irrelevance.pl').
:- include('include/explanations.pl').
:- include(include/common/generic_handlers).
:- use_module(library(http/thread_httpd)).
:- use_module(library(http/http_error)).
......@@ -10,19 +11,14 @@
:- use_module(library(http/http_json)).
:- use_module(library(http/json)).
:- use_module(library(http/json_convert)).
:- use_module(library(http/http_header)).
:- use_module(library(http/http_client)).
:- use_module(library(http/http_log)).
:- use_module(library(persistency)).
:- use_module(library(pairs)).
%! theory_bg:item(+Abs_path,Dict) is det.
:- dynamic(theory_bg:item/2).
:- use_module(library(optparse), [opt_arguments/3]).
% :- initialization(server_main, main).
:- set_prolog_flag(answer_write_options,[max_depth(0)]).
% :- debug.
% Structure of items & persistency
:- use_module(theory_bg).
init :- server_main.
......@@ -45,13 +41,14 @@ getMock(irrelevant, JSONContent) :-
server_main :-
server_opts(Opts),
% consult(irrelevanceTheory),
debug(Opts.debug),
http_server(http_dispatch,[port(Opts.port)]),
set_setting(http:logfile, Opts.log).
debug(false).
debug(true) :- prolog_ide(debug_monitor).
debug(true) :-
set_prolog_flag(answer_write_options,[max_depth(0)]),
prolog_ide(debug_monitor).
server_opts(Opts) :-
OptsSpec =
......@@ -74,7 +71,7 @@ server_opts(Opts) :-
/* World state and runtime information handlers */
:- http_handler(root(state), state(post), []).
:- http_handler(root(bg), set_bg, [method(post)]).
:- http_handler(root(bg), bg(Method), [methods(get,post), method(Method)]).
:- http_handler(root(clear), clear_bg, [method(post)]).
/* Handlers for irr & explanation */
......@@ -88,8 +85,6 @@ server_opts(Opts) :-
:- http_handler(root(query), handle_query, []).
/* Closures for handlers */
%! handle_irrelevant_file(++Request) is det
%
% Handles HTTP request querrying the irrelevance of a single absolute path.
......@@ -175,21 +170,53 @@ handle_explain(Req) :-
% reply_json/2.
).
set_bg(Req) :-
http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]),
/**
* bg(-Arg:type) is nondet
*
* Predicate ...
*/
bg(get, Req) :- get_bg(Req).
bg(post, Req) :- set_bg(Req).
%! set_bg(++Request) is det
%
% Handles HTTP requests adding background facts.
% @Request is a POST that contains a json body denoting what facts to add.
% (defined in @see ./schema/filesystem-data-schema.json)
%
% Replies with:
%
% - status 200 containing a json body describing the changes in detail (defined in @see ./schema/status-schema.json)
% - status 400 in case of malformed body or header
%
%
% @tbd advanced error handling
%
set_bg(Request) :-
http_read_json_dict(Request, Dict,[value_string_as(atom), tag(type)]),
(is_list(Dict)
-> maplist(assert_dict, Dict, Accs),
length(Dict,L),
sum_list(Accs,Total)
; assert_dict(Dict, Total)
),
(
Diff is (L - Total),
(
% Total is 0 when no facts were added since already present
Total is 0
-> action_reply_success(204, add, 'fact(s) already present - nochange', Reply)
; action_reply_success(201, add, Total, Reply)
),
reply_json(Reply). % -> for reply
-> action_reply_success_dict(204, _{received:L,added:Total,skipped:Diff})
; action_reply_success_dict(201, _{received:L,added:Total,skipped:Diff})
).
/**
* assert_dict(+Dict,-Acc) is det
*
* Auxiliary predicate adding items from a Dict, skipping existing entries.
*
* @Acc tracks the number of effectively added items
*/
assert_dict(D,Acc) :-
dict_create(Dict,tag(type),D),
(
......@@ -198,82 +225,76 @@ assert_dict(D,Acc) :-
;
Acc = 1,
Abs_path = Dict.abs_path,
assertz(theory_bg:item(Abs_path,Dict))
add_item(Abs_path, Dict)
).
clear_bg(Req) :-
http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]),
(is_list(Dict)
-> retract_list(Dict); retract(theory_bg:item(_Abs_Path,Dict))
),
action_reply_success(205, reset_bg, Reply),
reply_json_dict(Reply).
retract_list([]).
retract_list([H|T]) :-
R = theory_bg:item(_Abs_Path,H),
retract(R),
retract_list(T).
state(get, _Req) :-
generic_reply(state, get, Reply),
reply_json(Reply).
state(put, _Req) :-
generic_reply(state, put, Reply),
reply_json(Reply).
echo(_Req) :-
format('Status: 204~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Could not match url: ~q", ''),
reply_json(Reply).
toProlog(InProlog, OutTerm, OutBindings) :-
atom_to_term(InProlog, OutTerm, OutBindings).
read_json_request(InRequest, OutProlog) :-
http_read_json(InRequest, JSON),
json_to_prolog(JSON, OutProlog).
handle_add(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, _),
assert(Term),
format('Status: 201~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Added fact to base: ~q", Term),
reply_json(Reply).
jsonize(X, Y) :-
Y = json( X ).
evaluate_query(InTerm, InBindings, OutStringResult) :-
Goal =.. [findall, InBindings, InTerm, IR],
call(Goal),
sort(IR, Result),
maplist(jsonize, Result, OutStringResult).
handle_query(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, Bindings),
evaluate_query(Term, Bindings, Result),
reply_json(Result,
[
serialize_unknown(true)
]).
handle_remove(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, _),
(
(Term = _/_, abolish(Term)) ;
retract(Term)
),
format('Status: 200~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Removed fact: ~q", Term),
reply_json(Reply).
%! clear_bg(++Request) is det
%
% Handles HTTP requests removing background facts.
% @Request is a POST that contains a json body denoting what facts to remove.
% (defined in @see ./schema/filesystem-data-schema.json)
%
% Replies with:
%
% - status 200 containing a json body describing the changes in detail (defined in @see ./schema/status-schema.json)
% - status 400 in case of empty body
%
clear_bg(Req) :-
option(content_length(0),Req)
-> action_reply_success_dict(400, _{received_empty_body:true})
;
http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]),
catch(
(
(is_list(Dict)
-> length(Dict,Length),
retract_list(Dict,Failed)
; retract_list([Dict],Failed)
)
),
E, throw(server_error(E))
),
length(Failed, FailedCnt),
Diff is (Length - FailedCnt),
( % Failed is empty iff we removed successfully all requested items
% ToDo: Remove case or modify return code
Failed == []
-> action_reply_success_dict(200, _{received:Length,removed:Diff,skipped:FailedCnt})
; action_reply_success_dict(200, _{received:Length,removed:Diff,skipped:FailedCnt})
).
/**
* retract_list(+Dict,-Failed) is det
*
* Auxiliary predicate removing items, skipping nonexisting entries.
*
* @Failed tracks the items that could not be removed, hopefully _only_ because they are not existing.
*
* @tbd advanced error handling
*/
retract_list([], []).
retract_list([In|Ins],Outs) :-
rem_item(In.abs_path,In),!,
retract_list(Ins,Outs).
retract_list([In|Ins],[In|Outs]) :-
retract_list(Ins,Outs).
%! get_bg(@Request) is det
%
% A handler returning information on all currently existing items in theory_bg.
% @Request is a GET, ignoring any transmitted body.
%
% Replies with:
%
% - status 200 containing a json body listing all items (defined in @see ./schema/filesystem-data-schema.json)
%
get_bg(_Req) :-
theory_bg:get_size(Size),
get_all(_Type,List),
Reply =_{item_count:Size,list:List},
reply_json(Reply, [status(200)]).
/* Helpers */
......@@ -286,19 +307,12 @@ list_dyns :-
writeln(S :- T),
fail.
print_request([]).
print_request([H|T]) :-
H =.. [Name, Value],
format('<tr><td>~w<td>~w~n', [Name, Value]),
print_request(T).
getPath(Dict, Dict.abs_path).
get_field(Dict, Field, Res) :- Res = Dict.Field.
get_all(Type, Res) :- findall(T, (theory_bg:item(_,T), is_dict(T,Type)), Res).
get_one(Type, Res) :- is_dict(Res,Type), !.
match_with(Tag, Field, Dict, Value) :- theory_bg:item(_,Dict), is_dict(Dict,Tag), Dict.Field = Value.
%! text_to_string(+Text:text, -String:string)
%
% Transforms any valid text value (atom, list of codes, list of characters,
......@@ -339,3 +353,23 @@ get_dict_typed(Key, Dict, Type, Value) :-
-> true
; throw(error(key_type_error(Key, Type, Value), _))
).
%! write_to_tty(+Msg)
%
% For debugging:
% Switches the output stream of the thread to write to the interpreter.
%
write_to_tty(Msg) :-
tell(user),
writeln(Msg),
told.
%! http_stop
%
% For debugging:
% syncs the db file & gracefully exits the http server.
%
http_stop :-
db_sync_all(gc),
http_stop_server(4444,[]).
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment