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 @@ ...@@ -8,22 +8,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_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,15 +37,15 @@ getMock(irrelevant, JSONContent) :- ...@@ -45,15 +37,15 @@ getMock(irrelevant, JSONContent) :-
%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%
server_main :- server_main :-
attach_bg_db,
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 =
...@@ -76,8 +68,7 @@ server_opts(Opts) :- ...@@ -76,8 +68,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(bg), get_bg, [method(get)]).
:- http_handler(root(clear), clear_bg, [method(post)]). :- http_handler(root(clear), clear_bg, [method(post)]).
/* Handlers for irr & explanation */ /* Handlers for irr & explanation */
...@@ -90,10 +81,6 @@ server_opts(Opts) :- ...@@ -90,10 +81,6 @@ server_opts(Opts) :-
:- http_handler(root(remove), handle_remove, []). :- http_handler(root(remove), handle_remove, []).
:- http_handler(root(query), handle_query, []). :- http_handler(root(query), handle_query, []).
:- http_handler(root(test), test, []).
/* Closures for handlers */ /* Closures for handlers */
handle_explain(Req) :- handle_explain(Req) :-
http_read_json(Req, json(Content),[value_string_as(string)]), http_read_json(Req, json(Content),[value_string_as(string)]),
...@@ -111,21 +98,21 @@ handle_explain(Req) :- ...@@ -111,21 +98,21 @@ handle_explain(Req) :-
; throw("No explanation found!") ; throw("No explanation found!")
), ),
Exceeded = true, Exceeded = true,
reply_json(json([explanations=AllExplanations,'answers-exceeded'=Exceeded])). reply_json(json([explanations=AllExplanations,'answers-exceeded'=Exceeded])).
handle_irrelevant(Req) :- handle_irrelevant(Req) :-
http_read_json(Req, json(Content), [value_string_as(string)]), http_read_json(Req, json(Content), [value_string_as(string)]),
%% Path as string %% Path as string
% TODO: improve error handling on required parameter % TODO: improve error handling on required parameter
( Content=[file=Path] -> true ; throw("file is required!")), ( Content=[file=Path] -> true ; throw("file is required!")),
( irrelevant(Path) -> AllIrrelevant=[Path] ; AllIrrelevant = []), ( irrelevant(Path) -> AllIrrelevant=[Path] ; AllIrrelevant = []),
reply_json(json([irrelevant=AllIrrelevant,'list-exhaustive'=true])). reply_json(json([irrelevant=AllIrrelevant,'list-exhaustive'=true])).
bg(get, Req) :- get_bg(Req).
bg(post, Req) :- set_bg(Req).
set_bg(Req) :- set_bg(Req) :-
http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]), http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]),
(is_list(Dict) (is_list(Dict)
...@@ -137,8 +124,7 @@ set_bg(Req) :- ...@@ -137,8 +124,7 @@ set_bg(Req) :-
Total is 0 Total is 0
-> action_reply_success(204, add, 'fact(s) already present, no change', Reply) -> action_reply_success(204, add, 'fact(s) already present, no change', Reply)
; action_reply_success(201, add, Total, Reply) ; action_reply_success(201, add, Total, Reply)
), ).
reply_json(Reply). % -> for reply
assert_dict(D,Acc) :- assert_dict(D,Acc) :-
dict_create(Dict,tag(type),D), dict_create(Dict,tag(type),D),
...@@ -148,48 +134,43 @@ assert_dict(D,Acc) :- ...@@ -148,48 +134,43 @@ 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)
). ).
%ToDo: StatusCodes bei verschiedenen returns
clear_bg(Req) :- clear_bg(Req) :-
option(content_length(0),Req) option(content_length(0),Req)
-> action_reply_success(400, clear_bg, 'no change (is the body empty?)', Reply) -> 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)]), http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]),
catch( catch(
( (
(is_list(Dict) (is_list(Dict)
-> retract_list(Dict,Failed) -> retract_list(Dict,Failed)
; 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)
Failed==[] ; action_reply_success(200, clear_bg, 'some facts not existing, skipping', Reply)
-> 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).
% In: alle zu löschenden Dicts
% Out: alle nicht löschbaren Pfade
% retract_list(In, Out)
retract_list([], []). retract_list([], []).
retract_list([In|Ins],Outs) :- 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(Ins,Outs).
retract_list([In|Ins],[In|Outs]) :- retract_list([In|Ins],[In|Outs]) :-
retract_list(Ins,Outs). retract_list(Ins,Outs).
%%ToDo Merge mit State
get_bg(_Req) :-
get_all(_type,X),
reply_json(X).
state(get, _Req) :- state(get, _Req) :-
generic_reply(state, get, Reply), generic_reply(state, get, Reply),
reply_json(Reply). reply_json(Reply).
...@@ -251,6 +232,10 @@ handle_remove(Req) :- ...@@ -251,6 +232,10 @@ handle_remove(Req) :-
reply_json(Reply). reply_json(Reply).
http_stop :-
db_sync_all(gc),
http_stop_server(4444,[]).
/* Helpers */ /* Helpers */
occurs(Dict) :- theory_bg:item(_Abs_path,X), X = Dict, true. occurs(Dict) :- theory_bg:item(_Abs_path,X), X = Dict, true.
...@@ -265,19 +250,4 @@ getPath(Dict, Dict.abs_path). ...@@ -265,19 +250,4 @@ 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.
\ No newline at end of file
:- 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