Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cogsys
Dare2Del
Demonstrator - Reasoning WebAPI
Commits
488776bf
Commit
488776bf
authored
Nov 13, 2020
by
Sebastian Seufert
Browse files
Exception messages in clear_bg
parent
6500a90e
Changes
2
Hide whitespace changes
Inline
Side-by-side
include/common/api_response.pl
View file @
488776bf
...
...
@@ -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-
t
ype: text/plain~n~n'
),
format
(
'Content-
T
ype: 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
web_api.pl
View file @
488776bf
...
...
@@ -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
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment