Commit 488776bf authored by Sebastian Seufert's avatar Sebastian Seufert
Browse files

Exception messages in clear_bg

parent 6500a90e
......@@ -11,19 +11,36 @@
*/
action_reply_success(Code, Msg, Reply) :-
format('Status: ~q~n', Code),
format('Content-type: text/plain~n~n'),
format(atom(Reply), 'Action: ~q', [Msg]).
format(atom(Reply), 'Endpoint: ~q', [Msg]),
reply_json(Reply, [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]).
Reply =_{endpoint:Msg,details:Details},
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).
write_to_tty(Msg) :-
tell(user),
writeln(Msg),
told.
\ No newline at end of file
......@@ -8,6 +8,9 @@
:- 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)).
......@@ -42,6 +45,7 @@ getMock(irrelevant, JSONContent) :-
%%%%%%%%%%%%%%%%
server_main :-
attach_bg_db,
server_opts(Opts),
% consult(irrelevanceTheory),
debug(Opts.debug),
......@@ -73,6 +77,7 @@ server_opts(Opts) :-
:- http_handler(root(state), state(post), []).
:- http_handler(root(bg), set_bg, [method(post)]).
% :- http_handler(root(bg), get_bg, [method(get)]).
:- http_handler(root(clear), clear_bg, [method(post)]).
/* Handlers for irr & explanation */
......@@ -85,6 +90,10 @@ server_opts(Opts) :-
:- http_handler(root(remove), handle_remove, []).
:- http_handler(root(query), handle_query, []).
:- http_handler(root(test), test, []).
/* Closures for handlers */
handle_explain(Req) :-
http_read_json(Req, json(Content),[value_string_as(string)]),
......@@ -126,7 +135,7 @@ set_bg(Req) :-
),
(
Total is 0
-> action_reply_success(204, add, 'fact(s) already present - nochange', Reply)
-> action_reply_success(204, add, 'fact(s) already present, no change', Reply)
; action_reply_success(201, add, Total, Reply)
),
reply_json(Reply). % -> for reply
......@@ -142,19 +151,44 @@ assert_dict(D,Acc) :-
assertz(theory_bg:item(Abs_path,Dict))
).
clear_bg(Req) :-
clear_bg(Req) :-
option(content_length(0),Req)
-> action_reply_success(400, clear_bg, 'no change (is the body empty?)', Reply)
;
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).
catch(
(
(is_list(Dict)
-> retract_list(Dict,Failed)
; retract_list([Dict],Failed)
)
),
E, throw(server_error(E))
),
(
Failed==[]
-> action_reply_success(200, clear_bg, 'facts removed', Reply),
reply_json(Reply)
; action_reply_success(200, clear_bg, 'some facts not existing, skipping', Reply),
reply_json(Reply)
).
get_bg(_Req) :-
get_all(_type,X),
reply_json(X).
retract_list([]).
retract_list([H|T]) :-
R = theory_bg:item(_Abs_Path,H),
retract(R),
retract_list(T).
% In: alle zu löschenden Dicts
% Out: alle nicht löschbaren Pfade
% retract_list(In, Out)
retract_list([], []).
retract_list([In|Ins],Outs) :-
retract(theory_bg:item(In.abs_path,In)),
!,
retract_list(Ins,Outs).
retract_list([In|Ins],[In|Outs]) :-
retract_list(Ins,Outs).
state(get, _Req) :-
generic_reply(state, get, Reply),
......@@ -227,14 +261,23 @@ 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.
:- persistent
bg(item:atom).
attach_bg_db :-
working_directory(CWD, CWD),
directory_file_path(CWD, 'bg.db', DB),
db_attach(DB, []).
attach_bg_db(Dir) :-
working_directory(CWD, CWD),
atom_concat(CWD, Dir, Path),
make_directory_path(Path),
directory_file_path(Path, 'bg.db', DB),
db_attach(DB, []).
\ 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