Skip to content

GitLab

Commit 72a8449e authored by Sebastian Seufert's avatar Sebastian Seufert
Browse files

Mending last WTF commit

parent b7bfcd4b
Hide whitespace changes
Inline Side-by-side
include/common/api_response.pl
View file @ 72a8449e
......@@ -52,9 +52,4 @@ print_request([]).
print_request([H|T]) :-
H =.. [Name, Value],
format('<tr><td>~w<td>~w~n', [Name, Value]),
print_request(T).
write_to_tty(Msg) :-
tell(user),
writeln(Msg),
told.
\ No newline at end of file
print_request(T).
\ No newline at end of file
web_api.pl
View file @ 72a8449e
......@@ -131,263 +131,9 @@ bg(post, Req) :- set_bg(Req).
% - 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)
),
(
Total is 0
-> action_reply_success(204, set_bg, 'fact(s) already present, no change')
; L == Total
-> format(atom(Message), 'Received: ~q, Added: ~q', [L,Total]),
action_reply_success(201, set_bg, Message)
; Diff is (L - Total),
format(atom(Message), 'Received: ~q, Added: ~q, Skipped: ~q (already present)', [L,Total, Diff]),
action_reply_success(201, set_bg, Message)
).
/**
* 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),
(
occurs(Dict)
-> Acc = 0
;
Acc = 1,
Abs_path = Dict.abs_path,
add_item(Abs_path, Dict)
).
%! 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(400, clear_bg, 'no change (is the body empty?)')
;
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))
),
(
Failed == []
-> format(atom(Message), 'Received: ~q, Removed: ~q', [Length,Length]),
action_reply_success(200, clear_bg, Message)
; length(Failed, FailedCnt),
Diff is (Length - FailedCnt),
format(atom(Message), 'Received: ~q, Removed: ~q, Skipped: ~q (not found)', [Length, Diff, FailedCnt]),
action_reply_success(200, clear_bg, Message)
).
/**
* 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)
% @tbd advanced error handling
%
get_bg(_Req) :-
theory_bg:get_size(Size),
get_all(_Type,List),
Reply =_{item_count:Size,list:List},
reply_json(Reply, [status(200)]).
/* Helpers */
occurs(Dict) :- theory_bg:item(_Abs_path,X), X = Dict, true.
list_dyns :-
predicate_property(S, dynamic),
clause(S, T),
writeln(S :- T),
fail.
getPath(Dict, Dict.abs_path). :- module(web_api, [server_main/0]).
:- include(include/common/api_response).
:- include(include/common/generic_handlers).
:- use_module(library(http/thread_httpd)).
:- use_module(library(http/http_error)).
:- use_module(library(http/http_dispatch)).
:- 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(pairs)).
:- use_module(library(optparse), [opt_arguments/3]).
% Structure of items & persistency
:- use_module(theory_bg).
init :- server_main.
%%%%%%%%%%%%%%%%
%% Mocks for Michael to test GUI
getMock(explanation, JSONContent) :-
working_directory(CWD, CWD),
atom_concat(CWD, 'mocks/expl-response-example.json', Mock),
open(Mock, read, Stream),
json_read(Stream, JSONContent).
getMock(irrelevant, JSONContent) :-
working_directory(CWD, CWD),
atom_concat(CWD, 'mocks/irr-response-example.json', Mock),
open(Mock, read, Stream),
json_read(Stream, JSONContent).
%%%%%%%%%%%%%%%%
server_main :-
server_opts(Opts),
debug(Opts.debug),
http_server(http_dispatch,[port(Opts.port)]),
set_setting(http:logfile, Opts.log).
debug(false).
debug(true) :-
set_prolog_flag(answer_write_options,[max_depth(0)]),
prolog_ide(debug_monitor).
server_opts(Opts) :-
OptsSpec =
[[opt(port), type(integer), default(4444), longflags([port]),
help('Server port')],
[opt(log), type(atom), default('log.txt'), longflags([log]),
help('Logfile')],
[opt(debug), type(boolean), default(false), longflags([debug])]
],
opt_arguments(OptsSpec, Opts0, PositionalArgs),
dict_create(Opts, opts, Opts0),
( PositionalArgs == []
-> true
; throw(error(extra_args,
context(PositionalArgs),
'Unknown positional arg(s)'))
).
/* +++++++++++++++++++++++++++++++++++++++++++++ */
/* World state and runtime information handlers */
:- http_handler(root(state), state(post), []).
:- http_handler(root(bg), bg(Method), [methods(get,post), method(Method)]).
:- http_handler(root(clear), clear_bg, [method(post)]).
/* Handlers for irr & explanation */
:- http_handler(root(irrelevant/file), handle_irrelevant, [method(post)]).
:- http_handler(root(explain), handle_explain, [method(post)]).
/* Generic handlers */
:- http_handler(root(.), echo, []).
:- http_handler(root(add), handle_add, []).
:- http_handler(root(remove), handle_remove, []).
:- http_handler(root(query), handle_query, []).
/* Closures for handlers */
handle_explain(Req) :-
http_read_json(Req, json(Content),[value_string_as(string)]),
%% Limit as int, Path as string
% TODO: improve error handling on required parameter
( member(abs_path=Path, Content) -> true ; throw("abs_path is required!")),
( member(limit=Limit, Content) -> true; Limit=5 ),
% TODO: improve error handling
( bagof([abs_path=Path, reasoning=Message, reasoning_details=Details, references=References],
explain(irrelevant(Path),Message,Details,References),
AllExplanations )
-> true
; throw("No explanation found!")
),
Exceeded = true,
reply_json(json([explanations=AllExplanations,'answers-exceeded'=Exceeded])).
handle_irrelevant(Req) :-
http_read_json(Req, json(Content), [value_string_as(string)]),
%% Path as string
% TODO: improve error handling on required parameter
( Content=[file=Path] -> true ; throw("file is required!")),
( irrelevant(Path) -> AllIrrelevant=[Path] ; AllIrrelevant = []),
reply_json(json([irrelevant=AllIrrelevant,'list-exhaustive'=true])).
/**
* 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)
......@@ -409,7 +155,7 @@ set_bg(Request) :-
).
/**
*! assert_dict(+Dict,-Acc) is det
* assert_dict(+Dict,-Acc) is det
*
* Auxiliary predicate adding items from a Dict, skipping existing entries.
*
......@@ -463,7 +209,7 @@ clear_bg(Req) :-
).
/**
*! retract_list(+Dict,-Failed) is det
* retract_list(+Dict,-Failed) is det
*
* Auxiliary predicate removing items, skipping nonexisting entries.
*
......@@ -529,25 +275,4 @@ write_to_tty(Msg) :-
%
http_stop :-
db_sync_all(gc),
http_stop_server(4444,[]).
match_with(Tag, Field, Dict, Value) :- theory_bg:item(_,Dict), is_dict(Dict,Tag), Dict.Field = 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,[]).
http_stop_server(4444,[]).
\ No newline at end of file
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