35
36:- module(cpa_browse,
37 [ graph_info//1, 38 graph_as_resource//2, 39 graph_actions//1, 40 list_resource//2, 41 context_graph//2 42 ]). 43:- use_module(library(http/http_dispatch)). 44:- use_module(library(http/http_parameters)). 45:- use_module(library(http/html_write)). 46:- use_module(library(http/js_write)). 47:- use_module(library(http/html_head)). 48:- use_module(library(http/http_wrapper)). 49:- use_module(library(http/yui_resources)). 50:- use_module(library(http/http_path)). 51:- use_module(library(http/cp_jquery)). 52
53:- use_module(library(semweb/rdf_db)). 54:- use_module(library(semweb/rdfs)). 55:- use_module(library(semweb/rdf_litindex)). 56:- use_module(library(semweb/rdf_persistency)). 57
58:- use_module(library(aggregate)). 59:- use_module(library(lists)). 60:- use_module(library(pairs)). 61:- use_module(library(debug)). 62:- use_module(library(option)). 63:- use_module(library(apply)). 64:- use_module(library(settings)). 65
66:- use_module(components(label)). 67:- use_module(components(simple_search)). 68:- use_module(components(graphviz)). 69:- use_module(components(basics)). 70:- use_module(api(lod_crawler)). 71:- use_module(api(sesame)). 72:- use_module(library(semweb/rdf_abstract)). 73:- use_module(library(semweb/rdf_label)). 74
75:- use_module(user(user_db)). 76
77
91
92 95
96:- http_handler(rdf_browser(.),
97 http_404([index(list_graphs)]),
98 [spawn(cliopatria), prefix]). 99:- http_handler(rdf_browser(list_graphs), list_graphs, []). 100:- http_handler(rdf_browser(list_graph), list_graph, []). 101:- http_handler(rdf_browser(list_classes), list_classes, []). 102:- http_handler(rdf_browser(list_instances), list_instances, []). 103:- http_handler(rdf_browser(list_predicates), list_predicates, []). 104:- http_handler(rdf_browser(list_predicate_resources),
105 list_predicate_resources, []). 106:- http_handler(rdf_browser(list_resource), list_resource, []). 107:- http_handler(rdf_browser(list_triples), list_triples, []). 108:- http_handler(rdf_browser(list_triples_with_object),
109 list_triples_with_object, []). 110:- http_handler(rdf_browser(list_triples_with_literal),
111 list_triples_with_literal, []). 112
113:- http_handler(rdf_browser(list_prefixes), list_prefixes, []). 114:- http_handler(rdf_browser(search), search, []). 115:- http_handler(rdf_browser(multigraph_action), multigraph_action,
116 [ time_limit(infinite) ]). 117
118
119:- meta_predicate
120 table_rows(3, +, ?, ?),
121 table_rows_top_bottom(3, +, +, +, ?, ?),
122 html_property_table(?, 0, ?, ?). 123
128
129list_graphs(_Request) :-
130 findall(Count-Graph,
131 ( rdf_graph(Graph),
132 graph_triples(Graph, Count)
133 ),
134 Pairs),
135 keysort(Pairs, Sorted),
136 pairs_values(Sorted, UpCount),
137 reverse(UpCount, DownCount),
138 append(DownCount, [virtual(total)], Rows),
139 reply_html_page(cliopatria(default),
140 title('RDF Graphs'),
141 [ h1('Named graphs in the RDF store'),
142 \warn_volatile,
143 \graph_table(Rows, [])
144 ]).
145
146:- if(current_predicate(rdf_persistency_property/1)). 147warn_volatile -->
148 { rdf_persistency_property(access(read_only)),
149 !,
150 rdf_persistency_property(directory(Dir))
151 },
152 html(div(class(msg_warning),
153 [ 'WARNING: The persistent store ', code(Dir), ' was loaded in ',
154 b('read-only'), ' mode. All changes will be lost when ',
155 'the server is stopped.'
156 ])).
157:- endif. 158warn_volatile --> [].
159
160:- if((rdf_version(V),V>=30000)). 161graph_triples(Graph, Count) :-
162 rdf_statistics(triples_by_graph(Graph, Count)).
163:- else. 164graph_triples(Graph, Count) :- 165 rdf_statistics(triples_by_file(Graph, Count)).
166:- endif. 167
168graph_table(Graphs, Options) -->
169 { option(top_max(TopMax), Options, 500),
170 option(top_max(BottomMax), Options, 500),
171 http_link_to_id(multigraph_action, [], Action),
172 graph_actions(Options, ActionOptions)
173 },
174 html_requires(css('rdf.css')),
175 html(form([ action(Action),
176 class('graph-table')
177 ],
178 [ table(class(block),
179 [ \graph_table_header
180 | \table_rows_top_bottom(
181 graph_row(ActionOptions), Graphs,
182 TopMax, BottomMax)
183 ]),
184 \multigraph_actions(ActionOptions)
185 ])),
186 mgraph_action_script.
187
-->
189 html(tr([ th('RDF Graph'),
190 th('Triples'),
191 th('Modified'),
192 th('Persistency')
193 ])).
194
195graph_row(_, virtual(total)) -->
196 !,
197 { rdf_statistics(triples(Count))
198 },
199 html([ th(class(total), 'Total #triples:'),
200 \nc('~D', Count, [class(total)]),
201 td([],[]), 202 td([],[]) 203 ]).
204graph_row(Options, Graph) -->
205 { graph_triples(Graph, Count)
206
207 },
208 html([ td(\graph_link(Graph)),
209 \nc('~D', Count),
210 \modified(Graph),
211 td(style('text-align:center'), \persistency(Graph)),
212 \graph_checkbox(Graph, Options)
213 ]).
214
215modified(Graph) -->
216 { rdf_graph_property(Graph, source_last_modified(Time)),
217 format_time(string(Modified), '%+', Time), !
218 },
219 html(td([class('file-time')], Modified)).
220modified(Graph) -->
221 { rdf_journal_file(Graph, File),
222 time_file(File, Time),
223 format_time(string(Modified), '%+', Time)
224 },
225 html(td([class('file-time')], Modified)).
226modified(_Graph) -->
227 html(td([class('file-time')], '')).
228
229graph_link(Graph) -->
230 { http_link_to_id(list_graph, [graph=Graph], URI)
231 },
232 html(a(href(URI), Graph)).
233
234persistency(Graph) -->
235 { rdf_graph_property(Graph, persistent(true)) },
236 !,
237 snapshot(Graph),
238 journal(Graph).
239persistency(_) -->
240 { http_absolute_location(icons('volatile.png'), Img, [])
241 },
242 html(img([ class('in-text'),
243 title('Graph is not persistent'),
244 src(Img)
245 ])).
246
247snapshot(Graph) -->
248 { rdf_snapshot_file(Graph, _),
249 http_absolute_location(icons('snapshot.png'), Img, [])
250 },
251 html(img([ class('in-text'),
252 title('Graph has persistent snapshot'),
253 src(Img)
254 ])).
255snapshot(_) --> [].
256
257journal(Graph) -->
258 { rdf_journal_file(Graph, _),
259 http_absolute_location(icons('journal.png'), Img, [])
260 },
261 html(img([ class('in-text'),
262 title('Graph has a journal'),
263 src(Img)
264 ])).
265journal(_) --> [].
266
271
272graph_actions(Options, [show_actions(true)|Options]) :-
273 logged_on(User),
274 !,
275 catch(check_permission(User, write(_, unload(user))), _, fail),
276 !.
277graph_actions(Options, Options).
278
279graph_checkbox(Graph, Options) -->
280 { option(show_actions(true), Options) },
281 !,
282 html(td(class('no-border'),
283 input([type(checkbox),name(graph),value(Graph),
284 class('graph-select')]))).
285graph_checkbox(_, _) --> [].
286
287multigraph_actions(Options) -->
288 { option(show_actions(true), Options),
289 !,
290 findall(Action-Format,
291 clause(graph_action(Action,Format,_), _),
292 Pairs)
293 },
294 html([ ul([ class('multi-graph-actions')
295 ],
296 \li_graph_actions(Pairs))
297 ]).
298multigraph_actions(_) --> [].
299
300li_graph_actions([]) --> [].
301li_graph_actions([H|T]) --> li_graph_action(H), li_graph_actions(T).
302
303li_graph_action(Action-Format) -->
304 { atomic_list_concat([Pre,Post], '~w', Format) },
305 html(li([ Pre,
306 input([ type(submit), name(action), value(Action) ]),
307 Post
308 ])).
309
310mgraph_action_script -->
311 html_requires(jquery),
312 js_script({|javascript||
313function showActions(time) {
314 if ( time === undefined ) time = 400;
315 var val = [];
316 $('.graph-table :checkbox:checked').each(function(i) {
317 val[i] = $(this).val();
318 });
319 if ( val.length == 0 )
320 $(".multi-graph-actions").hide(time);
321 else
322 $(".multi-graph-actions").show(time);
323}
324
325$(function() {
326 showActions(0);
327 $(".graph-table .graph-select").on('click', showActions);
328});
329 |}).
330
334
335multigraph_action(Request) :-
336 findall(Action, clause(graph_action(Action,_,_), _), Actions),
337 http_parameters(Request,
338 [ graph(Graphs, [list(atom)]),
339 action(Action, [oneof(Actions)])
340 ]),
341 clause(graph_action(Action,Format,_), _),
342 api_action(Request, multigraph_action(Action, Graphs), html,
343 Format-[Action]).
344
345multigraph_action(Action, Graphs) :-
346 forall(member(Graph, Graphs),
347 ( print_message(informational,
348 format('Processing ~w ...', [Graph])),
349 graph_action(Action, _, Graph))).
350
351graph_action('Delete', '~w selected graphs', Graph) :-
352 rdf_unload_graph(Graph).
353graph_action(volatile, 'Make selected graphs ~w', Graph) :-
354 rdf_persistency(Graph, false).
355graph_action(persistent, 'Make selected graphs ~w', Graph) :-
356 rdf_persistency(Graph, true).
357graph_action('Merge journals', '~w for selected graphs', Graph) :-
358 rdf_flush_journals([graph(Graph)]).
359
360
365
366list_graph(Request) :-
367 http_parameters(Request,
368 [ graph(Graph,
369 [description('Name of the graph to describe')])
370 ]),
371 ( rdf_graph(Graph)
372 -> true
373 ; http_404([], Request)
374 ),
375 reply_html_page(cliopatria(default),
376 title('RDF Graph ~w'-[Graph]),
377 [ h1('Summary information for graph "~w"'-[Graph]),
378 \simple_search_form([ id(ac_find_in_graph),
379 filter(graph(Graph)),
380 label('Search this graph')
381 ]),
382 \graph_info(Graph),
383 \graph_as_resource(Graph, []),
384 \graph_persistency(Graph),
385 \graph_actions(Graph),
386 \uri_info(Graph, Graph)
387 ]).
388
393
394graph_info(Graph) -->
395 html_property_table(row(P,V),
396 graph_property(Graph,P,V)).
397
398:- dynamic
399 graph_property_cache/3. 400
401graph_property(Graph, P, V) :-
402 graph_property_cache(Graph, MD5, Pairs),
403 rdf_md5(Graph, MD5),
404 !,
405 member(P0-V, Pairs),
406 P =.. [P0,Graph].
407graph_property(Graph, P, V) :-
408 retractall(graph_property_cache(Graph, _, _)),
409 findall(P-V, graph_property_nc(Graph, P, V), Pairs),
410 rdf_md5(Graph, MD5),
411 assert(graph_property_cache(Graph, MD5, Pairs)),
412 member(P0-V, Pairs),
413 P =.. [P0,Graph].
414
415graph_property_nc(Graph, source, Source) :-
416 rdf_source(Graph, Source).
417graph_property_nc(Graph, triples, int(Triples)) :-
418 graph_triples(Graph, Triples).
419graph_property_nc(Graph, predicate_count, int(Count)) :-
420 aggregate_all(count, predicate_in_graph(Graph, _P), Count).
421graph_property_nc(Graph, subject_count, int(Count)) :-
422 aggregate_all(count, subject_in_graph(Graph, _P), Count).
423graph_property_nc(Graph, bnode_count, int(Count)) :-
424 aggregate_all(count, bnode_in_graph(Graph, _P), Count).
425graph_property_nc(Graph, type_count, int(Count)) :-
426 aggregate_all(count, type_in_graph(Graph, _P), Count).
427
428predicate_in_graph(Graph, P) :-
429 rdf_current_predicate(P),
430 once(rdf(_,P,_,Graph)).
431
438
439subject_in_graph(Graph, S) :-
440 graph_triples(Graph, Count),
441 rdf_statistics(triples(Total)),
442 Count * 10 > Total, 443 !,
444 rdf_subject(S),
445 once(rdf(S, _, _, Graph)).
446subject_in_graph(Graph, S) :-
447 findall(S, rdf(S,_,_,Graph), List),
448 sort(List, Subjects),
449 member(S, Subjects).
450
451bnode_in_graph(Graph, S) :-
452 graph_triples(Graph, Count),
453 rdf_statistics(triples(Total)),
454 Count * 10 > Total,
455 !,
456 rdf_subject(S),
457 rdf_is_bnode(S),
458 once(rdf(S, _, _, Graph)).
459bnode_in_graph(Graph, S) :-
460 findall(S, (rdf(S,_,_,Graph), rdf_is_bnode(S)), List),
461 sort(List, Subjects),
462 member(S, Subjects).
463
464
465
469
470:- thread_local
471 type_seen/1. 472
473type_in_graph(Graph, Class) :-
474 call_cleanup(type_in_graph2(Graph, Class),
475 retractall(type_seen(_))).
476
477type_in_graph2(Graph, Class) :-
478 subject_in_graph(Graph, S),
479 ( rdf_has(S, rdf:type, Class)
480 *-> true
481 ; rdf_equal(Class, rdfs:'Resource')
482 ),
483 ( type_seen(Class)
484 -> fail
485 ; assert(type_seen(Class))
486 ).
487
488
492
493graph_persistency(Graph) -->
494 { rdf_graph_property(Graph, persistent(true)),
495 ( rdf_journal_file(Graph, _)
496 ; rdf_snapshot_file(Graph, _)
497 )
498 },
499 !,
500 html([ h1('Persistency information'),
501 table(class(block),
502 [ tr([ td(class('no-border'),[]),
503 th('File'), th('Size'),th('Modified'),
504 td(class('no-border'),[])
505 ]),
506 \graph_shapshot(Graph),
507 \graph_journal(Graph)
508 ])
509 ]).
510graph_persistency(Graph) -->
511 { rdf_graph_property(Graph, persistent(true))
512 },
513 !,
514 html([ h1('Persistency information'),
515 p('The graph has no associated persistency files')
516 ]).
517graph_persistency(_Graph) -->
518 [].
519
520graph_shapshot(Graph) -->
521 { rdf_snapshot_file(Graph, File)
522 },
523 html(tr([ th(class('file-role'), 'Snapshot'),
524 \file_info(File)
525 ])).
526graph_shapshot(_) --> [].
527
528
529graph_journal(Graph) -->
530 { rdf_journal_file(Graph, File)
531 },
532 html(tr([ th(class('file-role'), 'Journal'),
533 \file_info(File),
534 \flush_journal_button(Graph)
535 ])).
536graph_journal(_) --> [].
537
538flush_journal_button(Graph) -->
539 { http_link_to_id(flush_journal, [], HREF)
540 },
541 html(td(class('no-border'),
542 form(action(HREF),
543 [ input([type(hidden), name(graph), value(Graph)]),
544 input([type(hidden), name(resultFormat), value(html)]),
545 input([type(submit), value('Merge journal')])
546 ]))).
547
548
549file_info(File) -->
550 { size_file(File, Size),
551 time_file(File, Time),
552 format_time(string(Modified), '%+', Time)
553 },
554 html([ td(class('file-name'), File),
555 td(class('int'), \n(human, Size)),
556 td(class('file-time'), Modified)
557 ]).
558
559
563
564graph_actions(Graph) -->
565 html([ h2('Actions'),
566 ul(class(graph_actions),
567 [ \li_export_graph(Graph, show),
568 \li_export_graph(Graph, download),
569 \li_schema_graph(Graph),
570 \li_delete_graph(Graph),
571 \li_persistent_graph(Graph)
572 ])
573 ]).
574
575li_delete_graph(Graph) -->
576 { logged_on(User),
577 catch(check_permission(User, write(_, unload(Graph))), _, fail),
578 !,
579 http_link_to_id(unload_graph, [], Action)
580 },
581 html(li(form(action(Action),
582 [ input([type(hidden), name(graph), value(Graph)]),
583 input([type(hidden), name(resultFormat), value(html)]),
584 input([class(gaction), type(submit), value('Delete')]),
585 ' this graph'
586 ]))).
587li_delete_graph(_) --> [].
588
589li_persistent_graph(Graph) -->
590 { logged_on(User),
591 catch(check_permission(User, write(_, persistent(Graph))), _, fail),
592 !,
593 http_link_to_id(modify_persistency, [], Action),
594 ( rdf_graph_property(Graph, persistent(true))
595 -> Op = (volatile), Value = off
596 ; Op = (persistent), Value = on
597 )
598 },
599 !,
600 html(li(form(action(Action),
601 [ input([type(hidden), name(graph), value(Graph)]),
602 input([type(hidden), name(resultFormat), value(html)]),
603 input([type(hidden), name(persistent), value(Value)]),
604 'Make this graph ',
605 input([class(gaction), type(submit), value(Op)])
606 ]))).
607li_persistent_graph(_) --> [].
608
609li_schema_graph(Graph) -->
610 { http_link_to_id(export_graph_schema, [], Action),
611 download_options(show, Label, MimeType, Title)
612 },
613 html(li(form(action(Action),
614 [ input([type(hidden), name(graph), value(Graph)]),
615 input([type(hidden), name(mimetype), value(MimeType)]),
616 'Compute a schema for this graph and ',
617 input([class(saction), type(submit), value(Label),
618 title(Title)
619 ]),
620 ' the result as ',
621 \dl_format_menu
622 ]))).
623
624li_export_graph(Graph, How) -->
625 { http_link_to_id(export_graph, [], Action),
626 download_options(How, Label, MimeType, Title)
627 },
628 html(li(form(action(Action),
629 [ input([type(hidden), name(graph), value(Graph)]),
630 input([type(hidden), name(mimetype), value(MimeType)]),
631 input([class(gaction), type(submit), value(Label),
632 title(Title)
633 ]),
634 ' this graph as ',
635 \dl_format_menu
636 ]))).
637
638download_options(show, 'Show', 'text/plain',
639 'Returns graph with MIME-type text/plain, \n\c
640 so it will be displayed in your browser').
641download_options(download, 'Download', default,
642 'Return graph with its RDF MIME-type, \n\c
643 so most browsers will save it').
644
-->
646 html(select(name(format),
647 [ option([value(turtle),selected], 'Turtle'),
648 option([value(canonical_turtle)], 'Canonical Turtle'),
649 option([value(rdfxml)], 'RDF/XML')
650 ])).
651
652
658
659list_classes(Request) :-
660 http_parameters(Request,
661 [ graph(Graph, [description('Name of the graph')])
662 ]),
663 types_in_graph(Graph, Map),
664 sort_pairs_by_label(Map, Sorted),
665 reply_html_page(cliopatria(default),
666 title('Classes in graph ~w'-[Graph]),
667 [ h1(['Classes in graph ', \graph_link(Graph)]),
668 \class_table(Sorted, Graph, [])
669 ]).
670
671class_table(Pairs, Graph, Options) -->
672 { option(top_max(TopMax), Options, 500),
673 option(top_max(BottomMax), Options, 500)
674 },
675 html_requires(css('rdf.css')),
676 html(table(class(block),
677 [ \class_table_header
678 | \table_rows_top_bottom(class_row(Graph), Pairs,
679 TopMax, BottomMax)
680 ])).
681
-->
683 html(tr([ th('Class'),
684 th('#Instances')
685 ])).
686
687class_row(Graph, Class) -->
688 { atom(Class),
689 !,
690 findall(I, rdf_has(I, rdf:type, Class, Graph), IL),
691 sort(IL, Classes),
692 length(Classes, InstanceCount)
693 },
694 class_row(Graph, Class-InstanceCount).
695class_row(Graph, Class-InstanceCount) -->
696 { ( var(Graph)
697 -> Params = [class(Class)]
698 ; Params = [graph(Graph), class(Class)]
699 ),
700 http_link_to_id(list_instances, Params, ILink)
701 },
702 html([ td(\rdf_link(Class, [role(class)])),
703 td(class(int), a(href(ILink), InstanceCount))
704 ]).
705
710
711types_in_graph(Graph, Map) :-
712 findall(S, subject_in_graph(Graph, S), Subjects),
713 types(Subjects, Pairs),
714 transpose_pairs(Pairs, TypeSubj),
715 group_pairs_by_key(TypeSubj, TypeSubjs),
716 maplist(instance_count, TypeSubjs, Map).
717
718types([], []).
719types([S|T0], Types) :-
720 call_det(type_of(S,C), Det),
721 !,
722 ( Det == true
723 -> Types = [S-C|T],
724 types(T0, T)
725 ; findall(C2, type_of(S,C2), Cs),
726 multi_class(Cs, S, Types, PT),
727 types(T0, PT)
728 ).
729
730multi_class([], _, Pairs, Pairs).
731multi_class([H|T], S, [S-H|Pairs], PT) :-
732 multi_class(T, S, Pairs, PT).
733
734
735type_of(Subject, Type) :-
736 ( rdf_has(Subject, rdf:type, Type)
737 *-> true
738 ; rdf_equal(Type, rdfs:'Resource')
739 ).
740
741:- meta_predicate
742 call_det(0, -). 743
744call_det(G, Det) :-
745 call(G),
746 deterministic(Det).
747
748instance_count(Type-Instances, Type-Count) :-
749 length(Instances, Count).
750
756
757instance_in_graph(Graph, Class, any, S, C) :-
758 !,
759 instance_in_graph(Graph, Class, S, C).
760instance_in_graph(Graph, Class, bnode, S, C) :-
761 !,
762 freeze(S, rdf_is_bnode(S)),
763 instance_in_graph(Graph, Class, S, C).
764
765
766instance_in_graph(Graph, Class, S, C) :-
767 var(Class),
768 !,
769 subject_in_graph(Graph, S),
770 property_count(Graph, S, C).
771instance_in_graph(Graph, Class, S, C) :-
772 rdf_equal(Class, rdfs:'Resource'),
773 !,
774 ( rdf_has(S, rdf:type, Class),
775 once(rdf(S, _, _, Graph))
776 ; subject_in_graph(Graph, S),
777 \+ rdf_has(S, rdf:type, _)
778 ),
779 property_count(Graph, S, C).
780instance_in_graph(Graph, Class, S, C) :-
781 rdf_has(S, rdf:type, Class),
782 once(rdf(S, _, _, Graph)),
783 property_count(Graph, S, C).
784
785property_count(Graph, S, Count) :-
786 aggregate_all(count, rdf(S, _, _, Graph), Count).
787
791
792graph_as_resource(Graph, Options) -->
793 { ( rdf(Graph, _, _)
794 ; rdf(_, Graph, _)
795 ; rdf(_, _, Graph)
796 ), !
797 },
798 html([ h2([ 'Local view for "',
799 \location(Graph, _), '"'
800 ]),
801 \local_view(Graph, _, Options)
802 ]).
803graph_as_resource(_, _) --> [].
804
805
806 809
813
814list_instances(Request) :-
815 http_parameters(Request,
816 [ class(Class,
817 [ optional(true),
818 description('Limit to instances of this class')
819 ]),
820 graph(Graph,
821 [ optional(true),
822 description('Limit to have at least \c
823 one property in graph')
824 ]),
825 type(Type,
826 [ oneof([any, bnode]),
827 default(any),
828 description('Any instance or only bnodes?')
829 ]),
830 resource_format(Format,
831 [ default(DefaultFormat),
832 atom,
833 description('Display format as passed to rdf_link//2 ')
834 ]),
835 sortBy(Sort,
836 [ oneof([label,properties]),
837 default(label),
838 description('How to sort the result-table')
839 ])
840 ]),
841 setting(resource_format, DefaultFormat),
842 findall(I-PC, instance_in_graph(Graph, Class, Type, I, PC), IPairs),
843 sort_pairs_by_label(IPairs, TableByName),
844 ( Sort == properties
845 -> reverse(TableByName, RevTableByName),
846 transpose_pairs(RevTableByName, FPairsUp),
847 reverse(FPairsUp, FPairsDown),
848 flip_pairs(FPairsDown, Table)
849 ; Table = TableByName
850 ),
851
852 reply_html_page(cliopatria(default),
853 title(\instance_table_title(Graph, Class, Sort)),
854 [ h1(\html_instance_table_title(Graph, Class, Sort)),
855 \instance_table(Table, [resource_format(Format)])
856 ]).
857
858instance_table_title(Graph, Class, Sort) -->
859 { var(Class) },
860 !,
861 html('Instances in ~w sorted by ~w'-
862 [Graph, Sort]).
863instance_table_title(Graph, Class, Sort) -->
864 { rdf_display_label(Class, Label) },
865 html('Instances of ~w in ~w sorted by ~w'-
866 [Label, Graph, Sort]).
867
868html_instance_table_title(Graph, Class, Sort) -->
869 html([ 'Instances',
870 \of_class(Class),
871 \in_graph(Graph),
872 \sorted_by(Sort)
873 ]).
874
875of_class(Class) -->
876 { var(Class) },
877 !.
878of_class(Class) -->
879 html([' of class ', \rdf_link(Class, [role(class)])]).
880
881in_graph(Graph) -->
882 { var(Graph) },
883 !.
884in_graph(Graph) -->
885 html([' in graph ', \graph_link(Graph)]).
886
887sorted_by(Sort) -->
888 html(' sorted by ~w'-[Sort]).
889
890
891instance_table(Pairs, Options) -->
892 { option(top_max(TopMax), Options, 500),
893 option(top_max(BottomMax), Options, 500)
894 },
895 html_requires(css('rdf.css')),
896 html(table(class(block),
897 [ \instance_table_header
898 | \table_rows_top_bottom(instance_row(Options), Pairs,
899 TopMax, BottomMax)
900 ])).
901
-->
903 html(tr([ th('Instance'),
904 th('#Properties')
905 ])).
906
907instance_row(Options, R-C) -->
908 html([ td(\rdf_link(R, [role(inst)|Options])),
909 td(class(int), C)
910 ]).
911
912
913 916
920
921list_predicates(Request) :-
922 http_parameters(Request,
923 [ graph(Graph, [])
924 ]),
925 findall(Pred, predicate_in_graph(Graph, Pred), Preds),
926 sort_by_label(Preds, Sorted),
927 reply_html_page(cliopatria(default),
928 title('Predicates in graph ~w'-[Graph]),
929 [ h1(['Predicates in graph ', \graph_link(Graph)]),
930 \predicate_table(Sorted, Graph, [])
931 ]).
932
933predicate_table(Preds, Graph, Options) -->
934 { option(top_max(TopMax), Options, 500),
935 option(bottom_max(BottomMax), Options, 500)
936 },
937 html_requires(css('rdf.css')),
938 html(table(class(block),
939 [ \predicate_table_header
940 | \table_rows_top_bottom(predicate_row(Graph), Preds,
941 TopMax, BottomMax)
942 ])).
943
-->
945 html(tr([ th('Predicate'),
946 th('#Triples'),
947 th('#Distinct subjects'),
948 th('#Distinct objects'),
949 th('Domain(s)'),
950 th('Range(s)')
951 ])).
952
954
955predicate_row(Graph, Pred) -->
956 { predicate_statistics(Graph, Pred, Triples,
957 Subjects, Objects, Doms, Ranges),
958 ( var(Graph)
959 -> Params = [predicate(Pred)]
960 ; Params = [graph(Graph), predicate(Pred)]
961 ),
962 http_link_to_id(list_triples, Params, PLink)
963 },
964 html([ td(\rdf_link(Pred, [role(pred)])),
965 td(class(int), a(href(PLink), Triples)),
966 \resources(Subjects, subject, Params, [role(subj)]),
967 \resources(Objects, object, Params, [role(obj)]),
968 \resources(Doms, domain, Params, [role(domain)]),
969 \resources(Ranges, range, Params, [role(range)])
970 ]).
971
972resources([], _, _, _) -->
973 !,
974 html(td(class(empty), -)).
975resources([One], _, _, Options) -->
976 !,
977 html(td(\rdf_link(One, Options))).
978resources(Many, What, Params, _) -->
979 !,
980 { ( integer(Many)
981 -> Count = Many
982 ; length(Many, Count)
983 ),
984 http_link_to_id(list_predicate_resources, [side(What)|Params], Link)
985 },
986 html(td(class(int_c), a(href(Link), Count))).
987
988:- dynamic
989 predicate_statistics_cache/8. 990
991predicate_statistics(Graph, P, C, Subjects, Objects, Domains, Ranges) :-
992 var(Graph),
993 !,
994 predicate_statistics_(Graph, P, C, Subjects, Objects, Domains, Ranges).
995predicate_statistics(Graph, P, C, Subjects, Objects, Domains, Ranges) :-
996 rdf_md5(Graph, MD5),
997 predicate_statistics_cache(MD5, Graph, P, C,
998 Subjects, Objects, Domains, Ranges),
999 !.
1000predicate_statistics(Graph, P, C, Subjects, Objects, Domains, Ranges) :-
1001 rdf_md5(Graph, MD5),
1002 debug(rdf_browse, 'Recomputing pred stats for ~p in ~w, MD5=~w',
1003 [P, Graph, MD5]),
1004 retractall(predicate_statistics_cache(MD5, Graph, P, _,
1005 _, _, _, _)),
1006 predicate_statistics_(Graph, P, C, SubjectL, ObjectL, DomainL, RangeL),
1007 res_summary(SubjectL, Subjects),
1008 res_summary(ObjectL, Objects),
1009 res_summary(DomainL, Domains),
1010 res_summary(RangeL, Ranges),
1011 assertz(predicate_statistics_cache(MD5, Graph, P, C,
1012 Subjects, Objects, Domains, Ranges)).
1013
1014
1015res_summary([], []) :- !.
1016res_summary([One], [One]) :- !.
1017res_summary(Many, Count) :-
1018 length(Many, Count).
1019
1020
1021predicate_statistics_(Graph, P, C, Subjects, Objects, Domains, Ranges) :-
1022 findall(S-O, rdf(S,P,O,Graph), Pairs),
1023 length(Pairs, C),
1024 pairs_keys_values(Pairs, Ss, Os),
1025 sort(Ss, Subjects),
1026 sort(Os, Objects),
1027 resources_types(Subjects, Graph, Domains),
1028 resources_types(Objects, Graph, Ranges).
1029
1030resources_types(URIs, Graph, Types) :-
1031 findall(T, resource_type_in(URIs, Graph, T), TList),
1032 sort(TList, Types).
1033
1034resource_type_in(List, Graph, T) :-
1035 member(URI, List),
1036 resource_type(URI, Graph, T).
1037
1039
1040resource_type(literal(Lit), _, Type) :-
1041 !,
1042 ( Lit = type(Type, _)
1043 -> true
1044 ; rdf_equal(Type, rdfs:'Literal')
1045 ).
1046resource_type(^^(_, Type0), _, Type) :-
1047 !,
1048 Type = Type0.
1049resource_type(@(_,_), _, Type) :-
1050 !,
1051 rdf_equal(Type, rdf:langString).
1052resource_type(URI, Graph, Type) :-
1053 ( string(URI)
1054 -> rdf_equal(Type, xsd:string)
1055 ; rdf(URI, rdf:type, Type, Graph)
1056 *-> true
1057 ; rdf_equal(Type, rdfs:'Resource')
1058 ).
1059
1060
1061 1064
1082
1083list_predicate_resources(Request) :-
1084 http_parameters(Request,
1085 [ graph(Graph,
1086 [ optional(true),
1087 description('Limit search to this graph')
1088 ]),
1089 predicate(Pred,
1090 [ description('Predicate to list')
1091 ]),
1092 side(Which,
1093 [ oneof([subject,object,domain,range]),
1094 description('Relation to the predicate (see docs)')
1095 ]),
1096 sortBy(Sort,
1097 [ oneof([label,frequency]),
1098 default(frequency),
1099 description('How to sort results')
1100 ]),
1101 skosmap(SkosMap,
1102 [ boolean,
1103 optional(true),
1104 description('Show SKOS concepts for literals')
1105 ])
1106 ]),
1107 do_skos(SkosMap, Which, Pred),
1108 findall(R, predicate_resource(Graph, Pred, Which, R), Set),
1109 term_frequency_list(Set, FPairs),
1110 sort_pairs_by_label(FPairs, TableByName),
1111 ( Sort == frequency
1112 -> reverse(TableByName, RevTableByName),
1113 transpose_pairs(RevTableByName, FPairsUp),
1114 reverse(FPairsUp, FPairsDown),
1115 flip_pairs(FPairsDown, Table)
1116 ; Table = TableByName
1117 ),
1118
1119 pred_resource_options(Pred, Which, Options),
1120
1121 reply_html_page(cliopatria(default),
1122 title(\resource_table_title(Graph, Pred, Which, Sort)),
1123 [ h1(\html_resource_table_title(Graph, Pred, Which,
1124 Sort, SkosMap)),
1125 \resource_frequency_table(Table,
1126 [ skosmap(SkosMap),
1127 predicate(Pred),
1128 side(Which),
1129 sort(Sort)
1130 | Options
1131 ])
1132 ]).
1133
1134pred_resource_options(_, domain, [label('Class')]) :- !.
1135pred_resource_options(_, range, [label('Class')]) :- !.
1136pred_resource_options(_, _, []).
1137
1138do_skos(SkosMap, _, _) :-
1139 nonvar(SkosMap),
1140 !.
1141do_skos(SkosMap, object, Pred) :-
1142 \+ rdf(_, Pred, literal(_)),
1143 !,
1144 SkosMap = false.
1145do_skos(SkosMap, object, _) :-
1146 rdfs_individual_of(_, skos:'ConceptScheme'),
1147 !,
1148 SkosMap = true.
1149do_skos(false, _, _).
1150
1151
1152resource_table_title(Graph, Pred, Which, Sort) -->
1153 { rdf_display_label(Pred, PLabel)
1154 },
1155 html('Distinct ~ws for ~w in ~w sorted by ~w'-
1156 [Which, PLabel, Graph, Sort]
1157 ).
1158
1159html_resource_table_title(Graph, Pred, Which, Sort, SkosMap) -->
1160 html([ 'Distinct ~ws'-[Which],
1161 \for_predicate(Pred),
1162 \in_graph(Graph),
1163 \sorted_by(Sort),
1164 \showing_skosmap(SkosMap)
1165 ]).
1166
1167for_predicate(Pred) -->
1168 { var(Pred) },
1169 !.
1170for_predicate(Pred) -->
1171 html([' for predicate ', \rdf_link(Pred, [role(pred)])]).
1172
1173showing_skosmap(true) -->
1174 !,
1175 html(' with mapping to SKOS').
1176showing_skosmap(_) --> [].
1177
1178resource_frequency_table(Pairs, Options) -->
1179 { option(top_max(TopMax), Options, 500),
1180 option(top_max(BottomMax), Options, 500),
1181 option(predicate(Pred), Options, _),
1182 option(side(Side), Options)
1183 },
1184 html_requires(css('rdf.css')),
1185 html(table(class(block),
1186 [ \resource_table_header(Options)
1187 | \table_rows_top_bottom(resource_row(Pred, Side, [role(pred)|Options]), Pairs,
1188 TopMax, BottomMax)
1189 ])).
1190
(Options) -->
1192 { option(label(Label), Options, 'Resource'),
1193 ( option(sort(Sort), Options)
1194 -> ( Sort == frequency
1195 -> A1 = [],
1196 A2 = [class(sorted)]
1197 ; A1 = [class(sorted)],
1198 A2 = []
1199 )
1200 ; A1 = [],
1201 A2 = []
1202 )
1203 },
1204 html(tr([ th(A1, Label),
1205 th(A2, 'Count'),
1206 \skosmap_head(Options)
1207 ])).
1208
1209skosmap_head(Options) -->
1210 { option(skosmap(true), Options) },
1211 !,
1212 html(th('SKOS mapping')).
1213skosmap_head(_) --> [].
1214
1215resource_row(Pred, object, Options, R-C) -->
1216 !,
1217 { object_param(R, Param),
1218 http_link_to_id(list_triples_with_object,
1219 [ p(Pred),
1220 Param
1221 ], HREF)
1222 },
1223 html([ td(\rdf_link(R, Options)),
1224 td(class(int), a(href(HREF), C)),
1225 \skosmap(R, Options)
1226 ]).
1227resource_row(Pred, Side, Options, R-C) -->
1228 { domain_range_parameter(Side, R, Param),
1229 !,
1230 http_link_to_id(list_triples,
1231 [ predicate(Pred),
1232 Param
1233 ], HREF)
1234 },
1235 html([ td(\rdf_link(R, Options)),
1236 td(class(int), a(href(HREF), C)),
1237 \skosmap(R, Options)
1238 ]).
1239resource_row(_, _, Options, R-C) -->
1240 html([ td(\rdf_link(R, Options)),
1241 td(class(int), C),
1242 \skosmap(R, Options)
1243 ]).
1244
1245object_param(R, r=R) :-
1246 atom(R),
1247 !.
1248object_param(L, l=A) :-
1249 term_to_atom(L, A).
1250
1251domain_range_parameter(domain, R, domain(R)).
1252domain_range_parameter(range, R, range(R)).
1253
1258
1259skosmap(Literal, Options) -->
1260 { Literal = literal(_),
1261 option(skosmap(true), Options),
1262 findall(Concept-Scheme, skos_find(Literal, Concept, Scheme), Pairs),
1263 Pairs \== [],
1264 sort_pairs_by_label(Pairs, Sorted)
1265 },
1266 html(td(\skos_references(Sorted))).
1267skosmap(_, _) --> [].
1268
1269skos_find(Literal, Concept, Scheme) :-
1270 rdf_has(Concept, skos:prefLabel, Literal),
1271 rdf_has(Concept, skos:inScheme, Scheme).
1272
1273skos_references([]) --> [].
1274skos_references([H|T]) -->
1275 skos_reference(H),
1276 ( { T == [] }
1277 -> []
1278 ; html('; '),
1279 skos_references(T)
1280 ).
1281
1282skos_reference(Concept-Scheme) -->
1283 html([\rdf_link(Concept, [role(concept)]), ' in ', \rdf_link(Scheme, [role(scheme)])]).
1284
1285
1286flip_pairs([], []).
1287flip_pairs([Key-Val|Pairs], [Val-Key|Flipped]) :-
1288 flip_pairs(Pairs, Flipped).
1289
1290predicate_resource(Graph, Pred, subject, R) :-
1291 !,
1292 rdf(R, Pred, _, Graph).
1293predicate_resource(Graph, Pred, object, R) :-
1294 !,
1295 rdf(_, Pred, R, Graph).
1296predicate_resource(Graph, Pred, domain, D) :-
1297 !,
1298 rdf(R, Pred, _, Graph),
1299 rdf(R, rdf:type, D, Graph).
1300predicate_resource(Graph, Pred, range, R) :-
1301 rdf(_, Pred, O, Graph),
1302 resource_type(O, Graph, R).
1303
1309
1310term_frequency_list(Resources, Pairs) :-
1311 msort(Resources, Sorted),
1312 fpairs(Sorted, Pairs).
1313
1314fpairs([], []).
1315fpairs([H|T0], [H-C|T]) :-
1316 pick_same(T0, T1, H, 1, C),
1317 fpairs(T1, T).
1318
1319pick_same([H1|T0], L, H, F0, F) :-
1320 H == H1,
1321 !,
1322 F1 is F0 + 1,
1323 pick_same(T0, L, H, F1, F).
1324pick_same(L, L, _, F, F).
1325
1326
1327 1330
1338
1339list_resource(Request) :-
1340 http_parameters(Request,
1341 [ r(URI,
1342 [ description('URI to describe')]),
1343 sorted(Sorted,
1344 [ oneof([default,none]),
1345 default(default),
1346 description('How to sort properties')
1347 ]),
1348 graph(Graph,
1349 [ optional(true),
1350 description('Limit to properties from graph')
1351 ]),
1352 resource_format(Format,
1353 [ default(DefaultFormat),
1354 atom,
1355 description('Display format as passed to rdf_link//2 ')
1356 ]),
1357 raw(Raw,
1358 [ default(false),
1359 boolean,
1360 description('If true, omit application hook')
1361 ])
1362 ]),
1363 setting(resource_format, DefaultFormat),
1364 rdf_display_label(URI, Label),
1365 reply_html_page(cliopatria(default),
1366 title('Resource ~w'-[Label]),
1367 \list_resource(URI,
1368 [ graph(Graph),
1369 sorted(Sorted),
1370 raw(Raw),
1371 resource_format(Format)
1372 ])).
1373
1391
1392:- multifile
1393 cliopatria:list_resource//1. 1394
1395list_resource(URI, _Options) -->
1396 { \+ rdf(URI, _, _),
1397 \+ rdf(_, URI, _),
1398 \+ rdf(_, _, URI),
1399 \+ rdf(_, _, _, URI)
1400 },
1401 !,
1402 { http_current_request(Request),
1403 http_404([], Request)
1404 },
1405 html([ h1('Unknown URI'),
1406 p(['The URI does not appear in the graph, \c
1407 neither as subject, predicate, object or graph.'])
1408 ]).
1409list_resource(URI, Options) -->
1410 { \+ option(raw(true), Options) },
1411 ( cliopatria:list_resource(URI, Options)
1412 -> []
1413 ; cliopatria:list_resource(URI) 1414 ).
1415list_resource(URI, Options) -->
1416 { option(graph(Graph), Options, _)
1417 },
1418 html([ h1([ 'Local view for "',
1419 \location(URI, Graph), '"'
1420 ]),
1421 \define_prefix(URI),
1422 \local_view(URI, Graph, Options),
1423 p(\as_object(URI, Graph)),
1424 p(\as_graph(URI)),
1425 \uri_info(URI, Graph)
1426 ]).
1427
1432
1433define_prefix(URI) -->
1434 { rdf_global_id(_Prefix:_Local, URI) },
1435 !.
1436define_prefix(URI) -->
1437 { iri_xml_namespace(URI, Namespace, LocalName),
1438 LocalName \== '',
1439 http_link_to_id(add_prefix, [], Action)
1440 },
1441 html(form(action(Action),
1442 ['No prefix for ', a(href(Namespace),Namespace), '. ',
1443 \hidden(uri, Namespace),
1444 input([name(prefix), size(8),
1445 title('Short unique abbreviation')
1446 ]),
1447 input([type(submit), value('Add prefix')])
1448 ])).
1449define_prefix(_) --> 1450 [].
1451
1452
1457
1458location(URI, _Graph) -->
1459 { rdf_is_bnode(URI),
1460 !,
1461 findall(Path, path_to_non_bnode(URI, Path), Paths),
1462 sort_by_length(Paths, PathsByLen),
1463 partition(starts_bnode, PathsByLen, StartsBNode, StartsReal),
1464 ( StartsReal = [Path|_]
1465 -> true
1466 ; last(StartsBNode, Path)
1467 )
1468 },
1469 bnode_location(Path).
1470location(URI, _) -->
1471 html(URI).
1472
1473bnode_location([P-URI]) -->
1474 !,
1475 html([ '[', \rdf_link(P, [role(pred)]), ' ',
1476 \rdf_link(URI,[role(bnode)]),
1477 ']'
1478 ]).
1479bnode_location([P-URI|More]) -->
1480 !,
1481 html([ '[', div(class(bnode_attr),
1482 [ div(\rdf_link(P, [ role(pred)])),
1483 div(\rdf_link(URI,[ role(bnode)]))
1484 ]), ' ',
1485 \bnode_location(More),
1486 ']'
1487 ]).
1488bnode_location([URI|More]) -->
1489 !,
1490 rdf_link(URI, [role(subj)]),
1491 html(' '),
1492 bnode_location(More).
1493bnode_location([]) -->
1494 [].
1495
1496path_to_non_bnode(URI, Path) :-
1497 path_to_non_bnode_rev(URI, [URI], RevPath),
1498 reverse(RevPath, Path).
1499
1500path_to_non_bnode_rev(URI, Seen, [P-URI|Path]) :-
1501 ( rdf_is_bnode(URI),
1502 rdf(S, P, URI),
1503 \+ memberchk(S, Seen)
1504 *-> path_to_non_bnode_rev(S, [S|Seen], Path)
1505 ; fail
1506 ).
1507path_to_non_bnode_rev(URI, _, [URI]).
1508
1509starts_bnode([URI|_]) :-
1510 rdf_is_bnode(URI).
1511
1512sort_by_length(ListOfLists, ByLen) :-
1513 map_list_to_pairs(length, ListOfLists, Pairs),
1514 keysort(Pairs, Sorted),
1515 pairs_values(Sorted, ByLen).
1516
1520
1521as_graph(URI) --> { \+ rdf_graph(URI) }, !.
1522as_graph(URI) -->
1523 html([ 'This resource is also a ',
1524 a([href(location_by_id(list_graph)+'?graph='+encode(URI))],
1525 'named graph'),
1526 '.']).
1527
1528
1532
1533as_object(URI, Graph) -->
1534 { findall(S-P, rdf(S,P,URI,Graph), Pairs),
1535 sort(Pairs, Unique)
1536 },
1537 as_object_locations(Unique, URI, Graph).
1538
1539as_object_locations([], _URI, _) -->
1540 !,
1541 html([ 'The resource does not appear as an object' ]).
1542as_object_locations([S-P], URI, _) -->
1543 !,
1544 html([ 'The resource appears as object in one triple:',
1545 blockquote(class(triple),
1546 [ '{ ',
1547 \rdf_link(S, [role(subj)]), ', ',
1548 \rdf_link(P, [role(pred)]), ', ',
1549 \rdf_link(URI, [role(obj)]),
1550 ' }'
1551 ])
1552 ]).
1553as_object_locations(List, URI, Graph) -->
1554 !,
1555 { length(List, Len),
1556 ( var(Graph)
1557 -> Extra = []
1558 ; Extra = [graph=Graph]
1559 ),
1560 http_link_to_id(list_triples_with_object, [r=URI|Extra], Link)
1561 },
1562 html([ 'The resource appears as object in ',
1563 a(href(Link), [Len, ' triples'])
1564 ]).
1565
1579
1580local_view(URI, Graph, Options) -->
1581 { option(top_max(TopMax), Options, 500),
1582 option(bottom_max(BottomMax), Options, 500),
1583 po_pairs(URI, Graph, Pairs, Options),
1584 lview_graphs(URI, Graph, Graphs)
1585 },
1586 ( { Pairs \== []
1587 }
1588 -> html_requires(css('rdf.css')),
1589 html(table(class(block),
1590 [ \lview_header(Options)
1591 | \table_rows_top_bottom(lview_row(Options, URI, Graphs),
1592 Pairs,
1593 TopMax, BottomMax)
1594 ])),
1595 graph_footnotes(Graphs, Options)
1596 ; { lod_uri_graph(URI, LODGraph),
1597 rdf_graph(LODGraph)
1598 }
1599 -> html(p([ 'No triples for ', \show_link(URI), '. ',
1600 'Linked Data was loaded into ', \graph_link(LODGraph),
1601 '.'
1602 ]))
1603 ; { sane_uri(URI) }
1604 -> { http_link_to_id(lod_crawl, [], FetchURL),
1605 http_current_request(Request),
1606 memberchk(request_uri(Here), Request)
1607 },
1608 html(form(action(FetchURL),
1609 [ \hidden(r, URI),
1610 \hidden(return_to, Here),
1611 'No triples for ', \show_link(URI),
1612 '. Would you like to ',
1613 input([ type(submit),
1614 value('Query the Linked Data cloud')
1615 ]),
1616 '?'
1617 ]))
1618 ; html_requires(css('rdf.css')),
1619 html(p([ 'No triples for ', \show_link(URI),
1620 ' (unknown URI scheme).']))
1621 ).
1622
1623show_link(URI) -->
1624 { sane_uri(URI) },
1625 !,
1626 html(a(href(URI), 'this URI')).
1627show_link(URI) -->
1628 html(span(class('insecure-uri'), URI)).
1629
1630sane_uri(URI) :-
1631 uri_components(URI, Components),
1632 uri_data(scheme, Components, Scheme),
1633 valid_scheme(Scheme),
1634 uri_data(authority, Components, Authority),
1635 nonvar(Authority).
1636
1637valid_scheme(http).
1638valid_scheme(https).
1639valid_scheme(ftp).
1640valid_scheme(ftps).
1641
(Options) -->
1643 { option(sorted(Sorted), Options, default),
1644 alt_sorted(Sorted, Alt),
1645 http_current_request(Request),
1646 http_reload_with_parameters(Request, [sorted(Alt)], HREF)
1647 },
1648 html(tr([ th('Predicate'),
1649 th(['Value (sorted: ', a(href(HREF), Sorted), ')'])
1650 ])).
1651
1652alt_sorted(default, none).
1653alt_sorted(none, default).
1654
1655
1656lview_row(Options, S, Graphs, P-OList) -->
1657 html([ td(class(predicate), \rdf_link(P, [role(pred)|Options])),
1658 td(class(object), \object_list(OList, S, P, Graphs, Options, 1))
1659 ]).
1660
1661object_list([], _, _, _, _, _) --> [].
1662object_list([H|T], S, P, Graphs, Options, Row) -->
1663 { NextRow is Row + 1,
1664 obj_class(Row, Class)
1665 },
1666 html(div(class(Class),
1667 [ \rdf_link(H, [role(obj)|Options]),
1668 \graph_marks(S, P, H, Graphs)
1669 ])),
1670 object_list(T, S, P, Graphs, Options, NextRow).
1671
1672obj_class(N, Class) :-
1673 ( N mod 2 =:= 0
1674 -> Class = even
1675 ; Class = odd
1676 ).
1677
1678graph_marks(_,_,_,[_]) --> !.
1679graph_marks(S,P,O,Graphs) -->
1680 html(sup(class(graph), \graphs(S,P,O,Graphs))).
1681
1682graphs(S, P, O, Graphs) -->
1683 { findall(G, rdf(S,P,O,G:_), GL) },
1684 graphs(GL, Graphs).
1685
1686graphs([], _) --> [].
1687graphs([H|T], Graphs) -->
1688 { nth1(N, Graphs, H) -> true },
1689 html(N),
1690 ( { T == [] }
1691 -> []
1692 ; html(','),
1693 graphs(T, Graphs)
1694 ).
1695
1700
([], _Options) --> !.
1702graph_footnotes([Graph], _Options) -->
1703 !,
1704 html(p(class('graphs-used'),
1705 [ 'All properties reside in the graph ',
1706 \graph_link(Graph)
1707 ])).
1708graph_footnotes(Graphs, Options) -->
1709 html(p(class('graphs-used'),
1710 'Named graphs describing this resource:')),
1711 graph_footnotes(Graphs, 1, Options).
1712
([], _, _) --> [].
1714graph_footnotes([H|T], N, Options) -->
1715 html(div(class('graph-fn'),
1716 [ sup(class(graph), N),
1717 \graph_link(H)
1718 ])),
1719 { N2 is N + 1 },
1720 graph_footnotes(T, N2, Options).
1721
1723
1724lview_graphs(_Subject, Graph, Graphs) :-
1725 nonvar(Graph),
1726 !,
1727 Graphs = [Graph].
1728lview_graphs(Subject, Graph, Graphs) :-
1729 findall(Graph, rdf(Subject, _, _, Graph:_), Graphs0),
1730 sort(Graphs0, Graphs).
1731
1737
1738po_pairs(S, Graph, Pairs, Options) :-
1739 option(sorted(none), Options),
1740 !,
1741 findall(P-[O], rdf(S,P,O,Graph), Pairs).
1742po_pairs(S, Graph, Pairs, _Options) :-
1743 var(Graph),
1744 !,
1745 findall(P-OL,
1746 setof(O, rdf(S,P,O), OL),
1747 Pairs0),
1748 sort_po(Pairs0, Pairs).
1749po_pairs(S, Graph, Pairs, _Options) :-
1750 findall(P-OL,
1751 setof(O, rdf(S,P,O,Graph), OL),
1752 Pairs0),
1753 sort_po(Pairs0, Pairs).
1754
1760
1761sort_po(Pairs, Sorted) :-
1762 map_list_to_pairs(po_key, Pairs, Keyed),
1763 keysort(Keyed, KeySorted),
1764 exclude(=(0-_), KeySorted, Remaining),
1765 pairs_values(Remaining, Sorted).
1766
1767po_key(P-_, Key) :-
1768 p_order(P, Key),
1769 !.
1770po_key(P-_, Key) :-
1771 label_sort_key(P, Key).
1772
1778
1779:- rdf_meta
1780 p_order(r,?). 1781
1782p_order(P, Order) :-
1783 cliopatria:predicate_order(P, Order),
1784 !.
1785p_order(P, 100) :-
1786 label_property(P),
1787 !.
1788p_order(P, 110) :-
1789 rdfs_subproperty_of(P, skos:altLabel),
1790 !.
1791p_order(rdf:type, 210).
1792p_order(rdfs:subClassOf, 220).
1793p_order(rdfs:domain, 230).
1794p_order(rdfs:range, 240).
1795p_order(rdfs:comment, 310).
1796p_order(rdfs:isDefinedBy, 320).
1797
1798
1803
1804uri_info(URI, Graph) -->
1805 uri_class_info(URI, Graph),
1806 uri_predicate_info(URI, Graph),
1807 html(h2('Context graph')),
1808 context_graph(URI, []).
1809
1810uri_class_info(URI, Graph) -->
1811 { rdf_current_predicate(URI)
1812 },
1813 !,
1814 html(h2('Predicate statistics')),
1815 predicate_table([URI], Graph, []).
1816uri_class_info(_,_) --> [].
1817
1818uri_predicate_info(URI, Graph) -->
1819 { \+ \+ rdf(_, rdf:type, URI, Graph)
1820 },
1821 !,
1822 html(h2('Class statistics')),
1823 class_table([URI], Graph, []).
1824uri_predicate_info(_, _) --> [].
1825
1826
1841
1842context_graph(URI, Options) -->
1843 { merge_options(Options, [style(_)], GraphOption),
1844 rdf_equal(owl:sameAs, SameAs)
1845 },
1846 html([ \graphviz_graph(context_graph(URI, GraphOption),
1847 [ object_attributes([width('100%')]),
1848 wrap_url(resource_link),
1849 graph_attributes([ rankdir('RL')
1850 ]),
1851 shape_hook(shape(URI, GraphOption)),
1852 bag_shape_hook(bag_shape(GraphOption)),
1853 edge_hook(edge(URI, GraphOption)),
1854 label_hook(cliopatria:node_label),
1855 smash([SameAs])
1856 ])
1857 ]).
1858
1859:- public
1860 shape/5,
1861 edge/5,
1862 bag_shape/3. 1863
1868
1869shape(Start, Options, URI, Shape, GVOptions) :-
1870 append(Options, GVOptions, AllOptions),
1871 cliopatria:node_shape(URI, Shape, [start(Start)|AllOptions]),
1872 !.
1873shape(Start, _Options, Start,
1874 [ shape(tripleoctagon),style(filled),fillcolor('#ff85fd'),id(start) ],
1875 _GVOptions).
1876
1880
1881bag_shape(Options, Members, Shape) :-
1882 cliopatria:bag_shape(Members, Shape, Options),
1883 !.
1884bag_shape(_, _, []).
1885
1886edge(Start, Options, Predicate, Shape, GVOptions) :-
1887 append(Options, GVOptions, AllOptions),
1888 cliopatria:edge_shape(Predicate, Shape, [start(Start)|AllOptions]),
1889 !.
1890
1900
1901context_graph(URI, Options, RDF) :-
1902 cliopatria:context_graph(URI, RDF, Options),
1903 !.
1904context_graph(URI, _Options, RDF) :- 1905 cliopatria:context_graph(URI, RDF),
1906 !.
1907context_graph(URI, _, RDF) :-
1908 findall(T, context_triple(URI, T), RDF0),
1909 sort(RDF0, RDF1),
1910 minimise_graph(RDF1, RDF2), 1911 bagify_graph(RDF2, RDF3, Bags, []), 1912 append(RDF3, Bags, RDF).
1913
1914:- rdf_meta
1915 transitive_context(r),
1916 context(r). 1917
1918context_triple(URI, Triple) :-
1919 transitive_context(CP),
1920 parents(URI, CP, Triples, [URI], 3),
1921 member(Triple, Triples).
1922context_triple(URI, Triple) :-
1923 cliopatria:context_predicate(URI, R),
1924 rdf_has(URI, R, O, P),
1925 normalize_triple(rdf(URI, P, O), Triple).
1926context_triple(URI, Triple) :-
1927 context(R),
1928 rdf_has(URI, R, O, P),
1929 normalize_triple(rdf(URI, P, O), Triple).
1930context_triple(URI, Triple) :-
1931 context(R),
1932 rdf_has(S, R, URI, P),
1933 normalize_triple(rdf(S, P, URI), Triple).
1934
1935normalize_triple(rdf(S, inverse_of(P0), O),
1936 rdf(O, P, S)) :-
1937 !,
1938 rdf_predicate_property(P0, inverse_of(P)).
1939normalize_triple(RDF, RDF).
1940
1941
1942
1943parents(URI, Up, [Triple|T], Visited, MaxD) :-
1944 succ(MaxD2, MaxD),
1945 rdf_has(URI, Up, Parent, P),
1946 normalize_triple(rdf(URI, P, Parent), Triple),
1947 \+ memberchk(Parent, Visited),
1948 parents(Parent, Up, T, [Parent|Visited], MaxD2).
1949parents(_, _, [], _, _).
1950
1951transitive_context(owl:sameAs).
1952transitive_context(rdfs:subClassOf).
1953transitive_context(rdfs:subPropertyOf).
1954transitive_context(skos:broader).
1955transitive_context(P) :-
1956 rdfs_individual_of(P, owl:'TransitiveProperty'),
1957 rdf_predicate_property(P, rdfs_subject_branch_factor(BF)),
1958 BF < 2.0.
1959
1960context(skos:related).
1961context(skos:mappingRelation).
1962
1968
1969list_triples(Request) :-
1970 http_parameters(Request,
1971 [ predicate(P,
1972 [ optional(true),
1973 description('Limit triples to this pred')]),
1974 graph(Graph, [ optional(true),
1975 description('Limit triples to this graph')
1976 ]),
1977 domain(Dom, [ optional(true),
1978 description('Restrict to subjects of this class')
1979 ]),
1980 range(Range, [ optional(true),
1981 description('Restrict to objects of this class')
1982 ])
1983 ]),
1984 ( atom(Dom)
1985 -> findall(rdf(S,P,O), rdf_in_domain(S,P,O,Dom,Graph), Triples0)
1986 ; atom(Range)
1987 -> findall(rdf(S,P,O), rdf_in_range(S,P,O,Range,Graph), Triples0)
1988 ; findall(rdf(S,P,O), rdf(S,P,O,Graph), Triples0)
1989 ),
1990 sort(Triples0, Triples),
1991 sort_triples_by_label(Triples, Sorted),
1992 length(Sorted, Count),
1993 ( var(P)
1994 -> Title = 'Triples in graph ~w'-[Graph]
1995 ; rdf_display_label(P, PLabel),
1996 Title = 'Triples for ~w in graph ~w'-[PLabel, Graph]
1997 ),
1998 reply_html_page(cliopatria(default),
1999 title(Title),
2000 [ h1(\triple_header(Count, P, Dom, Range, Graph)),
2001 \triple_table(Sorted, P, [resource_format(nslabel)])
2002 ]).
2003
2004rdf_in_domain(S,P,O,Dom,Graph) :-
2005 rdf(S, P, O, Graph),
2006 rdf_has(S, rdf:type, Dom).
2007
2008rdf_in_range(S,P,O,Lit,Graph) :-
2009 rdf_equal(rdfs:'Literal', Lit),
2010 !,
2011 O = literal(_),
2012 rdf(S, P, O, Graph).
2013rdf_in_range(S,P,O,Rng,Graph) :-
2014 rdf_equal(rdfs:'Resource', Rng),
2015 !,
2016 rdf(S, P, O, Graph),
2017 atom(O).
2018rdf_in_range(S,P,O,Rng,Graph) :-
2019 rdf(S, P, O, Graph),
2020 rdf_has(O, rdf:type, Rng).
2021
2022
(Count, Pred, Dom, Range, Graph) -->
2024 html([ 'Table for the ~D triples'-[Count],
2025 \for_predicate(Pred),
2026 \with_domain(Dom),
2027 \with_range(Range),
2028 \in_graph(Graph)
2029 ]).
2030
2031with_domain(Dom) -->
2032 { var(Dom) },
2033 !.
2034with_domain(Dom) -->
2035 html([' with domain ', \rdf_link(Dom, [role(domain)])]).
2036
2037with_range(Range) -->
2038 { var(Range) },
2039 !.
2040with_range(Range) -->
2041 html([' with range ', \rdf_link(Range, [role(range)])]).
2042
2047
2048triple_table(Triples, Pred, Options) -->
2049 { option(top_max(TopMax), Options, 500),
2050 option(top_max(BottomMax), Options, 500)
2051 },
2052 html(table(class(block),
2053 [ \spo_header(Pred)
2054 | \table_rows_top_bottom(spo_row(Options, Pred), Triples,
2055 TopMax, BottomMax)
2056 ])).
2057
(P) -->
2059 { nonvar(P) },
2060 html(tr([ th('Subject'),
2061 th('Object')
2062 ])).
2063spo_header(_) -->
2064 html(tr([ th('Subject'),
2065 th('Predicate'),
2066 th('Object')
2067 ])).
2068
2069spo_row(Options, Pred, rdf(S,_,O)) -->
2070 { nonvar(Pred) },
2071 !,
2072 html([ td(class(subject), \rdf_link(S, [role(subj)|Options])),
2073 td(class(object), \rdf_link(O, [role(obj) |Options]))
2074 ]).
2075spo_row(Options, _, rdf(S,P,O)) -->
2076 html([ td(class(subject), \rdf_link(S, [role(subj)|Options])),
2077 td(class(predicate), \rdf_link(P, [role(pred)|Options])),
2078 td(class(object), \rdf_link(O, [role(obj) |Options]))
2079 ]).
2080
2081
2088
2089list_triples_with_object(Request) :-
2090 http_parameters(Request,
2091 [ r(RObject, [optional(true),
2092 description('Object as resource (URI)')
2093 ]),
2094 l(LObject, [optional(true),
2095 description('Object as literal (Prolog notation)')
2096 ]),
2097 p(P, [optional(true),
2098 description('Limit to a given predicate (URI)')
2099 ]),
2100 graph(Graph, [optional(true),
2101 description('Limit to a given graph (URI)')
2102 ]),
2103 sortBy(Sort,
2104 [ oneof([label, subject, predicate]),
2105 default(label),
2106 description('How to sort the result')
2107 ])
2108 ]),
2109 target_object(RObject, LObject, Object),
2110 list_triples_with_object(Object, P, Graph, [sortBy(Sort)]).
2111
2112target_object(RObject, _LObject, RObject) :-
2113 atom(RObject),
2114 !.
2115target_object(_, LObject, Object) :-
2116 atom(LObject),
2117 !,
2118 term_to_atom(Object0, LObject),
2119 rdf11_rdf_db(Object0, Object).
2120target_object(_, _, _) :-
2121 throw(existence_error(http_parameter, r)).
2122
2123rdf11_rdf_db(^^(String, Type), literal(type(Type, Atom))) :-
2124 atom_string(Atom, String).
2125rdf11_rdf_db(@(String, Lang), literal(lang(Lang, Atom))) :-
2126 atom_string(Atom, String).
2127rdf11_rdf_db(literal(Lit), literal(Lit)).
2128
2129
2135
2136list_triples_with_literal(Request) :-
2137 http_parameters(Request,
2138 [ q(Text,
2139 [optional(true),
2140 description('Object as resource (URI)')
2141 ])
2142 ]),
2143 list_triples_with_object(literal(Text), _, _, [sortBy(subject)]).
2144
2145
2146list_triples_with_object(Object, P, Graph, Options) :-
2147 findall(S-P, rdf(S,P,Object,Graph), Pairs),
2148 ( option(sortBy(label), Options)
2149 -> sort_pairs_by_label(Pairs, Sorted)
2150 ; option(sortBy(predicate), Options)
2151 -> transpose_pairs(Pairs, Transposed), 2152 flip_pairs(Transposed, Sorted) 2153 ; sort(Pairs, Sorted)
2154 ),
2155 length(Pairs, Count),
2156 label_of(Object, OLabel),
2157 reply_html_page(cliopatria(default),
2158 title('Triples with object ~w'-[OLabel]),
2159 [ h1(\otriple_header(Count, Object, P, Graph, Options)),
2160 \otriple_table(Sorted, Object, [resource_format(nslabel)])
2161 ]).
2162
(Count, Object, Pred, Graph, Options) -->
2164 { option(sortBy(SortBy), Options) },
2165 html([ 'Table for the ~D triples'-[Count],
2166 \with_object(Object),
2167 \on_predicate(Pred),
2168 \in_graph(Graph),
2169 \sorted_by(SortBy)
2170 ]).
2171
2172with_object(Obj) -->
2173 { var(Obj)},
2174 !.
2175with_object(Obj) -->
2176 html([' with object ', \rdf_link(Obj, [role(obj)])]).
2177
2178on_predicate(P) -->
2179 { var(P) },
2180 !.
2181on_predicate(P) -->
2182 html([' on predicate ', \rdf_link(P, [role(pred)])]).
2183
2184
2185otriple_table(SPList, Object, Options) -->
2186 { option(top_max(TopMax), Options, 500),
2187 option(top_max(BottomMax), Options, 500)
2188 },
2189 html(table(class(block),
2190 [ \sp_header(Object)
2191 | \table_rows_top_bottom(sp_row(Options,Object), SPList,
2192 TopMax, BottomMax)
2193 ])).
2194
(_) -->
2196 html(tr([ th('Subject'),
2197 th('Predicate')
2198 ])).
2199
2200sp_row(Options, _O, S-P) -->
2201 html([ td(class(subject), \rdf_link(S, [role(subj)|Options])),
2202 td(class(predicate), \rdf_link(P, [role(pred)|Options]))
2203 ]).
2204
2205
2206
2207
2208
2209 2212
2216
2217sort_by_label(URIs, Sorted) :-
2218 map_list_to_pairs(label_sort_key, URIs, LabelPairs),
2219 keysort(LabelPairs, SortedPairs),
2220 pairs_values(SortedPairs, Sorted).
2221
2222label_sort_key(URI, Key) :-
2223 label_of(URI, Label),
2224 ( atom(Label)
2225 -> collation_key(Label, Key)
2226 ; Key = Label
2227 ).
2228
2229label_of(URI, Label) :-
2230 rdf_is_resource(URI),
2231 !,
2232 rdf_display_label(URI, Label).
2233label_of(Literal, Label) :-
2234 literal_text(Literal, Label).
2235
2236
2240
2241sort_triples_by_label(Pairs, Sorted) :-
2242 map_list_to_pairs(key_triple_by_label, Pairs, LabelPairs),
2243 keysort(LabelPairs, SortedPairs),
2244 pairs_values(SortedPairs, Sorted).
2245
2246key_triple_by_label(rdf(S,P,O), rdf(SK,PK,OK)) :-
2247 label_sort_key(S, SK),
2248 label_sort_key(P, PK),
2249 label_sort_key(O, OK).
2250
2254
2255sort_pairs_by_label(Pairs, Sorted) :-
2256 map_list_to_pairs(key_label_sort_key, Pairs, LabelPairs),
2257 keysort(LabelPairs, SortedPairs),
2258 pairs_values(SortedPairs, Sorted).
2259
2260key_label_sort_key(R-_, Key) :-
2261 label_sort_key(R, Key).
2262
2263
2264 2267
2273
2274p_label(source(_), 'Source URL').
2275p_label(triples(G),
2276 ['# ', a(href(Link), triples)]) :-
2277 http_link_to_id(list_triples, [graph=G], Link).
2278p_label(subject_count(G),
2279 ['# ', a(href(Link), subjects)]) :-
2280 http_link_to_id(list_instances, [graph=G], Link).
2281p_label(bnode_count(G),
2282 ['# ', a(href(Link), 'bnode subjects')]) :-
2283 http_link_to_id(list_instances, [graph=G, type=bnode], Link).
2284p_label(predicate_count(G),
2285 ['# ', a(href(Link), predicates)]) :-
2286 http_link_to_id(list_predicates, [graph=G], Link).
2287p_label(type_count(G),
2288 ['# Referenced ', a(href(Link), classes)]) :-
2289 http_link_to_id(list_classes, [graph=G], Link).
2290
2291
2292 2295
2302
2303search(Request) :-
2304 http_parameters(Request,
2305 [ q(QueryText,
2306 [ description('Query to search for')
2307 ]),
2308 filter(FilterAtom,
2309 [ optional(true),
2310 description('Filter on raw matches (a Prolog term)')
2311 ])
2312 ]),
2313 ( var(FilterAtom)
2314 -> Filter = true
2315 ; atom_to_term(FilterAtom, Filter0, []),
2316 rdf_global_term(Filter0, Filter)
2317 ),
2318
2319 find_literals(QueryText, Literals, Query),
2320 literal_triples(Literals, Filter, Triples),
2321 reply_html_page(cliopatria(default),
2322 title('Search results for ~q'-[Query]),
2323 [ h1('Search results for token "~q"'-[Query]),
2324 \rdf_table(Triples, [])
2325 ]).
2326
2327find_literals(QueryText, [Query], exact(Query)) :-
2328 2329 sub_atom(QueryText,0,1,Remainder,'"'),
2330 sub_atom(QueryText,Remainder,1,0,'"'),
2331 !,
2332 sub_atom(QueryText,1,_,1,Query).
2333find_literals(QueryText, Literals, Query) :-
2334 2335 tokenize_atom(QueryText, Tokens),
2336 once(phrase(query(Query), Tokens)),
2337 rdf_find_literals(Query, Literals).
2338
2339query(Query) -->
2340 simple_query(Q1),
2341 ( eos
2342 -> {Query = Q1}
2343 ; query(Q2),
2344 {Query = and(Q1,Q2)}
2345 ).
2346
2347eos([],[]).
2348
2349simple_query(Token) -->
2350 ['"',Token,'"'],
2351 !.
2352simple_query(not(Token)) -->
2353 [-, Token].
2354simple_query(case(Token)) -->
2355 [Token].
2356
2361
2362literal_triples(Literals, Filter, Triples) :-
2363 sub_term(graph(Graph), Filter),
2364 !,
2365 phrase(ltriples(Literals, Graph, Filter), Triples).
2366literal_triples(Literals, Filter, Triples) :-
2367 phrase(ltriples(Literals, Filter), Triples).
2368
2369
2370ltriples([], _, _) --> [].
2371ltriples([H|T], G, F) -->
2372 findall(rdf(S,P,literal(L)),
2373 ( rdf(S,P,literal(exact(H), L),G),
2374 search_filter(F, S)
2375 )),
2376 ltriples(T, G, F).
2377
2378ltriples([], _) --> [].
2379ltriples([H|T], F) -->
2380 findall(rdf(S,P,literal(L)),
2381 ( rdf(S,P,literal(exact(H), L)),
2382 search_filter(F, S)
2383 )),
2384 ltriples(T, F).
2385
2391
2392rdf_table(Triples, Options) -->
2393 { option(top_max(TopMax), Options, 500),
2394 option(top_max(BottomMax), Options, 500)
2395 },
2396 html(table(class(block),
2397 [ tr([ th('Subject'), th('Predicate'), th('Object') ])
2398 | \table_rows_top_bottom(triple, Triples,
2399 TopMax, BottomMax)
2400 ])).
2401
2402triple(rdf(S,P,O)) -->
2403 html([ td(class(subject), \rdf_link(S, [role(subj)])),
2404 td(class(predicate), \rdf_link(P, [role(pred)])),
2405 td(class(object), \rdf_link(O, [role(obj) ]))
2406 ]).
2407
2408
2409 2412
2420
2421html_property_table(Template, Goal) -->
2422 { findall(Template, Goal, Rows) },
2423 html(table(class(block),
2424 \table_rows(prow, Rows))).
2425
2426prow(Row) -->
2427 { Row =.. [_,H|Cells],
2428 ( p_label(H, Label0)
2429 -> true
2430 ; functor(H, Label0, _)
2431 ),
2432 ( is_list(Label0)
2433 -> append(Label0, [:], Label)
2434 ; Label = [Label0, :]
2435 )
2436 },
2437 html([ th(class(p_name), Label)
2438 | \pcells(Cells)
2439 ]).
2440
2441pcells([]) --> [].
2442pcells([H|T]) -->
2443 pcell(H),
2444 pcells(T).
2445
2446pcell(int(Value)) -->
2447 { integer(Value) },
2448 !,
2449 nc('~D', Value).
2450pcell(H) -->
2451 { compound(H),
2452 H =.. [Class,Value], !
2453 },
2454 html(td(class(Class), Value)).
2455pcell(H) -->
2456 html(td(H)).
2457
2458
2472
2473table_rows(Goal, Rows) -->
2474 table_rows(Rows, Goal, 1, -1).
2475
2476table_rows_top_bottom(Goal, Rows, inf, inf) -->
2477 !,
2478 table_rows(Rows, Goal, 1, -1).
2479table_rows_top_bottom(Goal, Rows, MaxTop, MaxBottom) -->
2480 { length(Rows, Count) },
2481 ( { MaxTop+MaxBottom >= Count }
2482 -> table_rows(Rows, Goal, 1, -1)
2483 ; { Skip is Count-MaxBottom,
2484 delete_list_prefix(Skip, Rows, BottomRows),
2485 Skipped is Count-(MaxTop+MaxBottom)
2486 },
2487 table_rows(Rows, Goal, 1, MaxTop),
2488 html(tr(class(skip),
2489 [ th(colspan(10), 'Skipped ~D rows'-[Skipped])
2490 ])),
2491 table_rows(BottomRows, Goal, 1, -1)
2492 ).
2493
2494table_rows(_, _, _, 0) --> !, [].
2495table_rows([], _, _, _) --> [].
2496table_rows([H|T], Goal, N, Left) -->
2497 { N2 is N + 1,
2498 ( N mod 2 =:= 0
2499 -> Class = even
2500 ; Class = odd
2501 ),
2502 Left2 is Left - 1
2503 },
2504 html(tr(class(Class), \call(Goal, H))),
2505 table_rows(T, Goal, N2, Left2).
2506
2507delete_list_prefix(0, List, List) :- !.
2508delete_list_prefix(_, [], []) :- !.
2509delete_list_prefix(N, [_|T], List) :-
2510 N2 is N - 1,
2511 delete_list_prefix(N2, T, List).
2512
2516
2517list_prefixes(Request) :-
2518 Formats = [html,turtle],
2519 http_parameters(Request,
2520 [ format(Format,
2521 [ oneof(Formats),
2522 description('Output format'),
2523 default(html)
2524 ])
2525 ]),
2526 findall(Prefix-URI,
2527 rdf_current_ns(Prefix, URI),
2528 Pairs),
2529 keysort(Pairs, Sorted),
2530 prefix_actions(Options),
2531 reply_html_page(cliopatria(default),
2532 title('RDF prefixes (namespaces)'),
2533 [ h1('Known RDF prefixes (namespaces)'),
2534 \explain_prefixes,
2535 \prefix_table(Format, Sorted, Options),
2536 \prefix_formats(Formats, Format, Request)
2537 ]).
2538
2539prefix_actions([edit(true)]) :-
2540 logged_on(User),
2541 !,
2542 catch(check_permission(User, write(_, del_prefix(_))), _, fail),
2543 !.
2544prefix_actions([]).
2545
2546explain_prefixes -->
2547 html(p([ 'The following prefixes are known and may be used \c
2548 without declaration in SPARQL queries to this server.'
2549 ])).
2550
2551prefix_formats(Formats, Format, Request) -->
2552 { select(Format, Formats, Alt)
2553 },
2554 html(p(class('prefix-format'),
2555 [ 'Also available in ',
2556 \alt_formats(Alt, Request)
2557 ])).
2558
2559alt_formats([], _) --> [].
2560alt_formats([H|T], Request) -->
2561 { http_reload_with_parameters(Request, [format(H)], HREF)
2562 },
2563 html(a(href(HREF), H)),
2564 ( {T==[]}
2565 -> []
2566 ; html(' and '),
2567 alt_formats(T, Request)
2568 ).
2569
2570prefix_table(html, Pairs, Options) -->
2571 html(table(class(block),
2572 [ \prefix_table_header,
2573 \table_rows(prefix_row(Options), Pairs)
2574 ])).
2575prefix_table(turtle, Pairs, _) -->
2576 html(pre(class(code),
2577 \turtle_prefixes(Pairs))).
2578
-->
2580 html(tr([ th('Prefix'),
2581 th('URI')
2582 ])).
2583
2584prefix_row(Options, Prefix-URI) -->
2585 { option(edit(true), Options),
2586 !,
2587 http_link_to_id(del_prefix, [prefix(Prefix)], HREF)
2588 },
2589 html([ td(Prefix),
2590 td(URI),
2591 td(a([ href(HREF),
2592 class('delete'),
2593 title('Remove prefix')
2594 ], '\u232B'))
2595 ]).
2596prefix_row(_Options, Prefix-URI) -->
2597 html([ td(Prefix),
2598 td(URI)
2599 ]).
2600
2601turtle_prefixes(Pairs) -->
2602 { longest_prefix(Pairs, 0, Length),
2603 PrefixCol is Length+10
2604 },
2605 turtle_prefixes(Pairs, PrefixCol).
2606
2607longest_prefix([], L, L).
2608longest_prefix([Prefix-_|T], L0, L) :-
2609 atom_length(Prefix, L1),
2610 L2 is max(L0, L1),
2611 longest_prefix(T, L2, L).
2612
2613turtle_prefixes([], _) --> [].
2614turtle_prefixes([Prefix-URI|T], Col) -->
2615 html('@prefix ~t~w: ~*|<~w> .~n'-[Prefix, Col, URI]),
2616 turtle_prefixes(T, Col)