View source with formatted comments or as raw
    1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2014-2018, VU University Amsterdam
    7			      CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(swish_examples, []).   37:- use_module(library(http/http_dispatch)).   38:- use_module(library(http/http_json)).   39:- use_module(library(http/json)).   40:- use_module(library(http/http_path)).   41:- use_module(library(filesex)).   42:- use_module(library(apply)).   43:- use_module(library(option)).   44:- use_module(library(lists)).   45:- if(exists_source(library(atom))).   46:- use_module(library(atom)).   47:- endif.   48
   49:- use_module(storage).   50:- use_module(md_eval).   51
   52/** <module> Serve example files
   53
   54Locate and serve files for  the  _Examples_   menu  as  well as examples
   55included from overview notebooks. The examples come from two sources:
   56
   57  - Prolog files in the file search path `examples`.  Such files are
   58    distributed with SWISH.
   59  - Gitty files marked as `example`.  Such files can be created by the
   60    users.
   61
   62This  module  also  makes   the    known   examples   available  through
   63swish_provides/1  for  supporting  conditional   statements  on  example
   64overview notebooks.
   65*/
   66
   67:- multifile
   68	user:file_search_path/2,
   69	swish_config:config/2,
   70	swish_config:source_alias/2.   71
   72% make example(File) find the example data
   73user:file_search_path(example, swish(examples)).
   74user:file_search_path(example, swish(examples/inference)).
   75user:file_search_path(example, swish(examples/learning)).
   76user:file_search_path(example, swish(examples/lemur)).
   77user:file_search_path(example, swish(examples/phil)).
   78user:file_search_path(example, swish(examples/aleph)).
   79user:file_search_path(example, swish(examples/pascal)).
   80
   81user:file_search_path(e, swish(examples)).
   82user:file_search_path(e, swish(examples/inference)).
   83user:file_search_path(e, swish(examples/learning)).
   84user:file_search_path(e, swish(examples/lemur)).
   85user:file_search_path(e, swish(examples/phil)).
   86user:file_search_path(e, swish(examples/aleph)).
   87user:file_search_path(e, swish(examples/pascal)).
   88
   89
   90% make SWISH serve /example/File as example(File).
   91swish_config:source_alias(example, [access(read), search('*.{pl,swinb}')]).
   92swish_config:source_alias(e, [access(read), search('*.{pl,swinb}')]).
   93
   94:- http_handler(swish(list_examples),
   95		list_examples, [id(swish_examples)]).   96
   97
   98%%	list_examples(+Request)
   99%
  100%	Get a list of registered example code. Examples are described in
  101%	a file swish_examples('index.json').
  102
  103list_examples(_Request) :-
  104	examples(AllExamples, [community(true)]),
  105	example_menu(AllExamples, Menu),
  106	reply_json(Menu).
  107
  108example_menu(AllExamples, Menu) :-
  109	include(pos_ranked, AllExamples, ForMenu),
  110	insert_group_dividers(ForMenu, Menu).
  111
  112pos_ranked(Ex) :-
  113	Rank = Ex.get(grank),
  114	Rank > 0.
  115
  116insert_group_dividers([], []).
  117insert_group_dividers([H1,H2|T], List) :-
  118	!,
  119	(   H1.grank // 10000 =\= H2.grank // 10000
  120	->  List = [H1, json{type:divider}|Rest]
  121	;   List = [H1|Rest]
  122	),
  123	insert_group_dividers([H2|T], Rest).
  124insert_group_dividers([H], [H]).
  125
  126
  127%%	examples(JSON:list, +Options) is det.
  128%
  129%	JSON is a list of JSON dicts containing the keys below. The list
  130%	is composed from all *.pl files in the search path `example`.
  131%
  132%	  - file:File
  133%	  - href:URL
  134%	  - title:String
  135%	  - requires:Term
  136%	  - group:String
  137
  138examples(AllExamples, Options) :-
  139	swish_examples(SWISHExamples),
  140	(   option(community(true), Options)
  141	->  community_examples(CommunityEx)
  142	;   CommunityEx = json{}
  143	),
  144	join_examples([CommunityEx|SWISHExamples], AllExamples).
  145
  146:- dynamic
  147	swish_example_cache/2.  148
  149swish_examples(SWISHExamples) :-
  150	swish_example_cache(SWISHExamples, Time),
  151	get_time(Now),
  152	Now - Time < 60,
  153	!.
  154swish_examples(SWISHExamples) :-
  155	swish_examples_no_cache(SWISHExamples),
  156	get_time(Now),
  157	retractall(swish_example_cache(_,_)),
  158	assertz(swish_example_cache(SWISHExamples, Now)).
  159
  160swish_examples_no_cache(SWISHExamples) :-
  161	http_absolute_location(swish(example), HREF, []),
  162	findall(Index,
  163		absolute_file_name(example(.), Index,
  164				   [ access(read),
  165				     file_type(directory),
  166				     file_errors(fail),
  167				     solutions(all)
  168				   ]),
  169		ExDirs),
  170	maplist(index_json(HREF), ExDirs, SWISHExamples).
  171
  172
  173join_examples(PerDir, Files) :-
  174	menu_groups(PerDir, Groups),
  175	maplist(get_or(files, []), PerDir, FilesPerDir),
  176	append(FilesPerDir, Files0),
  177	maplist(add_grank(Groups), Files0, Files1),
  178	sort(grank, =<, Files1, Files).
  179
  180add_grank(Groups, File0, File) :-
  181	get_or(rank,  500,  File0, FRank),
  182	GroupName = File0.get(group),
  183	member(Group, Groups),
  184	Group.get(group) == GroupName,
  185	GRank is FRank + Group.get(rank), !,
  186	File = File0.put(grank, GRank).
  187add_grank(_, File0, File) :-
  188	File = File0.put(grank, -1).
  189
  190menu_groups(PerDir, Groups) :-
  191	maplist(get_or(menu, []), PerDir, GroupsPerDir),
  192	append(GroupsPerDir, Groups0),
  193	sort(group, @>, Groups0, Groups1),
  194	sort(rank,  =<, Groups1, Groups).
  195
  196get_or(Key, Default, Dict, Value) :-
  197	(   is_dict(Dict),
  198	    Value = Dict.get(Key)
  199	->  true
  200	;   Value = Default
  201	).
  202
  203%!	index_json(+BaseHREF, +Directory, -JSON)
  204%
  205%	Produce a JSON description for  the   examples  in the directory
  206%	Dir. This deals with two scenarios:   if  a file `index.json` is
  207%	provided, use this file  and  add   the  not-described  files as
  208%	examples that are not included in   the menu. If no `index.json`
  209%	is present, all files are added as example files.
  210
  211index_json(HREF, Dir, JSON) :-
  212	directory_file_path(Dir, 'index.json', File),
  213	access_file(File, read), !,
  214	read_file_to_json(File, JSON0),
  215	add_examples_href(HREF, JSON0, JSON1),
  216	add_other_files(HREF, Dir, JSON1, JSON).
  217index_json(HREF, Dir, json{menu:[json{group:examples, rank:10000}],
  218			   files:Files}) :-
  219	example_files(HREF, Dir, Files0),
  220	maplist(add_group(examples), Files0, Files).
  221
  222example_files(HREF, Dir, JSON) :-
  223	string_concat(Dir, "/*.{pl,swinb}", Pattern),
  224	expand_file_name(Pattern, Files),
  225	maplist(ex_file_json(HREF), Files, JSON).
  226
  227read_file_to_json(File, JSON) :-
  228	setup_call_cleanup(
  229	    open(File, read, In, [encoding(utf8)]),
  230	    json_read_dict(In, JSON, [default_tag(json)]),
  231	    close(In)).
  232
  233%!	add_examples_href(+HREF, +JSON0, -JSON) is det.
  234%
  235%	Add a `href` key pointing at the example. Also removes all items
  236%	that are not dicts or have no `file` key.
  237
  238add_examples_href(HREF, JSON0, JSON) :-
  239	Files0 = JSON0.get(files), !,
  240	convlist(add_href(HREF), Files0, Files),
  241	JSON = JSON0.put(files, Files).
  242add_examples_href(_, JSON, JSON).
  243
  244
  245add_href(HREF0, Dict, Dict2) :-
  246	is_dict(Dict),
  247	directory_file_path(HREF0, Dict.get(file), HREF),
  248	Dict2 = Dict.put(href, HREF).
  249
  250add_group(Group, Dict0, Dict) :-
  251	is_dict(Dict0), !,
  252	Dict = Dict0.put(group, Group).
  253add_group(_, Dict, Dict).
  254
  255add_other_files(HREF, Dir, JSON0, JSON) :-
  256	example_files(HREF, Dir, Files),
  257	get_or(files, [], JSON0, Files0),
  258	exclude(in_ex_list(Files0), Files, New),
  259	append(Files0, New, AllFiles),
  260	JSON = JSON0.put(files, AllFiles).
  261
  262in_ex_list(Examples, Ex) :-
  263	File = Ex.file,
  264	member(Ex2, Examples),
  265	is_dict(Ex2),
  266	File = Ex2.get(file),
  267	!.
  268
  269%%	ex_file_json(+ExampleBase, +Path, -JSON) is det.
  270%
  271%	Create a JSON representation for the given example file.
  272
  273ex_file_json(HREF0, Path, json{file:File, href:HREF, title:Title}) :-
  274	file_base_name(Path, File),
  275	file_name_extension(Base, _, File),
  276	file_name_to_title(Base, Title),
  277	directory_file_path(HREF0, File, HREF).
  278
  279:- if(current_predicate(restyle_identifier/3)).  280file_name_to_title(Base, Title) :-
  281	restyle_identifier(style(true,false,' '), Base, Title).
  282:- else.  283file_name_to_title(Base, Base).
  284:- endif.  285
  286
  287%!	md_eval:provides(?Term) is nondet.
  288%
  289%	Make examples available through swish_provides/1. Can be used in
  290%	dynamic cells as, e.g.,:
  291%
  292%	  ```
  293%	  :- if(swish_provides(example('chat80.pl',_,_))).
  294%	  ...
  295%	  :- endif.
  296%	  ```
  297
  298:- multifile
  299	md_eval:provides/1.  300
  301md_eval:provides(example(Name, Group, Example)) :-
  302	examples(Examples, []),
  303	(   var(Name)
  304	->  member(Example0, Examples),
  305	    atom_string(Name, Example0.get(file))
  306	;   member(Example0, Examples),
  307	    atom_string(Name, Example0.get(file))
  308	->  true
  309	),
  310	atom_string(Group,  Example0.get(group)),
  311	active_example(Example0, Example).
  312
  313active_example(Example0, Example) :-
  314	term_string(Cond, Example0.get(requires)),
  315	\+ swish_provides(Cond),
  316	(   cond_reason(Cond, Fmt, Args)
  317	->  format(string(Reason), Fmt, Args)
  318	;   format(string(Reason), 'missing requirement: ~q', [Cond])
  319	),
  320	Example = Example0.put(blocked, Reason).
  321active_example(Example, Example).
  322
  323cond_reason(plugin(Name), 'missing plugin: ~w', [Name]).
  324
  325
  326
  327		 /*******************************
  328		 *	      STORAGE		*
  329		 *******************************/
  330
  331%%	community_examples(-Dict) is det.
  332%
  333%	Extract examples from the gitty store.
  334
  335community_examples(json{menu:[json{group:community, rank:50000}],
  336			files:Files}) :-
  337	swish_config:config(community_examples, true),
  338	!,
  339	findall(Ex, community_example(Ex), Files).
  340community_examples(json{}).
  341
  342community_example(json{title:Title, file:File, group:community, type:store}) :-
  343	storage_file_extension_head(File, _Type, Head),
  344	storage_commit(Head, Meta),
  345	Meta.get(example) == true,
  346	(   Title = Meta.get(title), Title \== ""
  347	->  true
  348	;   file_name_extension(Base, _, File),
  349	    file_name_to_title(Base, Title)
  350	)