/* 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_highlight,
[ current_highlight_state/2
]).
:- use_module(library(debug)).
:- use_module(library(http/http_dispatch)).
:- use_module(library(http/html_write)).
:- use_module(library(http/http_json)).
:- use_module(library(http/http_path), []).
:- use_module(library(http/http_parameters)).
:- use_module(library(pairs)).
:- use_module(library(apply)).
:- use_module(library(error)).
:- use_module(library(prolog_xref)).
:- use_module(library(memfile)).
:- use_module(library(prolog_colour)).
:- if(exists_source(library(helpidx))).
:- use_module(library(helpidx), [predicate/5]).
:- endif.
http:location(codemirror, swish(cm), []).
:- http_handler(codemirror(.), http_404([]), [id(cm_highlight)]).
:- http_handler(codemirror(change), codemirror_change, []).
:- http_handler(codemirror(tokens), codemirror_tokens, []).
:- http_handler(codemirror(leave), codemirror_leave, []).
:- http_handler(codemirror(info), token_info, []).
/** <module> Highlight token server
This module provides the Prolog part of server-assisted highlighting for
SWISH. It is implemented by managing a shadow copy of the client editor
on the server. On request, the server computes a list of _semantic
tokens_.
@tbd Use websockets
*/
/*******************************
* SHADOW EDITOR *
*******************************/
%% codemirror_change(+Request)
%
% Handle changes to the codemirror instances. These are sent to us
% using a POST request. The request a POSTed JSON object
% containing:
%
% - uuid: string holding the editor's UUID
% - change: the change object, which holds:
% - from: Start position as {line:Line, ch:Ch}
% - to: End position
% - removed: list(atom) of removed text
% - text: list(atom) of inserted text
% - origin: what caused this change event
% - next: optional next change event.
%
% Reply is JSON and either 200 with `true` or 409 indicating that
% the editor is not known.
codemirror_change(Request) :-
http_read_json_dict(Request, Change, []),
debug(cm(change), 'Change ~p', [Change]),
UUID = Change.uuid,
( shadow_editor(Change, TB)
-> ( catch(apply_change(TB, Changed, Change.change),
cm(outofsync), fail)
-> mark_changed(TB, Changed),
reply_json_dict(true)
; destroy_editor(UUID),
change_failed(UUID, outofsync)
)
; change_failed(UUID, existence_error)
).
change_failed(UUID, Reason) :-
reply_json_dict(json{ type:Reason,
object:UUID
},
[status(409)]).
%% apply_change(+TB, -Changed, +Changes) is det.
%
% Note that the argument order is like this to allow for maplist.
%
% @arg Changed is left unbound if there are no changes or unified
% to =true= if something has changed.
%
% @throws cm(outofsync) if an inconsistent delete is observed.
apply_change(_, _Changed, []) :- !.
apply_change(TB, Changed, Change) :-
_{from:From} :< Change,
Line is From.line+1,
memory_file_line_position(TB, Line, From.ch, ChPos),
remove(Change.removed, TB, ChPos, Changed),
insert(Change.text, TB, ChPos, _End, Changed),
( Next = Change.get(next)
-> apply_change(TB, Changed, Next)
; true
).
remove([], _, _, _) :- !.
remove([H|T], TB, ChPos, Changed) :-
string_length(H, Len),
( T == []
-> DLen is Len
; DLen is Len+1
),
( DLen == 0
-> true
; Changed = true,
memory_file_substring(TB, ChPos, Len, _, Text),
( Text == H
-> true
; throw(cm(outofsync))
),
delete_memory_file(TB, ChPos, DLen)
),
remove(T, TB, ChPos, Changed).
insert([], _, ChPos, ChPos, _) :- !.
insert([H|T], TB, ChPos0, ChPos, Changed) :-
( H == ""
-> Len = 0
; Changed = true,
string_length(H, Len),
debug(cm(change), 'Insert ~q at ~d', [H, ChPos0]),
insert_memory_file(TB, ChPos0, H)
),
ChPos1 is ChPos0+Len,
( T == []
-> ChPos2 = ChPos1
; debug(cm(change), 'Adding newline at ~d', [ChPos1]),
Changed = true,
insert_memory_file(TB, ChPos1, '\n'),
ChPos2 is ChPos1+1
),
insert(T, TB, ChPos2, ChPos, Changed).
:- dynamic
current_editor/4, % UUID, MemFile, Role, Time
editor_last_access/2, % UUID, Time
xref_upto_data/1. % UUID
create_editor(UUID, Editor, Change) :-
must_be(atom, UUID),
uuid_like(UUID),
new_memory_file(Editor),
( RoleString = Change.get(role)
-> atom_string(Role, RoleString)
; Role = source
),
get_time(Now),
asserta(current_editor(UUID, Editor, Role, Now)).
%% current_highlight_state(?UUID, -State) is nondet.
%
% Return info on the current highlighter
current_highlight_state(UUID,
highlight{data:Editor,
role:Role,
created:Created,
access:Access
}) :-
current_editor(UUID, Editor, Role, Created),
( editor_last_access(Editor, Access)
-> true
; Access = Created
).
%% uuid_like(+UUID) is semidet.
%
% Do some sanity checking on the UUID because we use it as a
% temporary module name and thus we must be quite sure it will not
% conflict with anything.
uuid_like(UUID) :-
split_string(UUID, "-", "", Parts),
maplist(string_length, Parts, [8,4,4,4,12]),
\+ current_editor(UUID, _, _, _).
%% destroy_editor(+UUID)
%
% Destroy source admin UUID: the shadow text (a memory file), the
% XREF data and the module used for cross-referencing.
destroy_editor(UUID) :-
must_be(atom, UUID),
retractall(xref_upto_data(UUID)),
retractall(editor_last_access(UUID, _)),
current_editor(UUID, Editor, _, _), !,
( xref_source_id(Editor, SourceID)
-> xref_clean(SourceID),
destroy_state_module(UUID)
; true
),
% destroy late to make xref_source_identifier/2 work.
retractall(current_editor(UUID, Editor, _, _)),
free_memory_file(Editor).
destroy_editor(_).
%% gc_editors
%
% Garbage collect all editors that have not been accessed for 60
% minutes.
%
% @tbd Normally, deleting a highlight state can be done
% aggressively as it will be recreated on demand. But, coloring a
% query passes the UUIDs of related sources and as yet there is no
% way to restore this. We could fix that by replying to the query
% colouring with the UUIDs for which we do not have sources, after
% which the client retry the query-color request with all relevant
% sources.
:- dynamic
gced_editors/1.
editor_max_idle_time(3600).
gc_editors :-
get_time(Now),
( gced_editors(Then),
editor_max_idle_time(MaxIdle),
Now - Then < MaxIdle/3
-> true
; retractall(gced_editors(_)),
asserta(gced_editors(Now)),
fail
).
gc_editors :-
editor_max_idle_time(MaxIdle),
forall(garbage_editor(UUID, MaxIdle),
destroy_old_editor(UUID)).
garbage_editor(UUID, TimeOut) :-
get_time(Now),
current_editor(UUID, _TB, _Role, Created),
Now - Created > TimeOut,
( editor_last_access(UUID, Access)
-> Now - Access > TimeOut
; true
).
destroy_old_editor(UUID) :-
with_mutex(swish_gc_editor,
destroy_old_editor_sync(UUID)).
destroy_old_editor_sync(UUID) :-
editor_max_idle_time(MaxIdle),
garbage_editor(UUID, MaxIdle), !,
debug(cm(gc), 'GC highlight state for ~q', [UUID]),
destroy_editor(UUID).
destroy_old_editor_sync(_).
%% fetch_editor(+UUID, -MemFile) is semidet.
%
% Fetch existing editor for source UUID. Make sure the last access
% time is updated to avoid concurrent GC of the editor.
fetch_editor(UUID, TB) :-
with_mutex(swish_gc_editor,
( current_editor(UUID, TB, _Role, _),
update_access(UUID)
)).
update_access(UUID) :-
get_time(Now),
retractall(editor_last_access(UUID, _)),
asserta(editor_last_access(UUID, Now)).
:- multifile
prolog:xref_source_identifier/2,
prolog:xref_open_source/2.
prolog:xref_source_identifier(UUID, UUID) :-
current_editor(UUID, _, _, _).
prolog:xref_open_source(UUID, Stream) :-
current_editor(UUID, TB, _Role, _), !,
open_memory_file(TB, read, Stream).
%% codemirror_leave(+Request)
%
% POST handler that deals with destruction of the XPCE
% source_buffer associated with an editor, as well as the
% associated cross-reference information.
codemirror_leave(Request) :-
http_read_json_dict(Request, Data, []),
debug(cm(leave), 'Leaving editor ~p', [Data]),
( atom_string(UUID, Data.get(uuid))
-> forall(current_editor(UUID, _TB, _Role, _),
with_mutex(swish_gc_editor, destroy_editor(UUID)))
; true
),
reply_json_dict(true).
%% mark_changed(+MemFile, ?Changed) is det.
%
% Mark that our cross-reference data might be obsolete
mark_changed(MemFile, Changed) :-
( Changed == true
-> current_editor(UUID, MemFile, _Role, _),
retractall(xref_upto_data(UUID))
; true
).
%% xref(+UUID) is det.
xref(UUID) :-
xref_upto_data(UUID), !.
xref(UUID) :-
current_editor(UUID, MF, _Role, _),
xref_source_id(MF, SourceId),
xref_state_module(MF, Module),
xref_source(SourceId,
[ silent(true),
module(Module)
]),
asserta(xref_upto_data(UUID)).
%% xref_source_id(+TextBuffer, -SourceID) is det.
%
% Find the object we need to examine for cross-referencing. If
% this is an included file, this is the corresponding main file.
%xref_source_id(TB, SourceId) :-
% get(TB, file, File), File \== @nil, !,
% get(File, absolute_path, Path0),
% absolute_file_name(Path0, Path),
% master_load_file(Path, [], Master),
% ( Master == Path
% -> SourceId = TB
% ; SourceId = Master
% ).
xref_source_id(TB, UUID) :-
current_editor(UUID, TB, _Role, _).
%% xref_state_module(+TB, -Module) is semidet.
%
% True if we must run the cross-referencing in Module. We use a
% temporary module based on the UUID of the source.
xref_state_module(TB, UUID) :-
current_editor(UUID, TB, _Role, _),
( module_property(UUID, class(temporary))
-> true
; set_module(UUID:class(temporary)),
add_import_module(UUID, swish, start)
).
destroy_state_module(UUID) :-
module_property(UUID, class(temporary)), !,
'$destroy_module'(UUID).
destroy_state_module(_).
/*******************************
* SERVER TOKENS *
*******************************/
%% codemirror_tokens(+Request)
%
% HTTP POST handler that returns an array of tokens for the given
% editor.
codemirror_tokens(Request) :-
http_read_json_dict(Request, Data, []),
debug(cm(tokens), 'Asking for tokens: ~p', [Data]),
( catch(shadow_editor(Data, TB), cm(Reason), true)
-> ( var(Reason)
-> enriched_tokens(TB, Data, Tokens),
reply_json_dict(json{tokens:Tokens}, [width(0)])
; change_failed(Data.uuid, Reason)
)
; reply_json_dict(json{tokens:[[]]})
),
gc_editors.
enriched_tokens(TB, _Data, Tokens) :- % source window
current_editor(UUID, TB, source, _), !,
xref(UUID),
server_tokens(TB, Tokens).
enriched_tokens(TB, Data, Tokens) :- % query window
json_source_id(Data.get(sourceID), SourceID), !,
memory_file_to_string(TB, Query),
with_mutex(swish_highlight_query,
prolog_colourise_query(Query, SourceID, colour_item(TB))),
collect_tokens(TB, Tokens).
enriched_tokens(TB, _Data, Tokens) :-
memory_file_to_string(TB, Query),
prolog_colourise_query(Query, module(swish), colour_item(TB)),
collect_tokens(TB, Tokens).
%% json_source_id(+Input, -SourceID)
%
% Translate the Input, which is either a string or a list of
% strings into an atom or list of atoms. Older versions of
% SWI-Prolog only accept a single atom source id.
:- if(current_predicate(prolog_colour:to_list/2)).
json_source_id(StringList, SourceIDList) :-
is_list(StringList),
StringList \== [], !,
maplist(string_source_id, StringList, SourceIDList).
:- else. % old version (=< 7.3.7)
json_source_id([String|_], SourceID) :-
maplist(string_source_id, String, SourceID).
:- endif.
json_source_id(String, SourceID) :-
string(String),
string_source_id(String, SourceID).
string_source_id(String, SourceID) :-
atom_string(SourceID, String),
( fetch_editor(SourceID, _TB)
-> true
; true
).
%% shadow_editor(+Data, -MemoryFile) is det.
%
% Get our shadow editor:
%
% 1. If we have one, it is updated from either the text or the changes.
% 2. If we have none, but there is a `text` property, create one
% from the text.
% 3. If there is a `role` property, create an empty one.
%
% This predicate fails if the server thinks we have an editor with
% state that must be reused, but this is not true (for example
% because we have been restarted).
%
% @throws cm(existence_error) if the target editor did not exist
% @throws cm(out_of_sync) if the changes do not apply due to an
% internal error or a lost message.
shadow_editor(Data, TB) :-
atom_string(UUID, Data.get(uuid)),
fetch_editor(UUID, TB), !,
( Text = Data.get(text)
-> size_memory_file(TB, Size),
delete_memory_file(TB, 0, Size),
insert_memory_file(TB, 0, Text),
mark_changed(TB, true)
; Changes = Data.get(changes)
-> ( maplist(apply_change(TB, Changed), Changes)
-> true
; throw(cm(out_of_sync))
),
mark_changed(TB, Changed)
).
shadow_editor(Data, TB) :-
Text = Data.get(text), !,
atom_string(UUID, Data.uuid),
create_editor(UUID, TB, Data),
debug(cm(change), 'Initialising editor to ~q', [Text]),
insert_memory_file(TB, 0, Text).
shadow_editor(Data, TB) :-
_{role:_} :< Data, !,
atom_string(UUID, Data.uuid),
create_editor(UUID, TB, Data).
shadow_editor(_Data, _TB) :-
throw(cm(existence_error)).
:- thread_local
token/3.
%% show_mirror(+Role) is det.
%% server_tokens(+Role) is det.
%
% These predicates help debugging the server side. show_mirror/0
% opens the XPCE editor, which simplifies validation that the
% server copy is in sync with the client. The predicate
% server_tokens/1 dumps the token list.
%
% @arg Role is one of =source= or =query=, expressing the role of
% the editor in the SWISH UI.
:- public
show_mirror/1,
server_tokens/1.
show_mirror(Role) :-
current_editor(_UUID, TB, Role, _), !,
memory_file_to_string(TB, String),
write(user_error, String).
server_tokens(Role) :-
current_editor(_UUID, TB, Role, _), !,
enriched_tokens(TB, _{}, Tokens),
print_term(Tokens, [output(user_error)]).
%% server_tokens(+TextBuffer, -Tokens) is det.
%
% @arg Tokens is a nested list of Prolog JSON terms. Each group
% represents the tokens found in a single toplevel term.
server_tokens(TB, GroupedTokens) :-
current_editor(UUID, TB, _Role, _),
setup_call_cleanup(
open_memory_file(TB, read, Stream),
( set_stream_file(TB, Stream),
prolog_colourise_stream(Stream, UUID, colour_item(TB))
),
close(Stream)),
collect_tokens(TB, GroupedTokens).
collect_tokens(TB, GroupedTokens) :-
findall(Start-Token, json_token(TB, Start, Token), Pairs),
keysort(Pairs, Sorted),
pairs_values(Sorted, Tokens),
group_by_term(Tokens, GroupedTokens).
set_stream_file(_,_). % TBD
%% group_by_term(+Tokens, -Nested) is det.
%
% Group the tokens by input term. This simplifies incremental
% updates of the token list at the client sides as well as
% re-syncronizing. This predicate relies on the `fullstop` token
% that is emitted at the end of each input term.
group_by_term([], []) :- !.
group_by_term(Flat, [Term|Grouped]) :-
take_term(Flat, Term, Rest),
group_by_term(Rest, Grouped).
take_term([], [], []).
take_term([H|T0], [H|T], R) :-
( ends_term(H.get(type))
-> T = [],
R = T0
; take_term(T0, T, R)
).
ends_term(fullstop).
ends_term(syntax_error).
%% json_token(+TB, -Start, -JSON) is nondet.
%
% Extract the stored terms.
%
% @tbd We could consider to collect the attributes in the
% colour_item/4 callback and maintain a global variable
% instead of using assert/retract. Most likely that would
% be faster. Need to profile to check the bottleneck.
json_token(TB, Start, Token) :-
retract(token(Style, Start0, Len)),
debug(color, 'Trapped ~q.', [token(Style, Start0, Len)]),
( atomic_special(Style, Start0, Len, TB, Type, Attrs)
-> Start = Start0
; style(Style, Type0, Attrs0)
-> ( Type0 = StartType-EndType
-> ( Start = Start0,
Type = StartType
; Start is Start0+Len-1,
Type = EndType
)
; Type = Type0,
Start = Start0
),
json_attributes(Attrs0, Attrs, TB, Start0, Len)
),
dict_create(Token, json, [type(Type)|Attrs]).
atomic_special(atom, Start, Len, TB, Type, Attrs) :-
( memory_file_substring(TB, Start, 1, _, "'")
-> Type = qatom,
Attrs = []
; Type = atom,
( Len =< 5 % solo characters, neck, etc.
-> memory_file_substring(TB, Start, Len, _, Text),
Attrs = [text(Text)]
; Attrs = []
)
).
json_attributes([], [], _, _, _).
json_attributes([H0|T0], Attrs, TB, Start, Len) :-
json_attribute(H0, Attrs, T, TB, Start, Len), !,
json_attributes(T0, T, TB, Start, Len).
json_attributes([_|T0], T, TB, Start, Len) :-
json_attributes(T0, T, TB, Start, Len).
json_attribute(text, [text(Text)|T], T, TB, Start, Len) :- !,
memory_file_substring(TB, Start, Len, _, Text).
json_attribute(line(File:Line), [line(Line),file(File)|T], T, _, _, _) :- !.
json_attribute(Term, [Term|T], T, _, _, _).
colour_item(_TB, Style, Start, Len) :-
( style(Style)
-> assertz(token(Style, Start, Len))
; debug(color, 'Ignored ~q.', [token(Style, Start, Len)])
).
%% style(+StyleIn) is semidet.
%% style(+StyleIn, -SWISHType:atomOrPair, -Attributes:list)
%
% Declare that we map StyleIn as generated by
% library(prolog_colour) into a token of type SWISHType, providing
% additional context information based on Attributes. Elements of
% Attributes are terms of the form Name(Value) or the atom =text=.
% The latter is mapped to text(String), where String contains the
% text that matches the token character range.
%
% The resulting JSON token object has a property =type=,
% containing the SWISHType and the properties defined by
% Attributes.
%
% Additional translations can be defined by adding rules for the
% multifile predicate swish:style/3. The base type, which refers
% to the type generated by the SWISH tokenizer must be specified
% by adding an attribute base(BaseType). For example, if the
% colour system classifies an atom as refering to a database
% column, library(prolog_colour) may emit db_column(Name) and the
% following rule should ensure consistent mapping:
%
% ==
% swish_highlight:style(db_column(Name),
% db_column, [text, base(atom)]).
% ==
:- multifile
style/3.
style(Style) :-
style(Style, _, _).
style(neck(Neck), neck, [ text(Text) ]) :-
neck_text(Neck, Text).
style(head(Class, Head), Type, [ text, arity(Arity) ]) :-
goal_arity(Head, Arity),
head_type(Class, Type).
style(goal(Class, Goal), Type, [ text, arity(Arity) | More ]) :-
goal_arity(Goal, Arity),
goal_type(Class, Type, More).
style(file_no_depend(Path), file_no_depends, [text, path(Path)]).
style(file(Path), file, [text, path(Path)]).
style(nofile, nofile, [text]).
style(option_name, option_name, [text]).
style(no_option_name, no_option_name, [text]).
style(flag_name(_Flag), flag_name, [text]).
style(no_flag_name(_Flag), no_flag_name, [text]).
style(fullstop, fullstop, []).
style(var, var, [text]).
style(singleton, singleton, [text]).
style(string, string, []).
style(codes, codes, []).
style(chars, chars, []).
style(atom, atom, []).
style(meta(_Spec), meta, []).
style(op_type(_Type), op_type, [text]).
style(functor, functor, [text]).
style(control, control, [text]).
style(delimiter, delimiter, [text]).
style(identifier, identifier, [text]).
style(module(_Module), module, [text]).
style(error, error, [text]).
style(type_error(Expect), error, [text,expected(Expect)]).
style(syntax_error(_Msg,_Pos), syntax_error, []).
style(predicate_indicator, atom, [text]).
style(predicate_indicator, atom, [text]).
style(arity, int, []).
style(int, int, []).
style(float, float, []).
style(qq(open), qq_open, []).
style(qq(sep), qq_sep, []).
style(qq(close), qq_close, []).
style(qq_type, qq_type, [text]).
style(dict_tag, tag, [text]).
style(dict_key, key, [text]).
style(dict_sep, sep, []).
style(func_dot, atom, [text(.)]).
style(dict_return_op, atom, [text(:=)]).
style(dict_function(F), dict_function, [text(F)]).
style(empty_list, list_open-list_close, []).
style(list, list_open-list_close, []).
style(dcg(terminal), list_open-list_close, []).
style(dcg(string), string_terminal, []).
style(dcg(plain), brace_term_open-brace_term_close, []).
style(brace_term, brace_term_open-brace_term_close, []).
style(dict_content, dict_open-dict_close, []).
style(expanded, expanded, [text]).
style(comment_string, comment_string, []).
style(ext_quant, ext_quant, []).
% from library(http/html_write)
style(html(_Element), html, []).
style(entity(_Element), entity, []).
style(html_attribute(_), html_attribute, []).
style(sgml_attr_function,sgml_attr_function, []).
style(http_location_for_id(_), http_location_for_id, []).
style(http_no_location_for_id(_), http_no_location_for_id, []).
% XPCE support
style(method(send), xpce_method, [text]).
style(method(get), xpce_method, [text]).
style(class(built_in,_Name), xpce_class_built_in, [text]).
style(class(library(File),_Name), xpce_class_lib, [text, file(File)]).
style(class(user(File),_Name), xpce_class_user, [text, file(File)]).
style(class(user,_Name), xpce_class_user, [text]).
style(class(undefined,_Name), xpce_class_undef, [text]).
neck_text(clause, (:-)).
neck_text(grammar_rule, (-->)).
neck_text(method(send), (:->)).
neck_text(method(get), (:<-)).
neck_text(directive, (:-)).
head_type(exported, head_exported).
head_type(public(_), head_public).
head_type(extern(_), head_extern).
head_type(dynamic, head_dynamic).
head_type(multifile, head_multifile).
head_type(unreferenced, head_unreferenced).
head_type(hook, head_hook).
head_type(meta, head_meta).
head_type(constraint(_), head_constraint).
head_type(imported, head_imported).
head_type(built_in, head_built_in).
head_type(iso, head_iso).
head_type(def_iso, head_def_iso).
head_type(def_swi, head_def_swi).
head_type(_, head).
goal_type(built_in, goal_built_in, []).
goal_type(imported(File), goal_imported, [file(File)]).
goal_type(autoload(File), goal_autoload, [file(File)]).
goal_type(global, goal_global, []).
goal_type(undefined, goal_undefined, []).
goal_type(thread_local(Line), goal_thread_local, [line(Line)]).
goal_type(dynamic(Line), goal_dynamic, [line(Line)]).
goal_type(multifile(Line), goal_multifile, [line(Line)]).
goal_type(expanded, goal_expanded, []).
goal_type(extern(_), goal_extern, []).
goal_type(recursion, goal_recursion, []).
goal_type(meta, goal_meta, []).
goal_type(foreign(_), goal_foreign, []).
goal_type(local(Line), goal_local, [line(Line)]).
goal_type(constraint(Line), goal_constraint, [line(Line)]).
goal_type(not_callable, goal_not_callable, []).
%% goal_arity(+Goal, -Arity) is det.
%
% Get the arity of a goal safely in SWI7
goal_arity(Goal, Arity) :-
( compound(Goal)
-> compound_name_arity(Goal, _, Arity)
; Arity = 0
).
/*******************************
* HIGHLIGHT CONFIG *
*******************************/
:- multifile
swish_config:config/2,
css/3. % ?Context, ?Selector, -Attributes
%% swish_config:config(-Name, -Styles) is nondet.
%
% Provides the object `config.swish.style`, a JSON object that
% maps style properties of user-defined extensions of
% library(prolog_colour). This info is used by the server-side
% colour engine to populate the CodeMirror styles.
%
% @tbd Provide summary information
swish_config:config(cm_style, Styles) :-
findall(Name-Style, highlight_style(Name, Style), Pairs),
keysort(Pairs, Sorted),
remove_duplicate_styles(Sorted, Unique),
dict_pairs(Styles, json, Unique).
swish_config:config(cm_hover_style, Styles) :-
findall(Sel-Attrs, css_dict(hover, Sel, Attrs), Pairs),
dict_pairs(Styles, json, Pairs).
remove_duplicate_styles([], []).
remove_duplicate_styles([H|T0], [H|T]) :-
H = K-_,
remove_same(K, T0, T1),
remove_duplicate_styles(T1, T).
remove_same(K, [K-_|T0], T) :- !,
remove_same(K, T0, T).
remove_same(_, Rest, Rest).
highlight_style(StyleName, Style) :-
style(Term, StyleName, _),
atom(StyleName),
( prolog_colour:style(Term, Attrs0)
-> maplist(css_style, Attrs0, Attrs),
dict_create(Style, json, Attrs)
).
css_style(bold(true), 'font-weight'(bold)) :- !.
css_style(underline(true), 'text-decoration'(underline)) :- !.
css_style(colour(Name), color(RGB)) :-
current_prolog_flag(gui, true), !,
get(colour(Name), red, R0),
get(colour(Name), green, G0),
get(colour(Name), blue, B0),
R is R0//256,
G is G0//256,
B is B0//256,
format(atom(RGB), '#~|~`0t~16r~2+~`0t~16r~2+~`0t~16r~2+', [R,G,B]).
css_style(Style, Style).
%% css(?Context, ?Selector, -Style) is nondet.
%
% Multifile hook to define additional style to apply in a specific
% context. Currently defined contexts are:
%
% - hover
% Used for CodeMirror hover extension.
%
% @arg Selector is a CSS selector, which is refined by Context
% @arg Style is a list of Name(Value) terms.
css_dict(Context, Selector, Style) :-
css(Context, Selector, Attrs0),
maplist(css_style, Attrs0, Attrs),
dict_create(Style, json, Attrs).
/*******************************
* INFO *
*******************************/
:- multifile
prolog:predicate_summary/2.
%% token_info(+Request)
%
% HTTP handler that provides information about a token.
token_info(Request) :-
http_parameters(Request, [], [form_data(Form)]),
maplist(type_convert, Form, Values),
dict_create(Token, token, Values),
reply_html_page(plain,
title('token info'),
\token_info_or_none(Token)).
type_convert(Name=Atom, Name=Number) :-
atom_number(Atom, Number), !.
type_convert(NameValue, NameValue).
token_info_or_none(Token) -->
token_info(Token), !.
token_info_or_none(_) -->
html(span(class('token-noinfo'), 'No info available')).
%% token_info(+Token:dict)// is det.
%
% Generate HTML, providing details about Token. Token is a dict,
% providing the enriched token as defined by style/3. This
% multifile non-terminal can be hooked to provide details for user
% defined style extensions.
:- multifile token_info//1.
token_info(Token) -->
{ _{type:Type, text:Name, arity:Arity} :< Token,
goal_type(_, Type, _), !,
ignore(token_predicate_module(Token, Module)),
predicate_info(Module:Name/Arity, Info)
},
pred_info(Info).
pred_info([]) -->
html(span(class('pred-nosummary'), 'No help available')).
pred_info([Info|_]) --> % TBD: Ambiguous
(pred_tags(Info) -> [];[]),
(pred_summary(Info) -> [];[]).
pred_tags(Info) -->
{ Info.get(iso) == true },
html(span(class('pred-tag'), 'ISO')).
pred_summary(Info) -->
html(span(class('pred-summary'), Info.get(summary))).
%% token_predicate_module(+Token, -Module) is semidet.
%
% Try to extract the module from the token.
token_predicate_module(Token, Module) :-
source_file_property(Token.get(file), module(Module)), !.
%% predicate_info(+PI, -Info:list(dict)) is det.
%
% Info is a list of dicts providing details about predicates that
% match PI. Fields in dict are:
%
% - module:Atom
% Module of the predicate
% - name:Atom
% Name of the predicate
% - arity:Integer
% Arity of the predicate
% - summary:Text
% Summary text extracted from the system manual or PlDoc
% - iso:Boolean
% Presend and =true= if the predicate is an ISO predicate
predicate_info(PI, Info) :-
PI = Module:Name/Arity,
findall(Dict,
( setof(Key-Value,
predicate_info(PI, Key, Value),
Pairs),
dict_pairs(Dict, json,
[ module - Module,
name - Name,
arity - Arity
| Pairs
])
),
Info).
%% predicate_info(?PI, -Key, -Value) is nondet.
%
% Find information about predicates from the system, manual and
% PlDoc. First, we deal with ISO predicates that cannot be
% redefined and are documented in the manual. Next, we deal with
% predicates that are documented in the manual.
%
% @bug: Handling predicates documented in the manual is buggy
% because their definition may be overruled by the user. We
% probably must include the file into the equation.
% ISO predicates
predicate_info(Module:Name/Arity, Key, Value) :-
functor(Head, Name, Arity),
predicate_property(system:Head, iso), !,
ignore(Module = system),
( catch(predicate(Name, Arity, Summary, _, _), _, fail),
Key = summary,
Value = Summary
; Key = iso,
Value = true
).
predicate_info(_Module:Name/Arity, summary, Summary) :-
catch(predicate(Name, Arity, Summary, _, _), _, fail), !.
predicate_info(PI, summary, Summary) :- % PlDoc
prolog:predicate_summary(PI, Summary).