29
30:- module(examples,
31 [ ex_xref/3, 32 index_examples/0,
33 examples//2,
34 reindex_examples/0
35 ]). 36:- use_module(library(http/html_write)). 37:- use_module(library(filesex)). 38:- use_module(library(dcg/high_order)). 39:- use_module(library(http/html_head)). 40:- use_module(library(apply)). 41:- use_module(library(lists)). 42:- use_module(library(occurs)). 43:- use_module(library(ordsets)). 44:- use_module(library(pairs)). 45:- use_module(library(prolog_code)). 46:- use_module(library(solution_sequences)). 47:- use_module(library(git)). 48:- use_module(library(http/http_dispatch)). 49:- use_module(library(option)). 50:- use_module(library(http/http_json)). 51:- use_module(library(dcg/basics)). 52
53:- use_module(wiki). 54:- use_module(messages). 55
56:- html_resource(pldoc_examples,
57 [ ordered(true),
58 requires([ jquery,
59 js('examples.js')
60 ]),
61 virtual(true)
62 ]). 63:- html_resource(css('examples.css'), []). 64
65:- multifile
66 prolog:doc_object_footer//2. 67
68prolog:(Objs, Options) -->
69 examples(Objs, Options).
70
74
75examples(Objs, _Options) -->
76 { index_examples,
77 findall(Ex-How, (member(Obj,Objs),example(Obj, Ex, How)), Refs0),
78 Refs0 \== [],
79 !,
80 keysort(Refs0, Refs),
81 group_pairs_by_key(Refs, Grouped0),
82 map_list_to_pairs(ex_score, Grouped0, Scored),
83 sort(1, >=, Scored, Sorted),
84 pairs_values(Sorted, Grouped)
85 },
86 html_requires(pldoc_examples),
87 html_requires(css('examples.css')),
88 html(div(class('ex-list'),
89 [ h4('Examples')
90 | \ex_list(Grouped)
91 ])).
92examples(_,_) -->
93 [].
94
95ex_list([One]) -->
96 { One = _File-How,
97 memberchk(file, How)
98 },
99 !,
100 ex_html(['ex-current'], One).
101ex_list(ExList) -->
102 !,
103 sequence(ex_html([]), ExList).
104
105ex_html(More, File-How) -->
106 { best_flag(How, Flag),
107 ( Flag == file
108 -> Classes = ['ex-current'|More]
109 ; Classes = More
110 )
111 },
112 html(div(class([ex|Classes]),
113 [ div(class('ex-header'),
114 [ \ex_flag(Flag),
115 \ex_title(File, How),
116 \ex_authors(File)
117 ]),
118 div(class('ex-content'),
119 \ex_content(File))
120 ])).
121
122ex_title(File, _) -->
123 { ex_prop(File, title, Title) }, !,
124 html(span(class(title), Title)).
125ex_title(File, _) -->
126 { file_title(File, Title)
127 },
128 !,
129 html(span(class(title), Title)).
130ex_title(_, _) -->
131 [].
132
133ex_authors(File) -->
134 { ex_prop(File, author, Authors) }, !,
135 sequence(ex_author, ", ", Authors).
136ex_authors(_) -->
137 [].
138
139ex_author(Author) -->
140 html(span(class(author), Author)).
141
142ex_flag(Flag) -->
143 { label(Flag, Title) },
144 html(span([ class(['ex-flag', Flag]),
145 title(Title)
146 ], '')).
147
148ex_content(File) -->
149 { ex_file_dom(File, DOM) },
150 html(DOM).
151
155
156example(PI, File, How) :-
157 example2(PI, File, How0),
158 ( How = How0
159 ; PI = Name/Arity,
160 file_base_name(File, Base),
161 ( Name == Base
162 -> How = file
163 ; atom_concat(Name, Arity, Base)
164 -> How = file
165 )
166 ).
167
168example2(PI, File, query) :-
169 ex_code(File, _, _, XRef),
170 memberchk(PI, XRef.get(query)).
171example2(PI, File, called) :-
172 ex_code(File, _, _, XRef),
173 memberchk(PI, XRef.get(called)).
174example2(PI, File, reference) :-
175 ex_prop(File, reference, PI).
176example2(PI, File, titleref) :-
177 ex_prop(File, titleref, PI).
178
179ex_score(_File-Flags, Score) :-
180 maplist(rank, Flags, Scores),
181 sum_list(Scores, Score).
182
183best_flag(Flags, Flag) :-
184 map_list_to_pairs(rank, Flags, Ranked),
185 sort(1, >, Ranked, [_Rank-Flag|_]).
186
187rank(file, 1000).
188rank(titleref, 100).
189rank(query, 30).
190rank(called, 20).
191rank(reference, 5).
192
193label(file, 'Example file for predicate').
194label(titleref, 'Mentioned in the title').
195label(query, 'Used in a query').
196label(called, 'Called in example').
197label(reference, 'Mentioned in comment').
198
199file_title(File, Title) :-
200 file_base_name(File, Base),
201 atom_codes(Base, Codes),
202 ( phrase((string(Name),integer(Arity)), Codes)
203 -> documented(Name/Arity),
204 format(string(Title), 'Examples for ~s/~d', [Name, Arity])
205 ; documented(Base/A1),
206 documented(Base/A2),
207 A1 \== A2
208 -> format(string(Title), 'Examples for ~s/N', [Base])
209 ).
210
211:- multifile
212 prolog:doc_object_summary/4. 213
214documented(PI) :-
215 prolog:doc_object_summary(PI, _Category, _Section, _Summary).
216
217
218 221
223
224:- dynamic
225 ex_code/4,
226 ex_prop/3,
227 ex_done/1,
228 ex_checked/1. 229
230
231 234
242
243index_examples :-
244 index_examples(60).
245
246index_examples(Backlog) :-
247 index_up_to_data(Backlog), !.
248index_examples(Backlog) :-
249 with_mutex(index_examples, index_examples2(Backlog)).
250
251index_examples2(Backlog) :-
252 index_up_to_data(Backlog), !.
253index_examples2(_) :-
254 transaction(reindex_examples).
255
256reindex_examples :-
257 clean_examples,
258 do_index_examples.
259
260do_index_examples :-
261 forall(ex_file(File),
262 index_example(File)),
263 get_time(Now),
264 assertz(ex_done(Now)),
265 retractall(ex_checked(_)),
266 assertz(ex_checked(Now)).
267
268index_up_to_data(Backlog) :-
269 ex_done(Indexed),
270 retract(ex_checked(Last)),
271 get_time(Now),
272 asserta(ex_checked(Now)),
273 Now-Last > Backlog,
274 ( ex_directory(Dir),
275 time_file(Dir, Modified),
276 Modified > Indexed
277 -> !, fail
278 ; true
279 ).
280
281clean_examples :-
282 retractall(ex_done(_)),
283 retractall(ex_code(_,_,_,_)),
284 retractall(ex_prop(_,_,_)).
285
286index_example(File) :-
287 ex_file_dom(File, DOM),
288 index_code(File, DOM),
289 ( dom_property(DOM, Prop, Value),
290 assertz(ex_prop(File, Prop, Value)),
291 fail
292 ; true
293 ).
294
295index_code(File, DOM) :-
296 ( call_nth(( dom_code(DOM, Code, _Attrs),
297 code_xref(Code, XRef)
298 ), N),
299 string_length(Code, Len),
300 assertz(ex_code(File, N, Len, XRef)),
301 fail
302 ; true
303 ).
304
306
307ex_xref(File, Code, XRef) :-
308 ex_file(File),
309 ex_file_dom(File, DOM),
310 dom_code(DOM, Code, _Attrs),
311 code_xref(Code, XRef).
312
316
317ex_repo(Dir) :-
318 absolute_file_name(examples(.), Dir,
319 [ file_type(directory),
320 access(read),
321 solutions(all)
322 ]).
323
324
328
329ex_file(File) :-
330 ex_repo(ExDir),
331 directory_member(ExDir, Path,
332 [ recursive(true),
333 extensions([md]),
334 access(read)
335 ]),
336 directory_file_path(ExDir, FileEx, Path),
337 file_name_extension(File, md, FileEx).
338
339ex_directory(Path) :-
340 ex_repo(ExDir),
341 ( Path = ExDir
342 ; directory_member(ExDir, Path,
343 [ recursive(true),
344 file_type(directory)
345 ])
346 ).
347
348
350
351ex_file_dom(File, DOM) :-
352 absolute_file_name(examples(File), Path,
353 [ access(read),
354 extensions([md])
355 ]),
356 wiki_file_to_dom(Path, DOM).
357
361
362dom_code(DOM, Code, Attrs) :-
363 sub_term(pre(Attrs, Code), DOM).
364
366
367dom_property(DOM, Attr, Val) :-
368 ( sub_term(H, DOM),
369 title(H, TitleDOM0)
370 -> clean_title(TitleDOM0, TitleDOM),
371 ( Attr+Val = title+TitleDOM
372 ; dom_references(TitleDOM0, Refs),
373 Attr = titleref,
374 member(Val, Refs)
375 )
376 ).
377dom_property(DOM, author, AuthorDOM) :-
378 ( sub_term(\tag(author, AuthorDOM), DOM)
379 -> true
380 ).
381dom_property(DOM, reference, Ref) :-
382 dom_references(DOM, Refs),
383 member(Ref, Refs).
384
385title(h1(_, TitleDOM), TitleDOM).
386title(h1( TitleDOM), TitleDOM).
387
388clean_title(\predref(PI), \nopredref(PI)) :-
389 !.
390clean_title(T0, T) :-
391 compound(T0),
392 !,
393 compound_name_arity(T0, Name, Arity),
394 compound_name_arity(T, Name, Arity),
395 clean_title(1, Arity, T0, T).
396clean_title(T,T).
397
398clean_title(I, Arity, T0, T) :-
399 I =< Arity,
400 !,
401 I2 is I+1,
402 arg(I, T0, A0),
403 arg(I, T, A),
404 clean_title(A0, A),
405 clean_title(I2, Arity, T0, T).
406clean_title(_, _, _, _).
407
408dom_references(DOM, Refs) :-
409 findall(Ref, dom_reference(DOM,Ref), Refs0),
410 sort(Refs0, Refs).
411
412dom_reference(DOM, Ref) :-
413 sub_term(Sub, DOM),
414 el_reference(Sub, Ref).
415
416el_reference(\predref(PI), PI).
417el_reference(\file(Text, _Path), Lib) :-
418 Lib = library(_),
419 catch(term_string(Lib, Text),
420 error(_,_), fail).
421
425
426code_xref(Code, XRef) :-
427 setup_call_cleanup(
428 open_string(Code, In),
429 read_terms(In, Terms),
430 close(In)),
431 xref_terms(Terms, XRef).
432
433read_terms(In, Terms) :-
434 stream_property(In, position(Pos0)),
435 catch(read_term(In, Term, []), E, true),
436 ( Term == end_of_file
437 -> Terms = []
438 ; var(E)
439 -> Terms = [Term|More],
440 read_terms(In, More)
441 ; set_stream_position(In, Pos0),
442 skip(In, 0'\n),
443 read_terms(In, Terms)
444 ).
445
446 449
460
461xref_terms(Terms, Result) :-
462 phrase(xref_terms(Terms), Pairs),
463 keysort(Pairs, Sorted),
464 group_pairs_by_key(Sorted, Grouped),
465 maplist(value_to_set, Grouped, GroupedSets),
466 dict_pairs(Result0, xref, GroupedSets),
467 ( exclude(built_in, Result0.get(called), Called),
468 ord_subtract(Called, Result0.get(defined), Required),
469 Required \== []
470 -> Result = Result0.put(required, Required)
471 ; Result = Result0
472 ).
473
474value_to_set(error-List, error-Set) :- !,
475 variant_set(List, Set).
476value_to_set(Key-HeadList, Key-PISet) :-
477 maplist(pi_head, PIList, HeadList),
478 sort(PIList, PISet).
479
480variant_set(List, Set) :-
481 list_to_set(List, Set1),
482 remove_variants(Set1, Set).
483
484remove_variants([], []).
485remove_variants([H|T0], [H|T]) :-
486 skip_variants(T0, H, T1),
487 remove_variants(T1, T).
488
489skip_variants([H|T0], V, T) :-
490 H =@= V, !,
491 skip_variants(T0, V, T).
492skip_variants(L, _, L).
493
494
495xref_terms([]) --> [].
496xref_terms([(?- Query), Answer|T]) --> {is_answer(Answer)}, !, xref_query(Query), xref_terms(T).
497xref_terms([H|T]) --> xref_term(H), xref_terms(T).
498
499xref_term(Var) -->
500 { var(Var) }, !.
501xref_term((Head :- Body)) --> !,
502 xref_head(Head),
503 xref_body(Body).
504xref_term((Head --> Body)) --> !,
505 xref_dcg_head(Head),
506 xref_dcg_body(Body).
507xref_term((:- Body)) --> !,
508 xref_body(Body).
509xref_term((?- Query)) --> !,
510 xref_query(Query).
511xref_term(Head) -->
512 xref_head(Head).
513
514xref_head(Term) --> { atom(Term) }, !, [defined-Term].
515xref_head(Term) --> { compound(Term), !, most_general_goal(Term,Gen) }, [defined-Gen].
516xref_head(Term) --> [ error-type_error(callable, Term) ].
517
518xref_query(Query) -->
519 xref_body(Query, query).
520
521xref_body(Body) -->
522 xref_body(Body, called).
523
524:- multifile
525 prolog:meta_goal/2. 526:- dynamic
527 prolog:meta_goal/2. 528
529xref_body(Term, _) --> { var(Term) }, !.
530xref_body(Term, Ctx) -->
531 { prolog:meta_goal(Term, Explicit),
532 !,
533 most_general_goal(Term, Called)
534 },
535 [ Ctx-Called ],
536 xref_explicit(Explicit, Ctx).
537xref_body(Term, Ctx) -->
538 { meta_head(Term, Meta), !,
539 most_general_goal(Term, Called),
540 Term =.. [_|Args],
541 Meta =.. [_|Specs]
542 },
543 [ Ctx-Called ],
544 xref_meta(Specs, Args, Ctx).
545xref_body(Term, Ctx) --> { atom(Term) }, !, [Ctx-Term].
546xref_body(Term, Ctx) --> { compound(Term), !, most_general_goal(Term,Gen) }, [Ctx-Gen].
547xref_body(Term, _Ctx) --> [ error-type_error(callable, Term) ].
548
549meta_head(Term, Meta) :-
550 predicate_property(user:Term, meta_predicate(Meta)).
551meta_head(Term, Meta) :-
552 predicate_property(M:Term, exported),
553 module_property(M, class(library)),
554 predicate_property(M:Term, meta_predicate(Meta)).
555
556xref_meta([], [], _) --> [].
557xref_meta([S|ST], [A|AT], Ctx) -->
558 xref_meta1(S, A, Ctx),
559 xref_meta(ST, AT, Ctx).
560
561xref_meta1(0, A, Ctx) --> !,
562 xref_body(A, Ctx).
563xref_meta1(^, A0, Ctx) --> !,
564 { strip_existential(A0, A) },
565 xref_body(A, Ctx).
566xref_meta1(N, A0, Ctx) -->
567 { integer(N), N > 0, !,
568 extend(A0, N, A)
569 },
570 xref_body(A, Ctx).
571xref_meta1(_, _, _) --> [].
572
573
574xref_dcg_head(Var) -->
575 { var(Var) }, !,
576 [ error-instantiation_error(Var) ].
577xref_dcg_head((A,B)) -->
578 { is_list(B) }, !,
579 xref_dcg_head(A).
580xref_dcg_head(Term) -->
581 { atom(Term), !,
582 functor(Head, Term, 2)
583 },
584 [ defined-Head ].
585xref_dcg_head(Term) -->
586 { compound(Term), !,
587 compound_name_arity(Term, Name, Arity0),
588 Arity is Arity0+2,
589 compound_name_arity(Gen, Name, Arity)
590 },
591 [ defined-Gen ].
592xref_dcg_head(Term) -->
593 [ error-type_error(callable, Term) ].
594
595xref_dcg_body(Body) -->
596 { var(Body) }, !.
597xref_dcg_body(Body) -->
598 { dcg_control(Body, Called) }, !,
599 xref_dcg_body_list(Called).
600xref_dcg_body(Terminal) -->
601 { is_list(Terminal) ; string(Terminal) }, !.
602xref_dcg_body(Term) -->
603 { atom(Term), !,
604 functor(Head, Term, 2)
605 },
606 [ called-Head ].
607xref_dcg_body(Term) -->
608 { compound(Term), !,
609 compound_name_arity(Term, Name, Arity0),
610 Arity is Arity0+2,
611 compound_name_arity(Gen, Name, Arity)
612 },
613 [ called-Gen ].
614xref_dcg_body(Term) -->
615 [ error-type_error(callable, Term) ].
616
617dcg_control((A,B), [A,B]).
618dcg_control((A;B), [A,B]).
619dcg_control((A->B), [A,B]).
620dcg_control((A*->B), [A,B]).
621dcg_control(\+(A), [A]).
622
623xref_dcg_body_list([]) --> [].
624xref_dcg_body_list([H|T]) --> xref_dcg_body(H), xref_dcg_body_list(T).
625
626xref_explicit([], _) -->
627 [].
628xref_explicit([G+N|T], Ctx) -->
629 !,
630 { extend(G,N,G1) },
631 xref_body(G1, Ctx),
632 xref_explicit(T, Ctx).
633xref_explicit([G|T], Ctx) -->
634 xref_body(G, Ctx),
635 xref_explicit(T, Ctx).
636
637
638
639strip_existential(T0, T) :-
640 ( var(T0)
641 -> T = T0
642 ; T0 = _^T1
643 -> strip_existential(T1, T)
644 ; T = T0
645 ).
646
647extend(T0, N, T) :-
648 atom(T0), !,
649 length(Args, N),
650 T =.. [T0|Args].
651extend(T0, N, T) :-
652 compound(T0),
653 compound_name_arguments(T0, Name, Args0),
654 length(Extra, N),
655 append(Args0, Extra, Args),
656 compound_name_arguments(T, Name, Args).
657
658built_in(PI) :-
659 pi_head(PI, Head),
660 predicate_property(Head, built_in).
661
662is_answer(Answer) :-
663 var(Answer),
664 !,
665 fail.
666is_answer((A;B)) :-
667 !,
668 is_1answer(A),
669 is_answer(B).
670is_answer(A) :-
671 is_1answer(A).
672
673is_1answer(X) :- var(X), !, fail.
674is_1answer(true) :- !.
675is_1answer(false) :- !.
676is_1answer((A,B)) :-
677 !,
678 is_binding_or_constraint(A),
679 is_1answer(B).
680is_1answer(A) :-
681 is_binding_or_constraint(A).
682
683is_binding_or_constraint(Var) :-
684 var(Var), !,
685 fail.
686is_binding_or_constraint(Var = _) :-
687 !,
688 var(Var). 689is_binding_or_constraint(:-_) :- !, fail.
690is_binding_or_constraint(?-_) :- !, fail.
691is_binding_or_constraint(_). 692
693
694 697
701
702pull_examples :-
703 ( ex_repo(ExDir),
704 is_git_directory(ExDir),
705 git([pull], [directory(ExDir)]),
706 fail
707 ; true
708 ),
709 index_examples(1).
710
711
712 715
716:- http_handler(root(examples/pull), pull_examples, []). 717
718pull_examples(Request) :-
719 ( option(method(post), Request)
720 -> http_read_json(Request, JSON),
721 print_message(informational, got(JSON))
722 ; true
723 ),
724 call_showing_messages(pull_examples, [])