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