Commit 174359a1 authored by Siebers, Michael's avatar Siebers, Michael
Browse files

Merge branch 'explanation_integration' into 'master'

Integration of explanation framework

Closes #11 and #12

See merge request cogsys/dare2del/demonstrator!3
parents 8852cf87 a7bf59b4
test_theory_common:
# Template for Prolog test jobs
.prolog_test:
image: swipl:8.2.2
stage: test
variables:
REPORT_PATH: report_irrelevance_common
script:
- swipl -s irrelevance_common.plt -t 'show_coverage(run_tests,[user])' > "$REPORT_PATH"
- swipl -s "tests/${TEST_FILE}" -t "show_coverage(run_tests,[${TEST_MODULE}])" > "${REPORT_PATH}"
timeout: 5m
artifacts:
paths:
- "$REPORT_PATH"
expire_in: 1 week
expire_in: 3 days
test_theory_common:
extends: .prolog_test
variables:
TEST_FILE: irrelevance_common.plt
TEST_MODULE: user
REPORT_PATH: coverage_irrelevance_common
test_web_api:
extends: .prolog_test
variables:
TEST_FILE: web_api.plt
TEST_MODULE: web_api
REPORT_PATH: coverage_web_api
......@@ -28,7 +28,9 @@
% An entity property reference is a term ref(ReferenceID,ListOfEntity),
% where each Entity is given as term entity(NameOfEntity,NameOfProperty).
%
% @throws fails(Atom) if Atom cannot be proven
explain(Atom, Message, Details, References) :-
( call(Atom) -> true; throw(fails(Atom))),
clause(Atom,Body), call(Body),
explain_message((Atom :- Body), Message, 0, No1, [], References1),
explain_details((Atom :- Body), Details, No1, _No2, References1, References).
......@@ -40,7 +42,7 @@ explain(Atom, Message, Details, References) :-
% clause was proven to hold. A list of entity references References (see
% explain/4) is generated for and used within the message.
explain_message(_Clause,
"Some message I have no idea how to generate",
["Some message I have no idea how to generate"],
No, No, [], []).
% explain_details(+Clause, -Details, +NoIn, -NoOut, +ReferencesIn, -ReferencesOut)
......
%! do_handle_explain(++Parameters:dict, --Result:list, --More:atom) is det
%
% Generates textual explanations for the irrelevance of a file. Parameters may
% contain the following keys:
% - abs_path (required, atom): The absolute path of the file which's
% irrelevance shall be explained
% - limit (optional, integer, default: 5): The maximal number of explanations
% to create.
%
% The Result is a list of explanation(AbsPath,Message,Details,References) terms.
% The list might be empty. In these terms AbsPath is bound to the absolute path
% of the item which's irrelevance is explained. Message is a list which's
% elements are either strings or a term reference(DescribingString,ReferenceID).
% Details is a list of Message-type lists. Finally, References is a list of
% ref(ReferenceID,ListOfEntity) terms where each Entity is given as term
% entity(NameOfEntity,NameOfProperty). NameOfEntity and NameOfProperty are
% either atom or a string. If there are more explanations available than there
% are in Result, More is bound to 'true'. Otherwise, More is bound to 'false'.
%
% @throws not_irrelevant(AbsPath) If the provided absolut path denotes a file
% which is not irrelevant. Then, by definition, no explanation may be
% created.
% @error type_error(dict, Parameters) if Parameters is no dict
% @error existence_error(key, Key, Parameters) if Parameters does not contain
% the required key Key
% @error instantiation_error if dict is unbound
% @error key_instantiation_error(abs_path) if the dict value under abs_path is unbound
% @error uninstantiation_error(Result|More) if Result or More are bound
% @error key_type_error(KeyName, Type, Value) if the dict value Value under
% KeyName is of a wrong type,
% expected Type
% @error unknown_key(KeyName, Dict) if the dict contains an unknown key KeyName
% @error implementation_error(Cause) if generating the explanation itself throws
% an exception
do_handle_explain(Parameters, Result, More) :-
( get_dict_typed(abs_path, Parameters, atom, AbsPath) % might throw error
-> true
; existence_error(key, abs_path, Parameters)
),
once(( get_dict_typed(limit, Parameters, integer, Limit)
; Limit = 5
)),
( get_dict(Key,Parameters,_),
\+ member(Key, [abs_path, limit])
-> throw(error(unknown_key(Key,Parameters),_))
; true
),
( var(Result)
-> true
; uninstantiation_error(Result)
),
( var(More)
-> true
; uninstantiation_error(More)
),
catch(
do_handle_explain_(AbsPath, Limit, Result, More),
E,
( E=fails(irrelevant(Path))
-> throw(not_irrelevant(Path))
; throw(error(implementation_error(E),_))
)
).
do_handle_explain_(AbsPath, Limit, Result, More) :-
findnsols(Limit,
explanation(AbsPath,Message, Details, References),
explanations:explain(irrelevant(AbsPath), Message, Details, References),
Result),
deterministic(LastAnswer),
( LastAnswer==true % other responses are not explicitly documented
-> More=false
; More=true
), !.
%! exception_to_handler_exception(+ExplainException, --HandlerException)
%
% Translates exceptions from do_handle_explain/3 to bad_request/1 and
% server_error/2 terms thrown by handle_explain/1.
%
% @see do_handle_explain/3 for the actual errors thrown
% @see handle_explain/1 for the resulting handler errors
exception_to_handler_exception(not_irrelevant(AbsPath),
bad_request(not_irrelevant(AbsPath))).
exception_to_handler_exception(
error(type_error(dict, Dict), Context),
server_error(type_error(dict, Dict), Context)).
exception_to_handler_exception(
error(existence_error(key, Key, _Parameters),_),
bad_request(missing_key(Key))).
exception_to_handler_exception(
error(instantiation_error,Context),
server_error(instantiation_error,Context)).
exception_to_handler_exception(
error(key_instantiation_error(KeyName, Type, Value),Context),
server_error(key_instantiation_error(KeyName, Type, Value),Context)).
exception_to_handler_exception(
error(uninstantiation_error(Argument),Context),
server_error(uninstantiation_error(Argument),Context)).
exception_to_handler_exception(
error(key_type_error(KeyName, Type, _Value),_),
bad_request(wrong_type(KeyName, Type))).
exception_to_handler_exception(
error(unknown_key(KeyName, _Parameters),_),
bad_request(unknown_key(KeyName))).
exception_to_handler_exception(
error(implementation_error(Cause),Context),
server_error(implementation_error(Cause),Context)).
exception_to_handler_exception(
error(E,Context),
server_error(unexpected_error(E),Context)).
%! explanation_to_json(++Explanation, --JSON) is det
%
% Transforms an explanation to a term suitable to be transformed into a JSON
% string. The sub-transformations of the explanation message and details are
% carried out by message_to_json/2. The references are transformed by
% reference_to_json/2.
%
% @see do_handle_explain/3 for the expected format of Explanation
% @error instantiation_error if Explanation or any part of it is unbound
% @error type_error(Type,Part) if Explanation or any Part of it has not the
% expected type
% @error uninstantiation_error(Part) if (part of) JSON is instantiated and
% cannot be unified with the correct answer.
explanation_to_json(explanation(AbsPath,Message,Details,References),
JSONDict) :-
text_to_string(AbsPath,AbsPathStr),
message_to_json(Message, MessageJSON),
must_be(list,Details),
maplist(message_to_json,Details, DetailsJSON),
reference_to_json(References, ReferencesJSON),
( JSONDict = explanation{
abs_path: AbsPathStr,
reasoning: MessageJSON,
reasoning_details: DetailsJSON,
references: ReferencesJSON
}
-> true
; uninstantiation_error(JSONDict)
), !.
explanation_to_json(Explanation,_JSON) :-
type_error(explanation(_,_,_,_),Explanation).
/*
reference_to_json_(ref(RefId,ListOfEntities), JSONDict) :-
must_be(integer,RefId),
must_be(list, ListOfEntities),
maplist(entity_to_json, ListOfEntities, JSONEntities),
( JSONDict = reference{id: RefId, referenced_entities: JSONEntities}
-> true
; uninstantiation_error(JSONDict)
),
!.
reference_to_json_(Reference,_JSON) :-
type_error(ref(_,_), Reference).
*/
%! message_to_json(++Message:list, --JSON) is det
%
% Transforms an explanation (detailed) message to a term suitable to be
% transformed into a JSON string.
%
% @see do_handle_explain/3 for the expected format of Message
% @error instantiation_error if Message or any part of it is unbound
% @error type_error(Type,Part) if Message or any Part of it has not the expected
% type
% @error uninstantiation_error(Part) if (part of) JSON is instantiated and
% cannot be unified with the correct answer.
message_to_json(Message, JSON) :-
must_be(list, Message),
maplist(message_to_json_, Message, JSONTrue),
( JSON=JSONTrue
-> true
; uninstantiation_error(JSON)
).
message_to_json_(reference(M,Ref), JSON) :-
text_to_string(M, MStr),
must_be(integer, Ref),
dict_create(J, message, [text=MStr, ref_id=Ref]),
( JSON = J
-> true
; uninstantiation_error(JSON)
),
!.
message_to_json_(M, JSON) :-
text_to_string(M, MStr),
dict_create(J, message, [text=MStr]),
( JSON = J
-> true
; uninstantiation_error(JSON)
).
%! reference_to_json(++References:list, --JSON) is det
%
% Transforms explanation references to a term suitable to be
% transformed into a JSON string.
%
% @see do_handle_explain/3 for the expected format of References
% @error instantiation_error if References or any part of it is unbound
% @error type_error(Type,Part) if References or any Part of it has not the expected type
% @error domain_error(non_empty_list,[]) if any reference has an empty list of entities.
% @error uninstantiation_error(Part) if (part of) JSON is instantiated and cannot be
% unified with the correct answer.
reference_to_json(References, JSON) :-
must_be(list, References),
maplist(reference_to_json_, References, JSONTrue),
( JSON=JSONTrue
-> true
; uninstantiation_error(JSON)
).
reference_to_json_(ref(RefId,ListOfEntities), JSONDict) :-
must_be(integer,RefId),
must_be(list, ListOfEntities),
maplist(entity_to_json, ListOfEntities, JSONEntities),
( JSONDict = reference{id: RefId, referenced_entities: JSONEntities}
-> true
; uninstantiation_error(JSONDict)
),
!.
reference_to_json_(Reference,_JSON) :-
type_error(ref(_,_), Reference).
%! entity_to_json(entity(++Path, ++Property), -JSON:dict) is det
entity_to_json(entity(Path, Property),
entity{abs_path: PathStr, property: PropertyStr}) :-
text_to_string(Path, PathStr),
text_to_string(Property, PropertyStr),
!.
entity_to_json(Entity,JSON) :-
( var(JSON)
-> type_error(entity(_,_), Entity)
; uninstantiation_error(JSON)
).
%! do_handle_irrelevant_file(+Parameters:dict, -AbsPath:atom) is semidet.
%
% True if the item associated with the absolute path given in Parameters
% is irrelevant. The absolute path is accessed using the dict key abs_path.
% An error is thrown if the dict does not contain this key, if its value
% is not an atom or if the dict contains any other key.
%
% @error instantiation_error if Parameters is unbound
% @error type_error(dict, Dict) if Dict is no dict
% @error existence_error(key, abs_path, Dict) if Dict does not contain the
% key abs_path
% @error key_instantiation_error(abs_path) if the dict value under abs_path is unbound
% @error key_type_error(abs_path, atom, AbsPath) if the dict value AbsPath under
% the key abs_path is not an atom
% @error unknown_key(KeyName, Dict) if the dict contains any KeyName which is
% not abs_path
% @error implementation_error(Cause) if checking the irrelevance itself throws
% an error (Cause)
do_handle_irrelevant_file(Parameters,AbsPath) :-
(
get_dict_typed(abs_path, Parameters, atom, AbsPath)
-> true
; existence_error(key, abs_path, Parameters)
),
( (get_dict(Key,Parameters,_), Key\= abs_path )
-> throw(error(unknown_key(Key,Parameters),_))
; true
),
catch(user:irrelevant(AbsPath),
E,
throw(error(implementation_error(E),_))
).
......@@ -27,12 +27,20 @@ in_directory(Item, Directory) :-
ItemPath \= '/', % Per POSIX definition '/' is in path '/'.
% we however want the true parent path which
% doesn't exist in this case
file_directory_name(ItemPath, DirPath),
DirPath \= '.', % Per POSIX '.' is the (topmost) parent path
% of a relative path. However, we want the true
% parent path which doesn't exist in this case.
in_directory_(ItemPath, DirPath),
abs_path(Directory, DirPath).
%! in_directory_(++AbsPath:atom, -Directory:atom)
% Extracts the parent directory name from an absolute PathName.
in_directory_(AbsPath, Dir) :-
AbsPath \= '/',
atom_string(AbsPath, PathStr),
re_matchsub("^(.*)/([^/]*)$", PathStr, Matches, []),
( Matches.1 = ""
-> Dir = '/'
; atom_string(Dir,Matches.1)
).
%! in_directory_recursive(++Item,?Directory) is nondet.
in_directory_recursive(Item,Directory) :- in_directory(Item,Directory).
in_directory_recursive(Item,Directory) :- in_directory(Item,DirectoryInter), in_directory_recursive(DirectoryInter,Directory).
......
......@@ -66,9 +66,7 @@ test(directory_findall, [true(Fs == TrueFs), setup(findall(TF, theory_bg:directo
% in_directory(++Item,+Directory) is semidet.
% in_directory(++Item,-Directory) is semidet.
test(in_directory_bound, forall(theory_bg:in_directory(TrueItemId,TrueDirectory))) :-
in_directory(TrueItemId, TrueDirectory).
test(in_directory_semibound, forall(theory_bg:in_directory(TrueItemId,TrueDirectory))) :-
in_directory(TrueItemId, Directory), Directory==TrueDirectory.
first_bound(in_directory/2,[TrueItemId, TrueDirectory]).
test(in_directory_false, [forall(theory_bg:in_directory_false(ItemId,DirectoryId)), fail]) :-
in_directory(ItemId,DirectoryId).
......
:- use_module(web_api).
/*************************************
* *
* Helpers generating correct values *
* *
*************************************/
%! type_is(?Type, -Value) is nondet
% Generates several Value's of type Type, If Type is unbound it is sequentially bound to
% the types atom, integer, string, chars, codes, text, and dict.
type_is(atom, Value) :- member(Value, [a, some_atom, 'an atom with spaces']).
type_is(integer, Value) :- member(Value, [-100, 0, 1, 5, 1000000000]).
type_is(string, Value) :- member(Value, ["some", "random strings", ""]).
type_is(chars, Value) :- type_is(atom, ValueAtom), atom_chars(ValueAtom, Value).
type_is(chars, Value) :- type_is(string, ValueStr), string_chars(ValueStr, Value).
type_is(codes, Value) :- type_is(atom, ValueAtom), atom_codes(ValueAtom, Value).
type_is(codes, Value) :- type_is(string, ValueStr), string_codes(ValueStr, Value).
type_is(text, Value) :-
type_is(atom, Value)
; type_is(string, Value)
; type_is(codes, Value)
; type_is(chars, Value).
type_is(dict, Value) :- between(0,2,N), type_is(dict, N, Value).
type_is(X, Value) :- X==dict_value, !,
(type_is(atom, Value)
; type_is(integer, Value)
).
type_is(dict, 0, _{}).
type_is(dict, 0, _{key: Value}) :- type_is(dict_value, Value).
type_is(dict, 0, _{key1: Value1, key2: Value2}) :-
type_is(dict_value, Value1),
type_is(dict_value, Value2).
type_is(dict, 1, _{key: Value}) :-
findall(V, type_is(dict, 0, V), Vs),
length(Vs, NVs),
randset(3, NVs, ValueIndices),
member(Pos, ValueIndices),
nth1(Pos, Vs, Value).
type_is(dict, 1, _{key1: Value1, key2: Value2}) :-
findall(V, type_is(dict, 0, V), Vs),
length(Vs, NVs),
randset(3, NVs, ValueIndices1),
member(Pos1, ValueIndices1),
nth1(Pos1, Vs, Value1),
randset(3, NVs, ValueIndices2),
member(Pos2, ValueIndices2),
nth1(Pos2, Vs, Value2).
type_is(dict, 2, _{key: Value}) :-
findall(V, type_is(dict, 1, V), Vs),
length(Vs, NVs),
randset(3, NVs, ValueIndices),
member(Pos, ValueIndices),
nth1(Pos, Vs, Value).
type_is(dict, 2, _{key1: Value1, key2: Value2}) :-
findall(V, type_is(dict, 1, V), Vs1),
findall(V, type_is(dict, 0, V), V0s),
append(V0s, Vs1, Vs2),
length(Vs1, NVs1),
randset(3, NVs1, ValueIndices1),
member(Pos1, ValueIndices1),
nth1(Pos1, Vs1, Value1),
length(Vs2, NVs2),
randset(10, NVs2, ValueIndices2),
member(Pos2, ValueIndices2),
nth1(Pos2, Vs2, Value2).
/***************************************
* *
* Helpers generating erroneous values *
* *
***************************************/
type_not(atom, Value) :- member(Value, [1, "test", 7.3, some(term)]).
type_not(dict, Value) :- member(Value, [
1,
test,
"test",
7.3,
some(term),
[key=value],
[key: value]
]).
type_not(integer, Value) :- member(Value, [
an_atom,
"test",
1.0,
7.3,
some(term),
["test"]
]).
type_not(list, Value) :- type_not_term('[|]'/2, Value).
type_not(text, Value) :- member(Value, [1, 7.3, some(term), ["test"]]).
type_not(term(_),Value) :- member(Value, [1, "test", test, 7.3]).
type_not(term(P/A), ["test"]) :- P/A \= '[|]'/2.
type_not(term(P/A), some(term)) :- P/A \= some/1.
type_not(term(P/A), Value) :-
succ(TooFew, A),
between(1,TooFew,N),
functor(Value,P,N),
numbervars(Value,0,_).
type_not(term(P/A), Value) :-
succ(A,TooMany),
functor(Value,P,TooMany),
numbervars(Value,0,_).
type_not_atom(Value) :- type_not(atom, Value).
type_not_dict(Value) :- type_not(dict, Value).
type_not_integer(Value) :- type_not(integer, Value).
type_not_list(Value) :- type_not(list, Value).
type_not_text(Value) :- type_not(text, Value).
type_not_term(P/A, Value) :- type_not(term(P/A), Value).
:- prolog_load_context(directory, Dir),
path_segments_atom(Dir/web_api/'*.plt',WebApiFiles),
load_files(WebApiFiles,[expand(true)]).
This diff is collapsed.
:- use_module(web_api).
/**************************************
* *
* web_api -> irrelevance integration *
* *
**************************************/
:- begin_tests('web_api -> helpers').
/********************
* text_so_string/2 *
********************/
% text_to_string(Text, String) succeeds with correct
% result if Text is a string
test(text_to_string_happy_string,
[
forall(member(Text,["these", "are",
"some", "valid texts", "given as string"])),
true(String == Text)
]) :-
web_api:text_to_string(Text,String).
% text_to_string(Text, String) succeeds with correct
% result if Text is a atom
test(text_to_string_happy_atom,
[
forall(member(Text/Expected,
[
these/"these",
are/"are",
some/"some",
'valid texts'/"valid texts",
'given as atom'/"given as atom"])),
true(String == Expected)
]) :-
web_api:text_to_string(Text,String).
% text_to_string(Text, String) succeeds with correct
% result if Text is a list of chars
test(text_to_string_happy_chars,
[
forall(member(Text/Expected,
[
[t,h,e,s,e]/"these",
[a,r,e]/"are",
[s,o,m,e]/"some",
[v,a,l,i,d,' ',t,e,x,t,s]/
"valid texts",
[g,i,v,e,n,' ',a,s,' ',c,h,a,r,s]/
"given as chars"])),
true(String == Expected)
]) :-
web_api:text_to_string(Text,String).
% text_to_string(Text, String) succeeds with correct
% result if Text is a list of character codes
test(text_to_string_happy_codes,
[
forall(member(Text/Expected,
[
[116,104,101,115,101]/"these",
[97,114,101]/"are",
[115,111,109,101]/"some",
[118,97,108,105,100,32,116,101,
120,116,115]/"valid texts",
[103,105,118,101,110,32,97,115,
32,99,111,100,101,115]/
"given as codes"])),
true(String == Expected)
]) :-
web_api:text_to_string(Text,String).
% text_to_string(Text, String) throws a uninstantiated
% if Text is unbound.
test(text_to_string_uninstantiated,
[
error(instantiation_error)
]) :-
web_api:text_to_string(_Text,_String).
% text_to_string(Text, String) throws a type_error(text,Text)
% if Text is neither a string, an atom, a list of chars, or
% a list of codes.
test(text_to_string_type,
[
forall(member(Text, [1,2,3.4,a(b),["text"]])),
error(type_error(text,Text))
]) :-
web_api:text_to_string(Text,_String).
/********************
* get_dict_typed/4 *
********************/
% get_dict_typed(+Key, +Dict, +Type, -Value) succeeds with the correct value on
% correct input
test(get_dict_typed_happy,
[ forall((
type_is(dict, RandomDict),
type_is(atom, Key),
type_is(Type, ExpectedValue),
false
)),
blocked(takes_too_long),
true(ExpectedValue =@= ActualValue)
]) :-
Dict = RandomDict.put([Key=ExpectedValue]),
web_api:get_dict_typed(Key, Dict, Type, ActualValue).
% get_dict_typed(+Key, +Dict, +Type, -Value) throws instantiation_error if Dict,
% Key, or Type is unbound.
test(get_dict_typed_instantiation_Dict,
[ error(instantiation_error)
]) :-
web_api:get_dict_typed(some_key, _, some_type, _ActualValue).
test(get_dict_typed_instantiation_Key,
[ error(instantiation_error)
]) :-
web_api:get_dict_typed(_Key, _{some_key: some_value}, some_type, _ActualValue).
test(get_dict_typed_instantiation_Type,
[ error(instantiation_error)
]) :-
web_api:get_dict_typed(some_key, _{some_key: some_value}, _, _ActualValue).
% get_dict_typed(+Key, +Dict, +Type, -Value) throws type_error(dict, Dict) if
% Dict is no dict.
test(get_dict_typed_type_Dict,
[ forall(type_not_dict(NoDict)),
error(type_error(dict, NoDict))
]) :-
web_api:get_dict_typed(some_key, NoDict, some_type, _ActualValue).