1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: jan@swi-prolog.org 5 WWW: https://www.swi-prolog.org 6 Copyright (C): 2020-2023, SWI-Prolog Solutions b.v. 7 8 This program is free software; you can redistribute it and/or 9 modify it under the terms of the GNU General Public License 10 as published by the Free Software Foundation; either version 2 11 of the License, or (at your option) any later version. 12 13 This program is distributed in the hope that it will be useful, 14 but WITHOUT ANY WARRANTY; without even the implied warranty of 15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 GNU General Public License for more details. 17 18 You should have received a copy of the GNU General Public 19 License along with this library; if not, write to the Free Software 20 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 21 22 As a special exception, if you link this library with other files, 23 compiled with a Free Software compiler, to produce an executable, this 24 library does not by itself cause the resulting executable to be covered 25 by the GNU General Public License. This exception does not however 26 invalidate any other reasons why the executable file might be covered by 27 the GNU General Public License. 28*/ 29 30:- module(examples, 31 [ ex_xref/3, % Id,Code,XRef 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).
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 File) (--> 134 { ex_prop(File, author, Authors) }, !, 135 sequence(ex_author, ", ", Authors). 136ex_authors(_) --> 137 []. 138 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).
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 /******************************* 219 * DB * 220 *******************************/
224:- dynamic 225 ex_code/4, 226 ex_prop/3, 227 ex_done/1, 228 ex_checked/1. 229 230 231 /******************************* 232 * INDEX * 233 *******************************/
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 ).
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).
317ex_repo(Dir) :-
318 absolute_file_name(examples(.), Dir,
319 [ file_type(directory),
320 access(read),
321 solutions(all)
322 ]).
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 ).
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).
362dom_code(DOM, Code, Attrs) :-
363 sub_term(pre(Attrs, Code), DOM).
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).
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 /******************************* 447 * XREF * 448 *******************************/
Note that XRef.required is XRef.called \ built-in \XRef.defined.
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). % often shares with query 689is_binding_or_constraint(:-_) :- !, fail. 690is_binding_or_constraint(?-_) :- !, fail. 691is_binding_or_constraint(_). % how to find out? 692 693 694 /******************************* 695 * UPDATE * 696 *******************************/
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 /******************************* 713 * HTTP * 714 *******************************/ 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, [])