swish/commit
Updated Prolog files
author | Jan Wielemaker |
---|---|
Mon Jan 19 18:34:39 2015 +0100 | |
committer | Jan Wielemaker |
Mon Jan 19 18:34:39 2015 +0100 | |
commit | bee7912d643372fb6ffd8ec84b9e16428b556e47 |
tree | d0de09d1efb133af71262223a196b37537360b81 |
parent | d230fbad545e412fa2c38ef549331fa443455794 |
Diff style: patch stat
diff --git a/lib/swish/config.pl b/lib/swish/config.pl index 28e7756..5f089d5 100644 --- a/lib/swish/config.pl +++ b/lib/swish/config.pl @@ -3,7 +3,7 @@ Author: Jan Wielemaker E-mail: J.Wielemaker@cs.vu.nl WWW: http://www.swi-prolog.org - Copyright (C): 2014, VU University Amsterdam + Copyright (C): 2014-2015, VU University Amsterdam This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License @@ -28,7 +28,8 @@ */ :- module(swish_config, - [ swish_reply_config/1 + [ swish_reply_config/1, % +Request + swish_config_hash/1 % -HASH ]). :- use_module(library(http/http_dispatch)). :- use_module(library(http/http_json)). @@ -49,12 +50,23 @@ swish_reply_config(Request) :- option(path(Path), Request), file_base_name(Path, 'swish_config.json'), + json_config(JSON), + reply_json(JSON). + +%% swish_config_hash(-Hash) is det. +% +% True if Hash is the SHA1 of the SWISH config. + +swish_config_hash(Hash) :- + json_config(Config), + variant_sha1(Config, Hash). + +json_config(json{ http: json{ locations:JSON + }, + swish: SWISHConfig + }) :- http_locations(JSON), - swish_config(SWISHConfig), - reply_json(json{ http: json{ locations:JSON - }, - swish: SWISHConfig - }). + swish_config(SWISHConfig). http_locations(JSON) :- findall(ID-Path, diff --git a/lib/swish/form.pl b/lib/swish/form.pl new file mode 100644 index 0000000..3ca44e7 --- /dev/null +++ b/lib/swish/form.pl @@ -0,0 +1,43 @@ +/* Part of SWI-Prolog + + Author: Jan Wielemaker + E-mail: J.Wielemaker@cs.vu.nl + WWW: http://www.swi-prolog.org + Copyright (C): 2014, VU University Amsterdam + + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation; either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + As a special exception, if you link this library with other files, + compiled with a Free Software compiler, to produce an executable, this + library does not by itself cause the resulting executable to be covered + by the GNU General Public License. This exception does not however + invalidate any other reasons why the executable file might be covered by + the GNU General Public License. +*/ + +:- module(swish_form, []). +:- use_module(library(http/http_dispatch)). +:- use_module(library(http/http_server_files)). + +/** <module> Show forms in SWISH + +This module serves forms for SWISH. +*/ + +:- http_handler(swish(form), serve_files_in_directory(swish_form), + [id(form),prefix]). + +user:file_search_path(swish_form, swish(web/form)). + diff --git a/lib/swish/gitty.pl b/lib/swish/gitty.pl index 768b5f3..a8d0187 100644 --- a/lib/swish/gitty.pl +++ b/lib/swish/gitty.pl @@ -3,7 +3,7 @@ Author: Jan Wielemaker E-mail: J.Wielemaker@cs.vu.nl WWW: http://www.swi-prolog.org - Copyright (C): 2014, VU University Amsterdam + Copyright (C): 2015, VU University Amsterdam This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License @@ -33,9 +33,12 @@ gitty_update/5, % +Store, +Name, +Data, +Meta, -Commit gitty_commit/3, % +Store, +Name, -Meta gitty_data/4, % +Store, +Name, -Data, -Meta - gitty_history/4, % +Store, +Name, +Max, -History + gitty_history/4, % +Store, +Name, -History, +Options gitty_scan/1, % +Store gitty_hash/2, % +Store, ?Hash + gitty_reserved_meta/1, % ?Key + + gitty_diff/4, % +Store, ?Start, +End, -Diff data_diff/3, % +String1, +String2, -Diff udiff_string/2 % +Diff, -String @@ -45,6 +48,9 @@ :- use_module(library(sha)). :- use_module(library(lists)). :- use_module(library(apply)). +:- use_module(library(option)). +:- use_module(library(process)). +:- use_module(library(debug)). :- use_module(library(dcg/basics)). /** <module> Single-file GIT like version system @@ -89,6 +95,8 @@ gitty_file(Store, Head, Hash) :- %% gitty_create(+Store, +Name, +Data, +Meta, -Commit) is det. % % Create a new object Name from Data and meta information. +% +% @arg Commit is a dit describing the new Commit gitty_create(Store, Name, _Data, _Meta, _) :- gitty_scan(Store), @@ -123,7 +131,7 @@ gitty_update(Store, Name, Data, Meta, CommitRet) :- -> true ; throw(error(gitty(commit_version(OldHead, Meta.previous)), _)) ), - load_commit(Store, OldHead, OldMeta), + load_plain_commit(Store, OldHead, OldMeta), get_time(Now), save_object(Store, Data, blob, Hash), Commit = gitty{}.put(OldMeta) @@ -158,7 +166,8 @@ gitty_data(Store, Hash, Data, Meta) :- %% gitty_commit(+Store, +NameOrHash, -Meta) is semidet. % -% True if Meta holds the commit data of NameOrHash. +% True if Meta holds the commit data of NameOrHash. A key =commit= +% is added to the meta-data to specify the commit hash. gitty_commit(Store, Name, Meta) :- gitty_scan(Store), @@ -167,31 +176,79 @@ gitty_commit(Store, Name, Meta) :- gitty_commit(Store, Hash, Meta) :- load_commit(Store, Hash, Meta). +load_commit(Store, Hash, Meta) :- + load_plain_commit(Store, Hash, Meta0), + Meta1 = Meta0.put(commit, Hash), + ( head(Store, Meta0.name, Hash) + -> Meta = Meta1.put(symbolic, "HEAD") + ; Meta = Meta1 + ). -load_commit(Store, Head, Meta) :- - load_object(Store, Head, String), +load_plain_commit(Store, Hash, Meta) :- + load_object(Store, Hash, String), term_string(Meta, String, []). -%% gitty_history(+Store, +NameOrHash, +Max, -History) is det. +%% gitty_history(+Store, +NameOrHash, -History, +Options) is det. % % History is a list of dicts representating the history of Name in -% Store. +% Store. Options: +% +% - depth(+Depth) +% Number of entries in the history. If not present, defaults +% to 5. +% - includes(+HASH) +% Ensure Hash is included in the history. This means that the +% history includes the entry with HASH an (depth+1)//2 entries +% after the requested HASH. + +gitty_history(Store, Name, History, Options) :- + history_hash_start(Store, Name, Hash0), + option(depth(Depth), Options, 5), + ( option(includes(Hash), Options) + -> read_history_to_hash(Store, Hash0, Hash, History0), + length(History0, Before), + After is max(Depth-Before, (Depth+1)//2), + read_history_depth(Store, Hash, After, History1), + append(History0, History1, History2), + list_prefix(Depth, History2, History) + ; read_history_depth(Store, Hash0, Depth, History) + ). -gitty_history(Store, Name, Max, [Meta|History]) :- +history_hash_start(Store, Name, Hash) :- gitty_scan(Store), head(Store, Name, Head), !, - load_commit(Store, Head, Meta), - history(Store, Meta, Max, History). -gitty_history(Store, Hash, Max, [Meta|History]) :- - load_commit(Store, Hash, Meta), - history(Store, Meta, Max, History). + Hash = Head. +history_hash_start(_, Hash, Hash). + + +read_history_depth(_, _, 0, []) :- !. +read_history_depth(Store, Hash, Left, [H|T]) :- + load_commit(Store, Hash, H), !, + Left1 is Left-1, + ( read_history_depth(Store, H.get(previous), Left1, T) + -> true + ; T = [] + ). +read_history_depth(_, _, _, []). + +%% read_history_to_hash(+Store, +Start, +Upto, -History) +% +% Read the history upto, but NOT including Upto. +read_history_to_hash(Store, Hash, Upto, [H|T]) :- + Upto \== Hash, + load_commit(Store, Hash, H), + ( read_history_to_hash(Store, H.get(previous), Upto, T) + -> true + ; T = [] + ). +read_history_to_hash(_, _, _, []). -history(Store, Meta, Max, [Prev|History]) :- - succ(Max1, Max), - load_commit(Store, Meta.get(previous), Prev), !, - history(Store, Prev, Max1, History). -history(_, _, _, []). +list_prefix(0, _, []) :- !. +list_prefix(_, [], []) :- !. +list_prefix(N, [H|T0], [H|T]) :- + N2 is N - 1, + list_prefix(N2, T0, T). %% save_object(+Store, +Data, +Type, -Hash) @@ -303,6 +360,7 @@ gitty_scan_sync(Store) :- gitty_hash(Store, Hash) :- var(Hash), !, + access_file(Store, exist), directory_files(Store, Level0), member(E0, Level0), E0 \== '..', @@ -335,11 +393,120 @@ hash_file(Store, Hash, Path) :- sub_atom(Hash, 4, _, 0, File), atomic_list_concat([Store, Dir0, Dir1, File], /, Path). +%% gitty_reserved_meta(?Key) is nondet. +% +% True when Key is a gitty reserved key for the commit meta-data + +gitty_reserved_meta(name). +gitty_reserved_meta(time). +gitty_reserved_meta(data). +gitty_reserved_meta(previous). + /******************************* * DIFF * *******************************/ +%% gitty_diff(+Store, ?Hash1, +FileOrHash2, -Dict) is det. +% +% True if Dict representeds the changes in Hash1 to FileOrHash2. +% If Hash1 is unbound, it is unified with the `previous` of +% FileOrHash2. Returns _{initial:true} if Hash1 is unbound and +% FileOrHash2 is the initial commit. Dict contains: +% +% - from:Meta1 +% - to:Meta2 +% Meta-data for the two diffed versions +% - data:UDiff +% String holding unified diff representation of changes to the +% data. Only present of data has changed +% - tags:_{added:AddedTags, deleted:DeletedTags} +% If tags have changed, the added and deleted ones. + +gitty_diff(Store, C1, C2, Dict) :- + gitty_data(Store, C2, Data2, Meta2), + ( var(C1) + -> C1 = Meta2.get(previous) + ; true + ), !, + gitty_data(Store, C1, Data1, Meta1), + Pairs = [ from-Meta1, to-Meta2|_], + ( Data1 \== Data2 + -> udiff_string(Data1, Data2, UDIFF), + memberchk(data-UDIFF, Pairs) + ; true + ), + meta_tag_set(Meta1, Tags1), + meta_tag_set(Meta2, Tags2), + ( Tags1 \== Tags2 + -> ord_subtract(Tags1, Tags2, Deleted), + ord_subtract(Tags2, Tags1, Added), + memberchk(tags-_{added:Added, deleted:Deleted}, Pairs) + ; true + ), + once(length(Pairs,_)), % close list + dict_pairs(Dict, json, Pairs). +gitty_diff(_Store, '0000000000000000000000000000000000000000', _C2, + json{initial:true}). + + +meta_tag_set(Meta, Tags) :- + sort(Meta.get(tags), Tags), !. +meta_tag_set(_, []). + +%% udiff_string(+Data1, +Data2, -UDIFF) is det. +% +% Produce a unified difference between two strings. Note that we +% can avoid one temporary file using diff's `-` arg and the second +% by passing =/dev/fd/NNN= on Linux systems. See +% http://stackoverflow.com/questions/3800202 + +:- if(true). + +udiff_string(Data1, Data2, UDIFF) :- + setup_call_cleanup( + save_string(Data1, File1), + setup_call_cleanup( + save_string(Data2, File2), + process_diff(File1, File2, UDIFF), + delete_file(File2)), + delete_file(File1)). + +save_string(String, File) :- + tmp_file_stream(utf8, File, TmpOut), + format(TmpOut, '~s', [String]), + close(TmpOut). + +process_diff(File1, File2, String) :- + setup_call_cleanup( + process_create(path(diff), + ['-u', file(File1), file(File2)], + [ stdout(pipe(Out)), + process(PID) + ]), + read_string(Out, _, String), + ( close(Out), + process_wait(PID, Status) + )), + assertion(normal_diff_exit(Status)). + +normal_diff_exit(exit(0)). % equal +normal_diff_exit(exit(1)). % different + +:- else. + +udiff_string(Data1, Data2, UDIFF) :- + data_diff(Data1, Data2, Diffs), + maplist(udiff_string, Diffs, Strings), + atomics_to_string(Strings, UDIFF). + +:- endif. + + + /******************************* + * PROLOG DIFF * + *******************************/ + /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Attempt at a built-in diff utility. Doing it in Prolog may seem weird, but is good for tasting ones own dog food. In addition, it avoids @@ -368,11 +535,11 @@ different solution for the real thing. Options are: % `Diff` is a list holding % % - +(Line) -% Line as added to Data1 to get Data2 +% Line was added to Data1 to get Data2 % - -(Line) % Line was deleted from Data1 to get Data2 % - -(Line1,Line2) -% Line as replaced +% Line was replaced % - =(Line) % Line is identical (context line). @@ -476,7 +643,7 @@ block_lines(=(U), Lines) :- maplist(string_concat(' '), U, Lines). block_lines(+(U), Lines) :- maplist(string_concat('+'), U, Lines). block_lines(-(U), Lines) :- maplist(string_concat('-'), U, Lines). -udiff_blocks([], []). +udiff_blocks([], []) :- !. udiff_blocks([=(H)|T0], [=([H|E])|T]) :- !, udiff_cp(T0, E, T1), udiff_blocks(T1, T). diff --git a/lib/swish/highlight.pl b/lib/swish/highlight.pl index 7c66b0c..884c8be 100644 --- a/lib/swish/highlight.pl +++ b/lib/swish/highlight.pl @@ -301,19 +301,6 @@ destroy_state_module(UUID) :- destroy_state_module(_). -%% master_load_file(+File, +Seen, -MasterFile) is det. -% -% If file is included into another file, find the outermost file. -% This is the file that needs to be reloaded instead of reloading -% File. - -master_load_file(File0, Seen, File) :- - source_file_property(File0, included_in(File1, _Line)), - \+ memberchk(File1, Seen), !, - master_load_file(File1, [File0|Seen], File). -master_load_file(File, _, File). - - /******************************* * SERVER TOKENS * *******************************/ diff --git a/lib/swish/page.pl b/lib/swish/page.pl index 6d46605..145e9ac 100644 --- a/lib/swish/page.pl +++ b/lib/swish/page.pl @@ -50,7 +50,11 @@ :- use_module(library(debug)). :- use_module(library(time)). :- use_module(library(option)). + :- use_module(config). +:- use_module(help). +:- use_module(form). +:- use_module(search). /** <module> Provide the SWISH application as Prolog HTML component @@ -59,7 +63,9 @@ grammer rules. This allows for server-side generated pages to include swish or parts of swish easily into a page. */ -:- http_handler(swish(.), swish_reply([]), [id(swish), prefix]). +http:location(pldoc, swish(pldoc), [priority(100)]). + +:- http_handler(swish(.), swish_reply([]), [id(swish), prefix, priority(100)]). :- multifile swish_config:source_alias/1, @@ -89,26 +95,34 @@ swish_reply(SwishOptions, Request) :- Params = [ code(_, [optional(true)]), background(_, [optional(true)]), examples(_, [optional(true)]), - q(_, [optional(true)]) + q(_, [optional(true)]), + format(_, [oneof([swish,raw]), default(swish)]) ], http_parameters(Request, Params), params_options(Params, Options0), merge_options(Options0, SwishOptions, Options1), - source_option(Request, Options1, Options), - ( swish_config:reply_page(Options) - -> true - ; reply_html_page( - swish(main), - [ title('SWISH -- SWI-Prolog for SHaring'), - link([ rel('shortcut icon'), - href('/icons/favicon.ico') - ]), - link([ rel('apple-touch-icon'), - href('/icons/swish-touch-icon.png') - ]) - ], - \swish_page(Options)) - ). + source_option(Request, Options1, Options2), + swish_reply1(Options2). + +swish_reply1(Options) :- + option(code(Code), Options), + option(format(raw), Options), !, + format('Content-type: text/x-prolog~n~n'), + format('~s~n', [Code]). +swish_reply1(Options) :- + swish_config:reply_page(Options), !. +swish_reply1(Options) :- + reply_html_page( + swish(main), + [ title('SWISH -- SWI-Prolog for SHaring'), + link([ rel('shortcut icon'), + href('/icons/favicon.ico') + ]), + link([ rel('apple-touch-icon'), + href('/icons/swish-touch-icon.png') + ]) + ], + \swish_page(Options)). params_options([], []). params_options([H0|T0], [H|T]) :- @@ -126,7 +140,8 @@ params_options([_|T0], T) :- % Alias(File). source_option(_Request, Options, Options) :- - option(code(_), Options), !. + option(code(_), Options), + option(format(swish), Options), !. source_option(Request, Options0, Options) :- option(path_info(Info), Request), Info \== 'index.html', !, % Backward compatibility @@ -165,6 +180,7 @@ serve_resource(Request) :- resource_prefix('css/'). resource_prefix('help/'). +resource_prefix('form/'). resource_prefix('icons/'). resource_prefix('js/'). resource_prefix('bower_components/'). @@ -181,28 +197,57 @@ swish_page(Options) --> % % Generate the swish navigation bar. -swish_navbar(_Options) --> +swish_navbar(Options) --> swish_resources, - html(header(class([navbar, 'navbar-default']), - div(class([container, 'pull-left']), - [ div(class('navbar-header'), - \swish_logos), - nav(id(navbar), []) - ]))). - -swish_logos --> - pengine_logo, - swish_logo. - -pengine_logo --> + html(nav([ class([navbar, 'navbar-default']), + role(navigation) + ], + [ div(class('navbar-header'), + [ \collapsed_button, + \swish_logos(Options) + ]), + div([ class([collapse, 'navbar-collapse']), + id(navbar) + ], + [ ul([class([nav, 'navbar-nav'])], []), + \search_form(Options) + ]) + ])). + +collapsed_button --> + html(button([type(button), + class('navbar-toggle'), + 'data-toggle'(collapse), + 'data-target'('#navbar') + ], + [ span(class('sr-only'), 'Toggle navigation'), + span(class('icon-bar'), []), + span(class('icon-bar'), []), + span(class('icon-bar'), []) + ])). + +swish_logos(Options) --> + pengine_logo(Options), + swish_logo(Options). + +pengine_logo(_Options) --> { http_absolute_location(root(.), HREF, []) }, html(a([href(HREF), class('pengine-logo')], &(nbsp))). -swish_logo --> +swish_logo(_Options) --> { http_absolute_location(swish('index.html'), HREF, []) }, html(a([href(HREF), class('swish-logo')], &(nbsp))). +%% search_form(+Options)// +% +% Add search box to the navigation bar + +search_form(Options) --> + html(div(class(['col-sm-3', 'col-md-3', 'pull-right']), + \search_box(Options))). + + %% swish_content(+Options)// % % Generate the SWISH editor, Prolog output area and query editor. @@ -213,6 +258,7 @@ swish_logo --> swish_content(Options) --> swish_resources, + swish_config_hash, html(div([id(content), class([container, swish])], [ div([class([tile, horizontal]), 'data-split'('50%')], [ div(class('prolog-editor'), \source(Options)), @@ -225,6 +271,21 @@ swish_content(Options) --> \examples(Options) ])). + +%% swish_config_hash// +% +% Set `window.swish.config_hash` to a hash that represents the +% current configuration. This is used by config.js to cache the +% configuration in the browser's local store. + +swish_config_hash --> + { swish_config_hash(Hash) }, + js_script({|javascript(Hash)|| + window.swish = window.swish||{}; + window.swish.config_hash = Hash; + |}). + + %% source(+Options)// % % Associate the source with the SWISH page. The source itself is @@ -245,6 +306,7 @@ source(Options) --> ; Extra = [] ) }, + source_meta_data(File, Options), html(textarea([ class([source,prolog]), style('display:none') | Extra @@ -252,6 +314,19 @@ source(Options) --> Source)). source(_) --> []. +%% source_meta_data(+File, +Options)// +% +% Dump the meta-data of the provided file into swish.meta_data. + +source_meta_data(File, Options) --> + { nonvar(File), + option(meta(Meta), Options) + }, !, + js_script({|javascript(Meta)|| + window.swish = window.swish||{}; + window.swish.meta_data = Meta; + |}). +source_meta_data(_, _) --> []. background(Options) --> { option(background(Spec), Options), !, diff --git a/lib/swish/search.pl b/lib/swish/search.pl new file mode 100644 index 0000000..794a300 --- /dev/null +++ b/lib/swish/search.pl @@ -0,0 +1,106 @@ +/* Part of SWI-Prolog + + Author: Jan Wielemaker + E-mail: J.Wielemaker@cs.vu.nl + WWW: http://www.swi-prolog.org + Copyright (C): 2015, VU University Amsterdam + + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation; either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + As a special exception, if you link this library with other files, + compiled with a Free Software compiler, to produce an executable, this + library does not by itself cause the resulting executable to be covered + by the GNU General Public License. This exception does not however + invalidate any other reasons why the executable file might be covered by + the GNU General Public License. +*/ + +:- module(swish_search, + [ search_box//1 % +Options + ]). +:- use_module(library(http/html_write)). +:- use_module(library(http/http_dispatch)). +:- use_module(library(http/http_parameters)). +:- use_module(library(http/http_json)). + +:- multifile + typeahead/3. % +Set, +Query, -Match + +/** <module> SWISH search from the navigation bar + +This library supports both typeahead of the search box and the actual +search from the server side. What do we want to search for? + + - Predicates (built-in, library) + - How should we handle documentation? PlDoc? Manual? + - Source files (name, tags, meta-data, content?) + - Show matching sources in modal dialog and allow switching to + these? +*/ + +:- http_handler(swish(typeahead), typeahead, [id(typeahead)]). +:- http_handler(swish(search), search, [id(search)]). + +%% search_box(+Options)// +% +% Render a Bootstrap search box. + +search_box(_Options) --> + html(form([class('navbar-form'), role(search)], + div(class('input-group'), + [ input([ type(text), + class('form-control'), + placeholder('Search'), + title('Searches code, documentation and files'), + id('search') + ]), + div(class('input-group-btn'), + button([ class([btn, 'btn-default']), + type(submit)], + i(class([glyphicon, 'glyphicon-search']), + []))) + ]))). + + +%% typeahead(+Request) +% +% Support the search typeahead widget. The handler returns a JSON +% array of matches. Each match is an object that contains at least +% a label. + +typeahead(Request) :- + http_parameters(Request, + [ q(Query, [default('')]), + set(Set, [default(predicates)]) + ]), + findall(Match, typeahead(Set, Query, Match), Matches), + reply_json_dict(Matches). + +typeahead(predicates, Query, Template) :- + swish_config:config(templates, Templates), + member(Template, Templates), + _{name:Name, arity:_} :< Template, + sub_atom(Name, 0, _, _, Query). + +%% search(+Request) +% +% Handle an actual search request from the SWISH search box. +% Returns an HTML document with the actual results that is +% displayed in a modal dialog. + +search(_Request) :- + reply_html_page(search, + [], + h1('Search results')). diff --git a/lib/swish/storage.pl b/lib/swish/storage.pl index 4645159..585187f 100644 --- a/lib/swish/storage.pl +++ b/lib/swish/storage.pl @@ -3,7 +3,7 @@ Author: Jan Wielemaker E-mail: J.Wielemaker@cs.vu.nl WWW: http://www.swi-prolog.org - Copyright (C): 2014, VU University Amsterdam + Copyright (C): 2015, VU University Amsterdam This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License @@ -31,9 +31,9 @@ :- use_module(library(http/http_dispatch)). :- use_module(library(http/http_parameters)). :- use_module(library(http/http_json)). -:- use_module(library(http/http_client)). :- use_module(library(http/http_wrapper)). :- use_module(library(http/mimetype)). +:- use_module(library(lists)). :- use_module(library(settings)). :- use_module(library(random)). :- use_module(library(apply)). @@ -69,42 +69,79 @@ web_storage(Request) :- storage(get, Request) :- http_parameters(Request, - [ format(Format, [ oneof([swish,raw]), - default(swish), - description('How to render') - ]) + [ format(Fmt, [ oneof([swish,raw,json,history,diff]), + default(swish), + description('How to render') + ]), + depth(Depth, [ default(5), + integer, + description('History depth') + ]), + to(RelTo, [ optional(true), + description('Diff relative to') + ]) ]), + ( Fmt == history + -> ( nonvar(RelTo) + -> Format = history(Depth, RelTo) + ; Format = history(Depth) + ) + ; Fmt == diff + -> Format = diff(RelTo) + ; Format = Fmt + ), storage_get(Request, Format). storage(post, Request) :- - http_parameters(Request, - [ data(Data, [default(''), - description('Data to be saved')]), - type(Type, [default(pl)]) - ]), - authentity(Request, Authentity), + http_read_json_dict(Request, Dict), + option(data(Data), Dict, ""), + option(type(Type), Dict, pl), setting(directory, Dir), make_directory_path(Dir), - ( repeat, - random_filename(Base), - file_name_extension(Base, Type, File), - catch(gitty_create(Dir, File, Data, Authentity, Commit), - error(gitty(file_exists(File)),_), - fail) - -> true + meta_data(Request, Dir, Dict, Meta), + ( atom_string(Base, Dict.get(meta).get(name)) + -> file_name_extension(Base, Type, File), + ( catch(gitty_create(Dir, File, Data, Meta, Commit), + error(gitty(file_exists(File)),_), + fail) + -> true + ; Error = json{error:file_exists, + file:File} + ) + ; ( repeat, + random_filename(Base), + file_name_extension(Base, Type, File), + catch(gitty_create(Dir, File, Data, Meta, Commit), + error(gitty(file_exists(File)),_), + fail) + -> true + ) ), - debug(storage, 'Created: ~p', [Commit]), - storage_url(File, URL), - reply_json_dict(json{url:URL, file:File}). + ( var(Error) + -> debug(storage, 'Created: ~p', [Commit]), + storage_url(File, URL), + + reply_json_dict(json{url:URL, + file:File, + meta:Commit.put(symbolic, "HEAD") + }) + ; reply_json_dict(Error) + ). storage(put, Request) :- - http_read_data(Request, Form, []), - option(data(Data), Form, ''), - authentity(Request, Meta), + http_read_json_dict(Request, Dict), setting(directory, Dir), request_file(Request, Dir, File), + ( Dict.get(update) == "meta-data" + -> gitty_data(Dir, File, Data, _OldMeta) + ; option(data(Data), Dict, "") + ), + meta_data(Request, Dict, Meta), storage_url(File, URL), gitty_update(Dir, File, Data, Meta, Commit), debug(storage, 'Updated: ~p', [Commit]), - reply_json_dict(json{url:URL, file:File}). + reply_json_dict(json{url:URL, + file:File, + meta:Commit.put(symbolic, "HEAD") + }). storage(delete, Request) :- authentity(Request, Meta), setting(directory, Dir), @@ -123,23 +160,113 @@ request_file(Request, Dir, File) :- storage_url(File, HREF) :- http_link_to_id(web_storage, path_postfix(File), HREF). +%% meta_data(+Request, +Dict, -Meta) is det. +%% meta_data(+Request, Store, +Dict, -Meta) is det. +% +% Gather meta-data from the Request (user, peer) and provided +% meta-data. Illegal and unknown values are ignored. + +meta_data(Request, Dict, Meta) :- + authentity(Request, Meta0), % user, peer + ( filter_meta(Dict.get(meta), Meta1) + -> Meta = Meta0.put(Meta1) + ; Meta = Meta0 + ). + +meta_data(Request, Store, Dict, Meta) :- + meta_data(Request, Dict, Meta1), + ( atom_string(Previous, Dict.get(previous)), + is_sha1(Previous), + gitty_commit(Store, Previous, _PrevMeta) + -> Meta = Meta1.put(previous, Previous) + ; Meta = Meta1 + ). + +filter_meta(Dict0, Dict) :- + dict_pairs(Dict0, Tag, Pairs0), + filter_pairs(Pairs0, Pairs), + dict_pairs(Dict, Tag, Pairs). + +filter_pairs([], []). +filter_pairs([H|T0], [H|T]) :- + H = K-V, + meta_allowed(K, Type), + is_of_type(Type, V), !, + filter_pairs(T0, T). +filter_pairs([_|T0], T) :- + filter_pairs(T0, T). + +meta_allowed(public, boolean). +meta_allowed(author, string). +meta_allowed(email, string). +meta_allowed(title, string). +meta_allowed(tags, list(string)). +meta_allowed(description, string). +meta_allowed(commit_message, string). + %% storage_get(+Request, +Format) is det. +% +% HTTP handler that returns information a given gitty file. +% +% @arg Format is one of +% +% - swish +% Serve file embedded in a SWISH application +% - raw +% Serve the raw file +% - json +% Return a JSON object with the keys `data` and `meta` +% - history(Depth, IncludeHASH) +% Return a JSON description with the change log +% - diff(RelTo) +% Reply with diff relative to RelTo. Default is the +% previous commit. storage_get(Request, swish) :- swish_reply_config(Request), !. -storage_get(Request, swish) :- !, - setting(directory, Dir), - request_file(Request, Dir, File), - gitty_data(Dir, File, Code, _Meta), - swish_reply([code(Code),file(File)], Request). -storage_get(Request, _) :- +storage_get(Request, Format) :- setting(directory, Dir), - request_file(Request, Dir, File), - gitty_data(Dir, File, Code, _Meta), - file_mime_type(File, MIME), + request_file_or_hash(Request, Dir, FileOrHash, Type), + storage_get(Format, Dir, Type, FileOrHash, Request). + +storage_get(swish, Dir, _, FileOrHash, Request) :- + gitty_data(Dir, FileOrHash, Code, Meta), + swish_reply([code(Code),file(FileOrHash),meta(Meta)], Request). +storage_get(raw, Dir, _, FileOrHash, _Request) :- + gitty_data(Dir, FileOrHash, Code, Meta), + file_mime_type(Meta.name, MIME), format('Content-type: ~w~n~n', [MIME]), format('~s', [Code]). +storage_get(json, Dir, _, FileOrHash, _Request) :- + gitty_data(Dir, FileOrHash, Code, Meta), + reply_json_dict(json{data:Code, meta:Meta}). +storage_get(history(Depth, Includes), Dir, _, File, _Request) :- + gitty_history(Dir, File, History, [depth(Depth),includes(Includes)]), + reply_json_dict(History). +storage_get(history(Depth), Dir, _, File, _Request) :- + gitty_history(Dir, File, History, [depth(Depth)]), + reply_json_dict(History). +storage_get(diff(RelTo), Dir, _, File, _Request) :- + gitty_diff(Dir, RelTo, File, Diff), + reply_json_dict(Diff). + +request_file_or_hash(Request, Dir, FileOrHash, Type) :- + option(path_info(PathInfo), Request), + atom_concat(/, FileOrHash, PathInfo), + ( gitty_file(Dir, FileOrHash, _Hash) + -> Type = file + ; is_sha1(FileOrHash) + -> Type = hash + ; http_404([], Request) + ). +is_sha1(SHA1) :- + atom_length(SHA1, 40), + atom_codes(SHA1, Codes), + maplist(hex_digit, Codes). + +hex_digit(C) :- between(0'0, 0'9, C), !. +hex_digit(C) :- between(0'a, 0'f, C). %% authentity(+Request, -Authentity:dict) is det. % @@ -183,3 +310,45 @@ random_char(Char) :- Max is Len - 1, random_between(0, Max, I), sub_atom(From, I, 1, _, Char). + + + /******************************* + * SEARCH SUPPORT * + *******************************/ + +:- multifile + swish_search:typeahead/3. % +Set, +Query, -Match + +%% swish_search:typeahead(+Set, +Query, -Match) is nondet. +% +% Find files using typeahead from the SWISH search box. +% +% @tbd caching? +% @tbd We should only demand public on public servers. + +swish_search:typeahead(file, Query, FileInfo) :- + setting(directory, Dir), + gitty_file(Dir, File, Head), + gitty_commit(Dir, Head, Meta), + Meta.get(public) == true, + ( sub_atom(File, 0, _, _, Query) % find only public + -> true + ; meta_match_query(Query, Meta) + -> true + ), + FileInfo = Meta.put(_{type:"store", file:File}). + +meta_match_query(Query, Meta) :- + member(Tag, Meta.get(tags)), + sub_atom(Tag, 0, _, _, Query). +meta_match_query(Query, Meta) :- + sub_atom(Meta.get(author), 0, _, _, Query). +meta_match_query(Query, Meta) :- + Title = Meta.get(title), + sub_atom_icasechk(Title, Start, Query), + ( Start =:= 0 + -> true + ; Before is Start-1, + sub_atom(Title, Before, 1, _, C), + \+ char_type(C, csym) + ). diff --git a/lib/swish/template_hint.pl b/lib/swish/template_hint.pl index eccdfe4..09669b3 100644 --- a/lib/swish/template_hint.pl +++ b/lib/swish/template_hint.pl @@ -250,11 +250,14 @@ man_predicate_info(PI, Name-Value) :- normalize_space(string(ModeLine), ModeLine0), ( atom_string(PName, PString), Name-Value = name-PString + ; Name-Value = arity-Arity ; Name-Value = mode-ModeLine ; once(catch(predicate(PName, Arity, Summary, _, _), _, fail)), Name-Value = summary-Summary - ; predicate_property(system:PHead, iso) - -> Name-Value = iso:true + ; predicate_property(system:PHead, iso), + Name-Value = iso-true + ; predicate_property(system:PHead, built_in), + Name-Value = type-built_in ). %% pldoc_predicate_info(+PI, -ModeLine) is semidet. @@ -262,7 +265,7 @@ man_predicate_info(PI, Name-Value) :- pldoc_predicate_info(PI, Name-Value) :- pi_head(PI, Head), strip_module(Head, _, PHead), - functor(PHead, PName, _Arity), + functor(PHead, PName, Arity), implementation_module(Head, Module), doc_comment(PI, Pos, Summary, Comment), !, is_structured_comment(Comment, Prefixes), @@ -281,6 +284,7 @@ pldoc_predicate_info(PI, Name-Value) :- ]), ( atom_string(PName, PString), Name-Value = name-PString + ; Name-Value = arity-Arity ; Name-Value = mode-ModeLine ; Name-Value = summary-Summary ; Det \== unknown,