swish/commit

New upstream libraries

authorJan Wielemaker
Wed Jun 28 16:15:20 2017 +0200
committerJan Wielemaker
Wed Jun 28 16:15:20 2017 +0200
commitf96a47a7bc6eb03207a5a3e18f5858c5971743b2
tree887a666fc14ec15d5282cb3bf6ea2438abf4a104
parent80114cc369970a9d322642a12101ffa7aeb8a95c
Diff style: patch stat
diff --git a/lib/swish/dashboard.pl b/lib/swish/dashboard.pl
new file mode 100644
index 0000000..f4c0962
--- /dev/null
+++ b/lib/swish/dashboard.pl
@@ -0,0 +1,243 @@
+/*  Part of SWISH
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2017, VU University Amsterdam
+			 CWI Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(swish_dashboard,
+          [ parameters/1                        % +Parameters
+          ]).
+:- use_module(library(pengines)).
+:- use_module(library(apply)).
+:- use_module(library(error)).
+:- use_module(library(debug)).
+:- use_module(library(option)).
+:- use_module(library(lists)).
+:- use_module(library(http/html_write)).
+
+:- use_module(bootstrap).
+:- use_module(form).
+
+/** <module> Provide non-programmer query execution
+
+@tbd	Colour support for this term
+*/
+
+%!  parameters(+Spec:list) is det.
+%
+%   Fill query parameters. Spec is a list   of query parameters that use
+%   the following syntax:
+%
+%       Var: Option ("+" Option)*
+%
+%   Defined options are:
+%
+%       - type(+Type)
+%       Defines the type to be used for Var.  Types are defined by
+%       library(error).  Type terms can also be used without the
+%       type(Type) wrapper.
+%       - default(+Default)
+%       Default value to use.
+
+parameters(List) :-
+    include(not_filled, List, ToFill),
+    debug(dashboard(param), 'ToFill: ~p', [ToFill]),
+    fill(ToFill).
+
+not_filled(Var:_) :-
+    var(Var).
+
+fill([]) :-
+    !.
+fill(NotFilled) :-
+    maplist(input, NotFilled, FieldWidgets),
+    !,
+    buttons(Buttons),
+    append(FieldWidgets, Buttons, Widgets),
+    html_string(\bt_form(Widgets,
+                         [ class('form-horizontal'),
+                           label_columns(sm-3)
+                         ]), HTML),
+    Prompt = _{ type: form,
+                html: HTML
+              },
+    pengine_input(Prompt, Reply),
+    bind_form_reply(NotFilled, Reply).
+
+buttons(
+    [ button_group(
+          [ button(run, submit,
+                   [ type(primary),
+                     data([action(run)])
+                   ]),
+            button(cancel, button,
+                   [ type(danger),
+                     data([action(cancel)])
+                   ])
+          ],
+          [])
+    ]).
+
+
+bind_form_reply(_NotFilled, cancel) :-
+    !,
+    fail.
+bind_form_reply(NotFilled, Reply) :-
+    maplist(form_field, NotFilled, Fields),
+    validate_form(Reply, Fields).
+
+form_field(Var:Opts, field(Name, Var, [Type|Extra])) :-
+    opt_list(Opts, Options),
+    option(name(Name), Options),
+    option(type(Type), Options),
+    (   option(default(Default), Options)
+    ->  Extra = [default(Default)]
+    ;   Extra = []
+    ).
+
+
+%!  input(+ParamSpec, -InputItem) is det.
+%
+%   Construct a Bootstrap input item from ParamSpec.
+
+input(_Var:Opts, Input) :-
+    opt_list(Opts, Options),
+    select_option(type(Type), Options, Options1),
+    select_option(name(Name), Options1, Options2),
+    input(Type, Name, Options2, Input).
+
+input(Type, Name, Options,
+      input(Name, text,
+            [ data('search-in'=Set),
+              class(typeahead)
+            | Options
+            ])) :-
+    typeahead(Type, Set),
+    !.
+input(string, Name, Options,
+      textarea(Name, Options)) :-
+    option(rows(_Rows), Options),
+    !.
+input(_, Name, Options,
+      input(Name, text, Options)).
+
+%!  typeahead(+Type, -Set)
+%
+%   True when an object of Type can be   selected from an input set that
+%   uses type-ahead search using the data set Set.
+
+typeahead(user, users).
+
+:- multifile error:has_type/2.
+
+error:has_type(user, _Dict) :-
+    true.
+
+
+		 /*******************************
+		 *   INSPECT VARIABLE NAMES	*
+		 *******************************/
+
+:- multifile
+    swish:goal_expansion/2.
+
+swish:goal_expansion(parameters(Params0), parameters(Params)) :-
+    add_var_names(Params0, 1, Params),
+    Params0 \== Params.
+
+add_var_names([], _, []).
+add_var_names([H0|T0], N0, [H|T]) :-
+    add_var_name(H0, N0, H),
+    N is N0 + 1,
+    add_var_names(T0, N, T).
+
+
+add_var_name(Var:Options, _, Var:Options) :-
+    opt(name(_), Options),
+    !.
+add_var_name(Var:Options, N, Var:name(Name)+Options) :-
+    (   var_property(Var, name(Name))
+    ->  true
+    ;   atom_concat('Param', N, Name)
+    ).
+
+
+		 /*******************************
+		 *            BASICS		*
+		 *******************************/
+
+opt_list(Opts, List) :-
+    phrase(opts(Opts), List0),
+    add_type(List0, List).
+
+opts(OptA+OptB) -->
+    !,
+    opts(OptA),
+    opts(OptB).
+opts(Opt) -->
+    [Opt].
+
+add_type(Options, Options) :-
+    option(type(_), Options), !.
+add_type(List, Options) :-
+    select(Type, List, Options1),
+    current_type(Type, _, _),
+    !,
+    Options = [type(Type)|Options1].
+add_type(Options, [type(term)|Options]).
+
+
+%!  opt(?Option, +Options) is nondet.
+%
+%   Opt is a member of the Options term.
+
+opt(Opt, Opts) :-
+    \+ functor(Opts, +, 2), !,
+    Opt = Opts.
+opt(Opt, Opt+_).
+opt(Opt, _+Opts) :-
+    opt(Opt, Opts).
+
+html_string(HTML, String) :-
+    phrase(html(HTML), Tokens),
+    !,
+    delete(Tokens, nl(_), SingleLine),
+    with_output_to(string(String), print_html(SingleLine)).
+
+
+		 /*******************************
+		 *            SANDBOX		*
+		 *******************************/
+
+:- multifile sandbox:safe_primitive/1.
+
+sandbox:safe_primitive(swish_dashboard:parameters(_)).
diff --git a/lib/swish/jquery.pl b/lib/swish/jquery.pl
new file mode 100644
index 0000000..f9bf337
--- /dev/null
+++ b/lib/swish/jquery.pl
@@ -0,0 +1,99 @@
+/*  Part of SWISH
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2015, VU University Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(swish_jquery,
+	  [ jquery/3			% +Selector, +Request, -Reply
+	  ]).
+:- use_module(library(error)).
+:- use_module(library(pengines)).
+
+/** <module> Call jQuery on the SWISH interface
+
+Select objects in the SWISH  interface   using  jQuery, run an arbitrary
+JavaScript function on them and return   the  result. This predicate was
+introduced while adding functionality to request the contents of tabs in
+the SWISH interface.
+*/
+
+%%	jquery(+Selector, +Function, -Reply) is det.
+%
+%	Run a jQuery query in the  SWISH interface. Selector defines the
+%	receiver  of  the  jQuery  method,  Function  is  the  JavaScript
+%	function to run  on  the  receiver   and  Reply  is  the  Prolog
+%	representation of the result.
+%
+%	@arg Selector selects the jQuery receiver. It takes three forms:
+%
+%	  - If the selector is a string, it is simply interpreted as
+%	    =|$(Selector)|=.
+%	  - If the selector is this(SubSelector), it perform a jQuery
+%	    `find` using `SubSelector` on the Prolog runner.  Using
+%	  - If the selector is swish(SubSelector), as above, but
+%	    starting at the SWISH plugin instance
+%
+%	@arg Function is a compound term  representing a JavaScript call.
+%	The functor name is used as   method and the remaining arguments
+%	are converted by json_write_dict/2.
+%
+%	@arg Reply is the JavaScript reply, converted to Prolog by
+%	the Pengine.stringify() method.
+
+jquery(Selector, Function, Reply) :-
+	map_selector(Selector, Selector1),
+	compound_name_arguments(Function, Method, Args),
+	pengine_input(_{ type: "jQuery",
+			 selector: Selector1,
+			 method: Method,
+			 arguments: Args
+		       },
+		      Reply).
+
+map_selector(Selector, Selector) :-
+	string(Selector), !.
+map_selector(Selector, Selector) :-
+	atom(Selector), !.
+map_selector(Selector, json{root:Name, sub:SubSelector}) :-
+	compound_name_arguments(Selector, Name, Args),
+	root_selector(Name),
+	(   Args == []
+	->  SubSelector = ""
+	;   Args = [SubSelector]
+	->  must_be(string, SubSelector)
+	;   domain_error(arity_one, Selector)
+	).
+
+root_selector(this) :- !.
+root_selector(swish) :- !.
+root_selector(Selector) :-
+	domain_error(root_selector, Selector).
diff --git a/lib/swish/projection.pl b/lib/swish/projection.pl
new file mode 100644
index 0000000..ab83c08
--- /dev/null
+++ b/lib/swish/projection.pl
@@ -0,0 +1,100 @@
+/*  Part of SWISH
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2017, VU University Amsterdam
+			 CWI Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(swish_projection,
+          [ projection/1
+          ]).
+:- use_module(library(lists)).
+:- use_module(library(apply)).
+:- use_module(library(debug)).
+:- use_module(library(error)).
+
+/** <module> Define the projection
+
+This module redefines variables that are   included  in the SWISH result
+set.
+
+@tbd	Removed variables should be removed from the template as well
+	for efficiency reasons.
+*/
+
+%!  projection(+Spec:list)
+%
+%   Specify the result variables. Using projection/1   at the start of a
+%   query specifies which variables are part of  the result set, in what
+%   order they are displayed and, optionally,   whether the results must
+%   be ordered on one or  more   variables.  Ordering is specified using
+%   `+Var` (ascending) or `-Var` (descending).  If ordering is specified
+%   for multiple variables, the result set  is ordered starting with the
+%   left-most variable for which ordering is defined.
+
+projection(_).
+
+swish:goal_expansion((projection(Spec),Body), Ordered) :-
+    must_be(list, Spec),
+    phrase(order(Spec, Vars), Order),
+    Order \== [],
+    Ordered = order_by(Order, Body),
+    ignore(set_projection(Vars)).
+swish:goal_expansion(projection(Vars), true) :-
+    set_projection(Vars).
+
+set_projection(Vars) :-
+    nb_current('$variable_names', Bindings),
+    debug(projection, 'Got ~p; Asking ~p', [Bindings, Vars]),
+    memberchk('_residuals'=Var, Bindings),
+    maplist(select_binding(Bindings), Vars, NewBindings),
+    debug(projection, 'Filtered ~p', [NewBindings]),
+    b_setval('$variable_names', ['_residuals'=Var|NewBindings]).
+
+select_binding(Bindings, Var, Name=Var) :-
+    member(Name=X, Bindings),
+    Var == X,
+    !.
+
+order([], []) -->
+    [].
+order([H|T], [V|VT]) -->
+    order1(H, V),
+    order(T, VT).
+
+order1(V, V)  --> {var(V)}, !.
+order1(+V, V) --> !, [asc(V)].
+order1(-V, V) --> !, [desc(V)].
+order1(V, V)  --> [].
+
+:- multifile sandbox:safe_primitive/1.
+
+sandbox:safe_primitive(swish_projection:projection(_)).