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