Commit d9dfdfc6 authored by Sebastian Seufert's avatar Sebastian Seufert
Browse files

- added theory_bg + persistency

- some cleanup
parent 488776bf
:- 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)).
\ No newline at end of file
......@@ -8,22 +8,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,15 +37,15 @@ getMock(irrelevant, JSONContent) :-
%%%%%%%%%%%%%%%%
server_main :-
attach_bg_db,
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 =
......@@ -76,8 +68,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), get_bg, [method(get)]).
:- http_handler(root(bg), bg(Method), [methods(get,post), method(Method)]).
:- http_handler(root(clear), clear_bg, [method(post)]).
/* Handlers for irr & explanation */
......@@ -90,10 +81,6 @@ 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)]),
......@@ -111,21 +98,21 @@ handle_explain(Req) :-
; 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(get, Req) :- get_bg(Req).
bg(post, Req) :- set_bg(Req).
set_bg(Req) :-
http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]),
(is_list(Dict)
......@@ -137,8 +124,7 @@ set_bg(Req) :-
Total is 0
-> action_reply_success(204, add, 'fact(s) already present, no change', Reply)
; action_reply_success(201, add, Total, Reply)
),
reply_json(Reply). % -> for reply
).
assert_dict(D,Acc) :-
dict_create(Dict,tag(type),D),
......@@ -148,48 +134,43 @@ assert_dict(D,Acc) :-
;
Acc = 1,
Abs_path = Dict.abs_path,
assertz(theory_bg:item(Abs_path,Dict))
add_item(Abs_path, Dict)
).
%ToDo: StatusCodes bei verschiedenen returns
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)]),
catch(
(
(is_list(Dict)
-> retract_list(Dict,Failed)
; retract_list([Dict],Failed)
)
http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]),
catch(
(
(is_list(Dict)
-> retract_list(Dict,Failed)
; retract_list([Dict],Failed)
)
),
E, throw(server_error(E))
),
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)
(
Failed==[]
-> action_reply_success(200, clear_bg, 'facts removed', Reply)
; action_reply_success(200, clear_bg, 'some facts not existing, skipping', Reply)
).
get_bg(_Req) :-
get_all(_type,X),
reply_json(X).
% 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)),
!,
rem_item(In.abs_path,In),!,
retract_list(Ins,Outs).
retract_list([In|Ins],[In|Outs]) :-
retract_list(Ins,Outs).
%%ToDo Merge mit State
get_bg(_Req) :-
get_all(_type,X),
reply_json(X).
state(get, _Req) :-
generic_reply(state, get, Reply),
reply_json(Reply).
......@@ -251,6 +232,10 @@ handle_remove(Req) :-
reply_json(Reply).
http_stop :-
db_sync_all(gc),
http_stop_server(4444,[]).
/* Helpers */
occurs(Dict) :- theory_bg:item(_Abs_path,X), X = Dict, true.
......@@ -265,19 +250,4 @@ 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
match_with(Tag, Field, Dict, Value) :- theory_bg:item(_,Dict), is_dict(Dict,Tag), Dict.Field = Value.
\ 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