1:- module(lsp_utils, [called_at/3,
    2                      defined_at/3,
    3                      name_callable/2,
    4                      relative_ref_location/4,
    5                      help_at_position/4,
    6                      help_at_position/5,
    7                      clause_in_file_at_position/3,
    8                      clause_variable_positions/3,
    9                      usemod_filespec_position/4,
   10                      seek_to_line/2,
   11                      linechar_offset/3,
   12                      url_path/2,
   13                      unlimited//1
   14                     ]).

   23:- use_module(library(apply_macros)).   24:- use_module(library(apply), [maplist/3, exclude/3]).   25:- use_module(library(dcg/basics), [blanks//0, string_without//2, prolog_var_name//1]).   26:- use_module(library(dcg/high_order), [optional//2]).   27:- use_module(library(prolog_xref)).   28:- use_module(library(prolog_source), [read_source_term_at_location/3]).   29:- use_module(library(pldoc/doc_process), [is_structured_comment/2]).   30:- use_module(library(pldoc/doc_wiki), [indented_lines/3]).   31:- use_module(library(help)). % help_text/2 if new, help_html/3 & help_objects/3 if old
   32:- use_module(library(lynx/html_text), [html_text/1]). % only needed with old library(help)
   33:- use_module(library(solution_sequences), [distinct/2]).   34:- use_module(library(lists), [append/3, member/2, selectchk/4]).   35:- use_module(library(sgml), [load_html/3]). % only needed with old library(help)
   36:- use_module(library(strings), [string_lines/2]).   37:- use_module(library(uri), [uri_file_name/2]).   38:- use_module(library(yall)).   39
   40:- include('_lsp_path_add.pl').   41
   42:- use_module(lsp(lsp_html_markdown), [ html_markdown/1 ]).   43:- use_module(lsp(lsp_reading_source), [ file_lines_start_end/2,
   44                                         read_term_positions/2,
   45                                         read_term_positions/4,
   46                                         find_in_term_with_positions/5,
   47                                         position_to_match/3,
   48                                         file_offset_line_position/4 ]).   49
   50:- if(current_predicate(xref_called/5)).

 called_at(+Path:atom, +Clause:term, -Locations:list) is det

Find the callers and locations of the goal Clause, starting from the file Path. Locations will be a list of all the callers and locations that the Clause is called from as LSP-formatted dicts.

   55called_at(Path, Clause, Locations) :-
   56    setof(L, Path^Clause^Locs^(
   57                 called_at_(Path, Clause, Locs),
   58                 member(L, Locs)
   59             ),
   60          Locations), !.
   61called_at(Path, Clause, Locations) :-
   62    name_callable(Clause, Callable),
   63    xref_source(Path),
   64    xref_called(Path, Callable, _By, _, CallerLine),
   65    % we couldn't find the definition, but we know it's in that form, so give that at least
   66    succ(CallerLine0, CallerLine),
   67    Locations = [@{range: @{start: @{line: CallerLine0, character: 0},
   68                            end: @{line: CallerLine, character: 0}}}].
   69
   70called_at_(Path, Clause, Locations) :-
   71    name_callable(Clause, Callable),
   72    xref_source(Path),
   73    xref_called(Path, Callable, _By, _, CallerLine),
   74    file_lines_start_end(Path, LineCharRange),
   75    file_offset_line_position(LineCharRange, Offset, CallerLine, 0),
   76    read_term_positions(Path, Offset, Offset, TermInfos),
   77    Clause = FuncName/Arity,
   78    find_occurences_of_callable(Path, FuncName, Arity, TermInfos, Matches, []),
   79    maplist(position_to_match(LineCharRange), Matches, Locations).
   80called_at_(Path, Clause, Locations) :-
   81    xref_source(Path),
   82    Clause = FuncName/Arity,
   83    DcgArity is Arity + 2,
   84    DcgClause = FuncName/DcgArity,
   85    name_callable(DcgClause, DcgCallable),
   86    xref_defined(Path, DcgCallable, dcg),
   87    name_callable(DcgClause, DcgCallable),
   88    xref_called(Path, DcgCallable, _By, _, CallerLine),
   89    file_lines_start_end(Path, LineCharRange),
   90    file_offset_line_position(LineCharRange, Offset, CallerLine, 0),
   91    read_term_positions(Path, Offset, Offset, TermInfos),
   92    find_occurences_of_callable(Path, FuncName, DcgArity, TermInfos, Matches, Tail0),
   93    % also look for original arity in a dcg context
   94    % TODO: modify this to check that it's inside a DCG if it has this
   95    % arity...but not in braces?
   96    find_occurences_of_callable(Path, FuncName, Arity, TermInfos, Tail0, []),
   97    maplist(position_to_match(LineCharRange), Matches, Locations).
   98:- else.   99called_at(Path, Callable, By, Ref) :-
  100    xref_called(Path, Callable, By),
  101    xref_defined(Path, By, Ref).
  102:- endif.  103
  104find_occurences_of_callable(_, _, _, [], Tail, Tail).
  105find_occurences_of_callable(Path, FuncName, Arity, [TermInfo|TermInfos], Matches, Tail) :-
  106    FindState = in_meta(false),
  107    find_in_term_with_positions(term_matches_callable(FindState, Path, FuncName, Arity),
  108                                TermInfo.term, TermInfo.subterm, Matches, Tail0),
  109    find_occurences_of_callable(Path, FuncName, Arity, TermInfos, Tail0, Tail).
  110
  111term_matches_callable(FindState, Path, FuncName, Arity, Term, Position) :-
  112    arg(1, Position, Start),
  113    arg(2, Position, End),
  114    ( arg(1, FindState, in_meta(_, MStart, MEnd)),
  115      once( Start > MEnd ; End < MStart )
  116    -> nb_setarg(1, FindState, false)
  117    ; true ),
  118    term_matches_callable_(FindState, Path, FuncName, Arity, Term, Position).
  119
  120term_matches_callable_(_, _, FuncName, Arity, Term, _) :-
  121    nonvar(Term), Term = FuncName/Arity.
  122term_matches_callable_(_, _, FuncName, Arity, Term, _) :-
  123    nonvar(Term),
  124    functor(T, FuncName, Arity),
  125    Term = T, !.
  126term_matches_callable_(State, _, FuncName, Arity, Term, _) :-
  127    nonvar(Term),
  128    % TODO check the argument
  129    arg(1, State, in_meta(N, _, _)),
  130    MArity is Arity - N,
  131    functor(T, FuncName, MArity),
  132    Term = T, !.
  133term_matches_callable_(State, Path, _, _, Term, Position) :-
  134    nonvar(Term), compound(Term),
  135    compound_name_arity(Term, ThisName, ThisArity),
  136    name_callable(ThisName/ThisArity, Callable),
  137    xref_meta(Path, Callable, Called),
  138    member(E, Called), nonvar(E), E = _+N, integer(N),
  139    arg(1, Position, Start),
  140    arg(2, Position, End),
  141    nb_setarg(1, State, in_meta(N, Start, End)),
  142    fail.

 url_path(?FileUrl:atom, ?Path:atom) is det

Convert between file:// url and path

  147url_path(Url, Path) :-
  148    current_prolog_flag(windows, true),
  149    % on windows, in neovim at least, textDocument URI looks like
  150    % "file:///C:/foo/bar/baz.pl"; we need to strip off another
  151    % leading slash to get a valid path
  152    uri_file_name(Url, SlashPath),
  153    atom_concat('/', Path, SlashPath), !.
  154url_path(Url, Path) :-
  155    uri_file_name(Url, Path).
  156
  157defined_at(Path, Name/Arity, Location) :-
  158    name_callable(Name/Arity, Callable),
  159    xref_source(Path),
  160    xref_defined(Path, Callable, Ref),
  161    url_path(Doc, Path),
  162    relative_ref_location(Doc, Callable, Ref, Location).
  163defined_at(Path, Name/Arity, Location) :-
  164    % maybe it's a DCG?
  165    DcgArity is Arity + 2,
  166    name_callable(Name/DcgArity, Callable),
  167    xref_source(Path),
  168    xref_defined(Path, Callable, Ref),
  169    url_path(Doc, Path),
  170    relative_ref_location(Doc, Callable, Ref, Location).
  171
  172collapse_adjacent([X|Rst], [X|CRst]) :-
  173    collapse_adjacent(X, Rst, CRst).
  174collapse_adjacent(X, [Y|Rst], CRst) :-
  175    succ(X, Y), !,
  176    collapse_adjacent(Y, Rst, CRst).
  177collapse_adjacent(_, [X|Rst], [X|CRst]) :- !,
  178    collapse_adjacent(X, Rst, CRst).
  179collapse_adjacent(_, [], []).

 name_callable(?Name:functor, ?Callable:term) is det

True when, if Name = Func/Arity, Callable = Func(_, _, ...) with Arity args.

  185name_callable(Name/0, Name) :- atom(Name), !.
  186name_callable(Name/Arity, Callable) :-
  187    length(FakeArgs, Arity),
  188    Callable =.. [Name|FakeArgs], !.

 relative_ref_location(+Path:atom, +Goal:term, +Position:position(int,int), -Location:dict) is semidet

Given Goal found in Path and position Position (from called_at/3), Location is a dictionary suitable for sending as an LSP response indicating the position in a file of Goal.

  194relative_ref_location(Here, _, position(Line0, Char1),
  195                      @{uri: Here, range: @{start: @{line: Line0, character: Char1},
  196                                            end: @{line: Line1, character: 0}}}) :-
  197    !, succ(Line0, Line1).
  198relative_ref_location(Here, _, local(Line1),
  199                      @{uri: Here, range: @{start: @{line: Line0, character: 1},
  200                                            end: @{line: NextLine, character: 0}}}) :-
  201    !, succ(Line0, Line1), succ(Line1, NextLine).
  202relative_ref_location(_, Goal, imported(Path), Location) :-
  203    url_path(ThereUri, Path),
  204    xref_source(Path),
  205    xref_defined(Path, Goal, Loc),
  206    relative_ref_location(ThereUri, Goal, Loc, Location).
  207
  208xref_source_recursive(S) :-
  209    xref_source(S),
  210    forall(xref_uses_file(S, Spec, Path),
  211           ( xref_current_source(Path)
  212           -> true
  213           ; debug(lsp(utils), "~w loads ~w @ ~w", [S, Spec, Path]),
  214             xref_source(Path) )).

 help_at_position(+Path:atom, +Line:integer, +Char:integer, -Help:string) is det

Help is the documentation for the term under the cursor at line Line, character Char in the file Path.

  220help_at_position(Path, Line1, Char0, S) :-
  221    help_at_position(plaintext, Path, Line1, Char0, S).

 help_at_position(+Format:atom, +Path:atom, +Line:integer, +Char:integer, -Help:string) is det

Help is the documentation for the term under the cursor at line Line, character Char in the file Path.

  227help_at_position(Format, Path, Line1, Char0, S) :-
  228    xref_source_recursive(Path), % recursively xref dependencies to get docs
  229    clause_in_file_at_position(Clause, Path, line_char(Line1, Char0)),
  230    predicate_help(Format, Path, Clause, S0),
  231    maybe_move_path(Path, S0, S1),
  232    format_help(S1, S).

 maybe_move_path(+Path:string, +Help0:string, -Help:string) is det

If Help0 starts with Path (as it would if it is the help for a locally defined predicate), Help is the text of Help0 but with Path moved to the end. This gives better hover-help for local predicates (since, in Emacs at least, it just shows the first line in the message area on hover).

  241maybe_move_path(Path, Help0, Help) :-
  242    string_concat(Path, "\n\n", Path1),
  243    string_concat(Path1, Help1, Help0), !,
  244    format(string(Help), "~w~n~n~w", [Help1, Path]).
  245maybe_move_path(_, Help, Help).
  246
  247blank_string(S) :-
  248    string_codes(S, Cs),
  249    phrase(blanks, Cs, []).

 format_help(+Help0:text, -Help1:text) is det

Reformat help string, so the first line is the signature of the predicate.

  254format_help(HelpFull, Help) :-
  255    split_string(HelpFull, "\n", " ", Lines0),
  256    exclude([Line]>>string_concat("Availability: ", _, Line),
  257            Lines0, Lines1),
  258    exclude(blank_string, Lines1, Lines2),
  259    Lines2 = [HelpShort|_],
  260    split_string(HelpFull, "\n", " ", HelpLines),
  261    selectchk(HelpShort, HelpLines, "", HelpLines0),
  262    append([HelpShort], HelpLines0, HelpLines1),
  263    atomic_list_concat(HelpLines1, "\n", Help0),
  264    split_string(Help0, "", "\n", [Help1]),
  265    atom_string(Help, Help1).
  266
  267:- if(current_predicate(help_text/2)).  268predicate_help(plaintext, _Path, Pred, Help) :-
  269    help_text(Pred, Help), !.
  270:- endif.  271predicate_help(Format, _Path, Pred, Help) :-
  272    nonvar(Pred),
  273    prolog_help:help_objects(Pred, exact, Matches), !,
  274    catch(prolog_help:help_html(Matches, exact-exact, HtmlDoc), _, fail),
  275    setup_call_cleanup(open_string(HtmlDoc, In),
  276                       load_html(stream(In), Dom, []),
  277                       close(In)),
  278    debug(xxx, "HELP HTML ~q", [Dom]),
  279    with_output_to(string(Help),
  280                   ( Format == markdown
  281                   -> html_markdown(Dom)
  282                   ; html_text(Dom) )
  283                  ).
  284predicate_help(_Format, HerePath, Pred, Help) :-
  285    xref_source(HerePath),
  286    name_callable(Pred, Callable),
  287    xref_defined(HerePath, Callable, Loc),
  288    location_path(HerePath, Loc, Path),
  289    once(xref_comment(Path, Callable, Summary, Comment)),
  290    % TODO: try to markdownify here if format?
  291    pldoc_process:parse_comment(Comment, Path:0, Parsed),
  292    memberchk(mode(Signature, Mode), Parsed),
  293    memberchk(predicate(_, Summary, CommentText), Parsed),
  294    comment_variable_names(CommentText, VariableNames),
  295    zip_args(Signature, VariableNames, Parameters),
  296    format(string(Help), "  ~W is ~w.~n~n~w",
  297           [Parameters, [spacing(next_argument)], Mode, Summary]),
  298    !.
  299
  300zip_args(Term, VariableNames, Parameters) :-
  301    compound_name_arguments(Term, Name, TypeModes),
  302    write_canonical(TypeModes),
  303    maplist([TypeMode, VarName, Param]>>(
  304                TypeMode =.. [Mode, Type],
  305                format(string(Param), "~w~w:~w", [Mode, VarName, Type])
  306            ),
  307            TypeModes, VariableNames, Combined),
  308    compound_name_arguments(Parameters, Name, Combined).
  309
  310comment_variable_names(CommentText, VariableNames) :-
  311    is_structured_comment(CommentText, Prefixes),
  312    string_codes(CommentText, CommentTextCodes),
  313    indented_lines(CommentTextCodes, Prefixes, IndentLines),
  314    convlist([_-Codes, String]>>(Codes \== [], string_codes(String, Codes)),
  315             IndentLines, Lines),
  316    string_lines(StrippedComment, Lines),
  317    string_codes(StrippedComment, StrippedCommentTextCodes),
  318    phrase(comment_variables(VariableNames), StrippedCommentTextCodes, _).
  319
  320comment_variables(VarNames) -->
  321    blanks, string_without("(", _), "(",
  322    comment_variables_(VarNames).
  323
  324comment_variables_([]) --> ")", !.
  325comment_variables_([VarName|VarNames]) -->
  326    blanks,
  327    optional(one_of(["+", "-", "?", ":"], ModeIndicator), [ModeIndicator = missing]), !,
  328    prolog_var_name(VarName), blanks,
  329    optional(comment_type_indicator(Type), { Type = any }),
  330    blanks,
  331    comment_variables_next(VarNames).
  332
  333comment_variables_next(VarNames) --> ",", !, comment_variables_(VarNames).
  334comment_variables_next([]) --> ")", !.
  335
  336comment_type_indicator(TypeName) -->
  337    ":", string_without(", )", TypeName).
  338
  339one_of([], _) --> !, { fail }.
  340one_of([A|_], A) --> A.
  341one_of([_|Others], Other) --> one_of(Others, Other).
  342
  343
  344/*
  345predicate_help(_, Pred/_Arity, Help) :-
  346    help_objects(Pred, dwim, Matches), !,
  347    catch(help_html(Matches, dwim-Pred, HtmlDoc), _, fail),
  348    setup_call_cleanup(open_string(HtmlDoc, In),
  349                       load_html(stream(In), Dom, []),
  350                       close(In)),
  351    with_output_to(string(Help), html_text(Dom)).
  352*/
  353
  354location_path(HerePath, local(_), HerePath).
  355location_path(_, imported(Path), Path).
  356
  357linechar_offset(Stream, line_char(Line1, Char0), Offset) :-
  358    seek(Stream, 0, bof, _),
  359    seek_to_line(Stream, Line1),
  360    seek(Stream, Char0, current, Offset).
  361
  362seek_to_line(Stream, N) :-
  363    N > 1, !,
  364    skip(Stream, 0'\n),
  365    NN is N - 1,
  366    seek_to_line(Stream, NN).
  367seek_to_line(_, _).
  368
  369clause_variable_positions(Path, Line, Variables) :-
  370    file_lines_start_end(Path, LineCharRange),
  371    read_term_positions(Path, TermsWithPositions),
  372    % find the top-level term that the offset falls within
  373    file_offset_line_position(LineCharRange, Offset, Line, 0),
  374    member(TermInfo, TermsWithPositions),
  375    SubTermPoses = TermInfo.subterm,
  376    arg(1, SubTermPoses, TermFrom),
  377    arg(2, SubTermPoses, TermTo),
  378    between(TermFrom, TermTo, Offset), !,
  379    find_in_term_with_positions(
  380        [X, _]>>( \+ \+ ( X = '$var'(Name), ground(Name) ) ),
  381        TermInfo.term,
  382        TermInfo.subterm,
  383        VariablesPositions, []
  384    ),
  385    findall(
  386        VarName-Locations,
  387        group_by(
  388            VarName,
  389            Location,
  390            ( member(found_at('$var'(VarName), Location0-_), VariablesPositions),
  391              file_offset_line_position(LineCharRange, Location0, L1, C),
  392              succ(L0, L1),
  393              Location = position(L0, C)
  394            ),
  395            Locations
  396        ),
  397        Variables).
  398
  399usemod_filespec_position(Path, Line, FileSpec, Position) :-
  400    file_lines_start_end(Path, LineCharRange),
  401    read_term_positions(Path, TermsWithPositions),
  402    % find the top-level term that the offset falls within
  403    file_offset_line_position(LineCharRange, Offset, Line, 0),
  404    member(TermInfo, TermsWithPositions),
  405    SubTermPoses = TermInfo.subterm,
  406    arg(1, SubTermPoses, TermFrom),
  407    arg(2, SubTermPoses, TermTo),
  408    between(TermFrom, TermTo, Offset), !,
  409    find_in_term_with_positions(
  410        {FileSpec}/[Term, _]>>once(matches_use_module(FileSpec, Term)),
  411        TermInfo.term,
  412        TermInfo.subterm,
  413        Positions,
  414        [] ),
  415    member(
  416        found_at(_Term,
  417            term_position(_, _, _, _, [ % :- ...
  418                term_position(_, _, _, _, [ % use_module(...)
  419                    SpecPos | _Rest])])),
  420        Positions
  421    ),
  422    termpos_start_end(SpecPos, Start, End),
  423    file_offset_line_position(LineCharRange, Start, StartLine1, StartCol),
  424    file_offset_line_position(LineCharRange, End, EndLine1, EndCol),
  425    succ(StartLine, StartLine1),
  426    succ(EndLine, EndLine1),
  427    Position = @{start: @{line: StartLine, character: StartCol},
  428                 end:   @{line: EndLine,   character: EndCol  } }.
  429
  430matches_use_module(FileSpec, ( :- use_module(FileSpec) )).
  431matches_use_module(FileSpec, ( :- use_module(FileSpec, _) )).
  432
  433termpos_start_end(From-To, From, To) :- !. % Primitive types (atoms, numbers, variables)
  434termpos_start_end(Term, From, To) :-
  435    arg(1, Term, From),
  436    arg(2, Term, To).
  437
  438clause_in_file_at_position(Clause, Path, Position) :-
  439    xref_source(Path),
  440    findall(Op, xref_op(Path, Op), Ops),
  441    setup_call_cleanup(
  442        open(Path, read, Stream, [ newline(posix) ]),
  443        clause_at_position(Stream, Ops, Clause, Position),
  444        close(Stream)
  445    ).
  446
  447clause_at_position(Stream, Ops, Clause, Start) :-
  448    linechar_offset(Stream, Start, Offset), !,
  449    clause_at_position(Stream, Ops, Clause, Start, Offset).
  450clause_at_position(Stream, Ops, Clause, line_char(Line1, Char), Here) :-
  451    read_source_term_at_location(Stream, Terms, [line(Line1),
  452                                                 subterm_positions(SubPos),
  453                                                 operators(Ops),
  454                                                 error(Error)]),
  455    extract_clause_at_position(Stream, Ops, Terms, line_char(Line1, Char), Here,
  456                               SubPos, Error, Clause).
  457
  458extract_clause_at_position(Stream, Ops, _, line_char(Line1, Char), Here, _,
  459                           Error, Clause) :-
  460    nonvar(Error), !, Line1 > 1,
  461    LineBack is Line1 - 1,
  462    clause_at_position(Stream, Ops, Clause, line_char(LineBack, Char), Here).
  463extract_clause_at_position(_, _, Terms, _, Here, SubPos, _, Clause) :-
  464    once(find_clause(Terms, Here, SubPos, Clause)).

 find_clause(+Term:term, ?Offset:int, +Position:position, ?Subclause) is nondet

True when Subclause is a subclause of Term at offset Offset and Position is the term positions for Term as given by read_term/3 with =subterm_positions(Position)=.

  470find_clause(Term, Offset, F-T, Clause) :-
  471    between(F, T, Offset),
  472    ground(Term), Clause = Term/0.
  473find_clause(Term, Offset, term_position(_, _, FF, FT, _), Name/Arity) :-
  474    between(FF, FT, Offset),
  475    functor(Term, Name, Arity).
  476find_clause(Term, Offset, term_position(F, T, _, _, SubPoses), Clause) :-
  477    between(F, T, Offset),
  478    Term =.. [_|SubTerms],
  479    find_containing_term(Offset, SubTerms, SubPoses, SubTerm, SubPos),
  480    find_clause(SubTerm, Offset, SubPos, Clause).
  481find_clause(Term, Offset, parentheses_term_position(F, T, SubPoses), Clause) :-
  482    between(F, T, Offset),
  483    find_clause(Term, Offset, SubPoses, Clause).
  484find_clause({SubTerm}, Offset, brace_term_position(F, T, SubPos), Clause) :-
  485    between(F, T, Offset),
  486    find_clause(SubTerm, Offset, SubPos, Clause).
  487
  488find_containing_term(Offset, [Term|_], [F-T|_], Term, F-T) :-
  489    between(F, T, Offset).
  490find_containing_term(Offset, [Term|_], [P|_], Term, P) :-
  491    P = term_position(F, T, _, _, _),
  492    between(F, T, Offset), !.
  493find_containing_term(Offset, [Term|_], [PP|_], Term, P) :-
  494    PP = parentheses_term_position(F, T, P),
  495    between(F, T, Offset), !.
  496find_containing_term(Offset, [BTerm|_], [BP|_], Term, P) :-
  497    BP = brace_term_position(F, T, P),
  498    {Term} = BTerm,
  499    between(F, T, Offset).
  500find_containing_term(Offset, [Terms|_], [LP|_], Term, P) :-
  501    LP = list_position(_F, _T, Ps, _),
  502    find_containing_term(Offset, Terms, Ps, Term, P).
  503find_containing_term(Offset, [Dict|_], [DP|_], Term, P) :-
  504    DP = dict_position(_, _, _, _, Ps),
  505    member(key_value_position(_F, _T, _SepF, _SepT, Key, _KeyPos, ValuePos),
  506           Ps),
  507    get_dict(Key, Dict, Value),
  508    find_containing_term(Offset, [Value], [ValuePos], Term, P).
  509find_containing_term(Offset, [_|Ts], [_|Ps], T, P) :-
  510    find_containing_term(Offset, Ts, Ps, T, P).
  511
  512:- meta_predicate unlimited(//, *, *).

 unlimited(:Nonterminal)// is semidet

Tries to parse Nonterminal an unlimited number of times. If the provided nonterminal ever fails, unlimited fails too. This rule can never actually succeed (i.e. yield true), although it could be considered to succeed "at infinity." Nonterminal is likely to be a DCG rule which performs side effects as it parses.

  521unlimited(Nonterminal) -->
  522    call(Nonterminal),
  523    unlimited(Nonterminal)