image_annotation/commit

move thing from here to other packages

authorJacco van Ossenbruggen
Mon Apr 9 17:48:40 2012 +0200
committerJacco van Ossenbruggen
Mon Apr 9 17:48:40 2012 +0200
commit54e668c50f231d61b6b5ff163f7a91906487a74b
tree5a8b4f5e956ec5a015cd5da1d70a419e2b4220b3
parent07e35927727c752ffc7cd0cdc176a6d157405130
Diff style: patch stat
diff --git a/applications/annotation.pl b/applications/annotation.pl
index d2abe20..1acf6ec 100644
--- a/applications/annotation.pl
+++ b/applications/annotation.pl
@@ -23,7 +23,6 @@
 :- use_module(user(user_db)).
 :- use_module(library(graph_version)).
 :- use_module(api(annotation)).
-:- use_module(library(instance_search)).
 
 /***************************************************
 * http handlers
diff --git a/config-available/DEFAULTS b/config-available/DEFAULTS
index f956519..2715841 100644
--- a/config-available/DEFAULTS
+++ b/config-available/DEFAULTS
@@ -1,2 +1,3 @@
-config(image_annotation, link).
-config(load_rma_example, link).
+config(image_annotation,    link).
+config(load_rma_example,    link).
+config(enable_autocomplete, link).
diff --git a/config-available/enable_autocomplete.pl b/config-available/enable_autocomplete.pl
new file mode 100644
index 0000000..60ae626
--- /dev/null
+++ b/config-available/enable_autocomplete.pl
@@ -0,0 +1,2 @@
+:- module(conf_enable_ac, []).
+:- use_module(api(autocomplete_api)).
diff --git a/config-available/image_annotation.pl b/config-available/image_annotation.pl
index cb64607..f68d127 100644
--- a/config-available/image_annotation.pl
+++ b/config-available/image_annotation.pl
@@ -8,8 +8,6 @@
 % hack namespace
 :- rdf_register_ns(oac, 'http://www.openannotation.org/ns/').
 :- rdf_register_ns(an, 'http://semanticweb.cs.vu.nl/annotate/').
-:- rdf_register_ns(gv, 'http://semanticweb.cs.vu.nl/graph/version/').
-:- rdf_register_ns(prov, 'http://www.w3.org/ns/prov-o/').
+% :- rdf_register_ns(prov, 'http://www.w3.org/ns/prov-o/').
 
-:- use_module(library(skos_schema)).
 :- use_module(applications(annotation)).
diff --git a/lib/filter.pl b/lib/filter.pl
deleted file mode 100644
index 2f93b52..0000000
--- a/lib/filter.pl
+++ /dev/null
@@ -1,167 +0,0 @@
-:- module(filter,
-	  [ target_goal/3,            % +Goal, +R, +Options
-	    filter_to_goal/3	      % +FilterList, +R, -Goal
-	  ]).
-
-:- use_module(library('semweb/rdf_db')).
-:- use_module(library('semweb/rdfs')).
-:- use_module(library(semweb/rdf_label)).
-
-%:- use_module(serql(rdf_optimise)).
-
-:- use_module(library(debug)).
-:- use_module(library(error)).
-:- use_module(library(option)).
-:- use_module(library(pairs)).
-:- use_module(library(lists)).
-:- use_module(library(assoc)).
-:- use_module(library(settings)).
-:- use_module(library(http/json_convert)).
-:- use_module(library(http/json)).
-
-
-%%	target_goal(+Goal, +R, -URI)
-%
-%	Succeeds if R passes all Filters.
-
-target_goal(Goal, R, R) :-
-	Goal, !.
-
-%%	filter_to_goal(+Filter, +R, -Goal)
-%
-%	Goal is a prolog goal of Filter that succeeds if R passes all filters.
-%       Allowed filters:
-%
-%	    * keyword(Keyword)
-%	    * type(Class)
-%	    * prop(Prop, Value)
-%	    * reachable(Prop, TransitiveProp, Concept)
-%
-%	@see Options are described with rdfs_plus_skos/5
-
-filter_to_goal(Filter, R, Goal) :-
-	is_list(Filter), !,
-	(   Filter = []
-	->  Goal = true
-	;   filter_to_conj_goal(Filter, R, Goal)
-	).
-filter_to_goal(Filter, R, Goal) :-
-	filter(Filter, R, Goal).
-
-%%	filter_to_conj_goal(+FilterList, +R, -Goal)
-%
-%	Goal is conjuctive prolog goal for FilterList.
-
-filter_to_conj_goal([Filter], R, Goal) :- !,
-	filter(Filter, R, Goal).
-filter_to_conj_goal([Filter|T], R, (Goal,Rest)) :-
-	filter(Filter, R, Goal),
-	filter_to_conj_goal(T, R, Rest).
-
-%%	filter_to_conj_goal(+FilterList, +R, -Goal)
-%
-%	Goal is disjunctive prolog goal for FilterList.
-
-filter_to_disj_goal([Filter], R, Goal) :- !,
-	filter(Filter, R, Goal).
-filter_to_disj_goal([Filter|T], R, (Goal;Rest)) :-
-	filter(Filter, R, Goal),
-	filter_to_disj_goal(T, R, Rest).
-
-%%	filter(+Filter, -Goal, ?R)
-%
-%	Goal is a prolog goal that succeeds if R passes Filter.
-
-filter(or(Filter), R, Goal) :- !,
-	filter_to_disj_goal(Filter, R, Goal).
-filter(or(F1, F2), R, Goal) :- !,
-	Goal = (G1 ; G2),
-	filter_to_goal(F1, R, G1),
-	filter_to_goal(F2, R, G2).
-filter(type(Class), R, Goal) :- !,
-	(   rdf_equal(Class,rdfs:'Resource')
-	->  Goal = true
-	;   rdf_equal(Type, rdf:type),
-	    rdf_equal(SubClass, rdfs:subClassOf),
-	    Goal = ( rdf(R,Type,C),
-	             rdf_reachable(C,SubClass,Class)
-		   )
-	).
-filter(scheme(Scheme), R, Goal) :- !,
-	rdf_equal(P, skos:inScheme),
-	Goal = rdf(R, P, Scheme).
-filter(prop(P, V), R, Goal) :- !,
-	(   P = all
-	->  Goal = rdf_has(R, _, V)
-	;   Goal = rdf_has(R, P, V)
-	).
-filter(reachable(TransP, C), R,	Goal) :- !,
-	Goal = rdf_reachable(R, TransP, C, 4, _).
-filter(reachable(P, TransP, C), R, Goal) :- !,
-	Goal = ( rdf_has(R, P, V),
-		 rdf_reachable(V, TransP, C)
-	       ).
-filter(value(V), R, Goal) :- !,
-	Goal = rdf_has(R, _, V).
-filter(valueOfProp(P), R, Goal) :- !,
-	Goal = rdf_has(_, P, R).
-filter(valueOfProp(P, Filter), R, Goal) :- !,
-	Goal = ( rdf_has(S, P, R),
-		 Rest
-	       ),
-	filter_to_goal(Filter, S, Rest).
-filter(metadata(Class), R, Goal) :- !,
-	rdf_equal(Type, rdf:type),
-	rdf_equal(SubClass, rdfs:subClassOf),
-	Goal = (  rdf(R, Type, C),
-		  rdf_reachable(C, SubClass, Class)
-	       ;  rdf_has(S,_,R),
-		  rdf(S, Type, C),
-		  rdf_reachable(C, SubClass, Class)
-	       ).
-filter(metaclass(MetaClass), R, Goal) :- !,
-	rdf_equal(Type, rdf:type),
-	rdf_equal(SubClass, rdfs:subClassOf),
-	Goal = ( rdf(R, Type, C),
-		 rdf_reachable(C, SubClass, Class),
-		 rdf(Class, Type, MetaClass)
-		).
-filter(equal(R1), R, Goal) :- !,
-	Goal = rdf_equal(R1, R).
-filter(ns(Ns), R, Goal) :- !,
-	Goal = (   ground(R+Ns)
-	       ->  sub_atom(R, _, _, _, Ns)
-	       ;   rdf_url_namespace(R, Ns)
-	       ).
-filter(alias(Alias), R,	Goal) :- !,
-	Goal = rdf_global_id(Alias:_, R).
-filter(group(P, [Value]), R, Goal) :- !,
-	(	Value == other
-	->	Goal = (\+ rdf_has(R, P, Value, _))
-	;	Goal = iface_has(R, P, Value, _)
-	).
-filter(Filter, _, _) :-
-	domain_error(filter, Filter).
-
-
-http:convert_parameter(json_filter, Atom, Term) :-
-	atom_json_term(Atom, JSON, []),
-	json_to_prolog(JSON, Term).
-
-:- json_object
-    or(or:_),
-    type(type:atom),
-    scheme(scheme:atom),
-    metaclass(metaclass:atom),
-    metadata(metadata:atom),
-    metadataOf(metadataOf:atom),
-    prop(prop:atom, object:_),
-    prop(prop:atom, uri:atom),
-    prop(prop:atom),
-    value(object:atom),
-    valueOfProp(valueOfProp:atom),
-    reachable(reachable:atom, uri:atom),
-    reachable(prop:atom, reachable:atom, uri:atom),
-    literal(value:_) + [type=literal],
-    type(type:atom, literal:atom),
-    lang(lang:atom, literal:atom).
diff --git a/lib/instance_search.pl b/lib/instance_search.pl
deleted file mode 100644
index a9dab8b..0000000
--- a/lib/instance_search.pl
+++ /dev/null
@@ -1,243 +0,0 @@
-:- module(instance_search,
-	[ instance_search/3		% +Query, -Hits, +Options
-
-	]).
-
-:- use_module(library(http/http_dispatch)).
-:- use_module(library(http/http_parameters)).
-:- use_module(library(http/http_json)).
-:- use_module(library(http/json_convert)).
-
-:- use_module(library('semweb/rdf_db')).
-:- use_module(library('semweb/rdfs')).
-:- use_module(library('semweb/rdf_label')).
-:- use_module(library('semweb/rdf_litindex.pl')).
-
-:- use_module(library(find_resource)).
-:- use_module(library(filter)).
-
-/*
-:- use_module(serql(rdf_optimise)).
-:- use_module(util(rdf_find_by_name)).
-:- use_module(util(fuzzy)).
-
-:- use_module(util(rdfs_plus_skos)).
-:- use_module(util(owl_restrictions)).
-
-:- use_module(util(rdf_util)).
-:- use_module(util(util)).
-:- use_module(util(iface_util)).
-:- use_module(util(filter)).
-*/
-
-:- rdf_meta
-	all_literal_propvalues(r, r, -).
-
-:- http_handler(api(autocomplete), http_autocomplete, [js(true)]).
-
-http_autocomplete(Request) :-
-	http_parameters(Request,
-			[q(Query,
-			   []),
-			 limit(Limit,
-			       [default(10)]),
-			 offset(Offset,
-				[default(0)]),
-			 method(Method,
-				[one_of([prefix,stem,exact]),
-				 default(prefix),
-				 description('String matching method')
-				]),
-			 filter(Filter,
-				[json_filter,
-				 default([]),
-				 description('JSON object specifying a restriction on the results')])
-			]),
-	Options = [match(Method),
-		   filter(Filter)],
-	instance_search(Query, Hits0, Options),
-	length(Hits0, TotalNumberOfResults),
-	list_offset(Hits0, Offset, Hits1),
-	list_limit(Hits1, Limit, Hits2, _),
-        maplist(ac_expand_hit, Hits2,Hits),
-	prolog_to_json(Hits, JSON),
-	reply_json(json([totalNumberOfResults(TotalNumberOfResults),
-			 results(JSON)])).
-
-:- json_object
-	hit(uri:uri, property:atom, label:atom, info:_).
-
-
-/***************************************************
-* term search
-***************************************************/
-
-%%	instance_search(+Query, -Hits:hit(uri,property,label,info), +Options)
-%
-%	Hits contains all resources matching Query.
-%	Options are
-%		match = prefix;stem;exact
-%		filter =
-%		compound = boolean
-%		property = [property-score]
-%		shortQueriesOptimized = integer
-%		treeRemove = false;relation
-
-
-instance_search(Query, Hits, Options) :-
-	option(property(Property), Options, []),
-	label_list(Property, LabelList),
-	find_resources(Query, LabelList, Hits, Options).
-
-
-/***************************************************
-* literal matching
-***************************************************/
-
-%%	label_list(+Property, -LabelList)
-%
-%	LabelList is a list of Pairs with an rdf property
-%	score. Lower score gets preference.
-
-label_list([], LabelList) :- !,
-	rdf_equal(rdfs:label, Label),
-	rdf_equal(skos:prefLabel, PrefLabel),
-	LabelList = [
-		PrefLabel-0,
-		Label-1
-	].
-label_list(Property, LabelList) :-
-	atom(Property), !,
-	LabelList = [Property-0].
-label_list(List, LabelList) :-
-    is_list(List),
-    format_label_list(List, 0, LabelList),
-    !.
-label_list(List,_) :-
-	 type_error(labellist,  List).
-
-format_label_list([], _, []).
-format_label_list([H|T], N0, [P-N|Rest]) :-
-	N1 is N0+0.1,
-	(   atom(H)
-	->  N = N0,
-	    P = H
-	;   H = P-N,
-	    number(N)
-	->  true
-	;   H = pair(P,N)
-	->  true
-	),
-	format_label_list(T, N1, Rest).
-
-
-%%	find_resources(+Query, +LabelList, -Hits, Options)
-%
-%	Hits contains uris with prefix matching label.
-
-find_resources(Query, LabelList, Hits, Options0) :-
-	Options = [distance(false),attributes(LabelList)|Options0],
-	find_resource_by_name(Query, Hits0, Options),
-	maplist(ac_hit, Hits0, Hits1),
-	filter(Hits1, Hits, Options0).
-
-ac_hit(hit(_D,U,P,L), hit(U,P,L,[])).
-
-/***************************************************
-* expand with extra display info
-***************************************************/
-
-ac_expand_hit(hit(R,P,L,[]),
-	      hit(R,P,L,json([altLabels=Labels,
-			      scopeNotes=ScopeNotes,
-			      definitions=Definitions,
-			      broader=Broader,
-			      narrower=Narrower,
-			      related=Related
-			     ]))) :-
-	all_labels(R,Labels),
-	findall(B, rdf_has(R, skos:broader,  B), Broader),
-	findall(N, rdf_has(R, skos:narrower, N), Narrower),
-	findall(Rl,rdf_has(R, skos:related, Rl), Related),
-
-	all_literal_propvalues(R, skos:scopeNote, ScopeNotes),
-	all_literal_propvalues(R, skos:definition, Definitions).
-
-
-% Fix me: need to take care of preferred languages here
-all_literal_propvalues(R,P,Definitions) :-
-	findall(Definition,
-		(   rdf_has(R, P, DefLit),
-		    literal_text(DefLit,Definition)
-		), Definitions).
-
-
-all_labels(R,Labels) :-
-	findall(AltLabel, (rdf_label(R,Lit),
-			   literal_text(Lit, AltLabel)
-			  ),
-		Labels0),
-	sort(Labels0,Labels).
-
-
-/***************************************************
-* filtering
-***************************************************/
-
-%%	filter(+Hits, -Filtered, +Options)
-%
-%	Fitered contains only those hits that
-%	satisfy the Filter from Options.
-
-filter(Hits0, Hits1, Options) :-
-	(	option(filter(Filter), Options),
-		Filter \== []
-	->	filter_hits(Hits0, Filter, Hits1)
-	;	Hits1 = Hits0
-	).
-filter(Hits, Hits, _Options).
-
-
-filter_hits([], _, []) :- !.
-filter_hits(HitsIn, Filter, HitsOut) :-
-	filter_to_goal(Filter, R, Goal),
-	findall(Hit, (member(Hit, HitsIn),
-		      Hit = hit(R,_,_,_),
-		      once(Goal)),
-		HitsOut).
-
-
-%%	list_offset(+List, +N, -SmallerList)
-%
-%	SmallerList starts at the nth element of List.
-
-list_offset(L, N, []) :-
-	length(L, Length),
-	Length < N,
-	!.
-list_offset(L, N, L1) :-
-	list_offset_(L, N, L1).
-
-list_offset_(L, 0, L) :- !.
-list_offset_([_|T], N, Rest) :-
-	N1 is N-1,
-	list_offset_(T, N1, Rest).
-
-%%	list_limit(+List, +N, -SmallerList, -Rest)
-%
-%	SmallerList ends at the nth element of List.
-
-list_limit(L, N, L, []) :-
-	N < 0,
-	!.
-list_limit(L, N, L, []) :-
-	length(L, Length),
-	Length < N,
-	!.
-list_limit(L, N, L1, Rest) :-
-	list_limit_(L, N, L1, Rest).
-
-list_limit_(Rest, 0, [], Rest) :- !.
-list_limit_([H|T], N, [H|T1], Rest) :-
-	N1 is N-1,
-	list_limit_(T, N1, T1, Rest).