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                      clause_in_file_at_position/3,
    7                      clause_variable_positions/3,
    8                      seek_to_line/2,
    9                      linechar_offset/3
   10                     ]).

   19:- use_module(library(apply_macros)).   20:- use_module(library(apply), [maplist/3, exclude/3]).   21:- use_module(library(prolog_xref)).   22:- use_module(library(prolog_source), [read_source_term_at_location/3]).   23:- use_module(library(help), [help_html/3, help_objects/3]).   24:- use_module(library(lynx/html_text), [html_text/1]).   25:- use_module(library(solution_sequences), [distinct/2]).   26:- use_module(library(lists), [append/3, member/2, selectchk/4]).   27:- use_module(library(sgml), [load_html/3]).   28:- use_module(library(yall)).   29
   30:- include('_lsp_path_add.pl').   31
   32:- use_module(lsp(lsp_reading_source), [ file_lines_start_end/2,
   33                                         read_term_positions/2,
   34                                         read_term_positions/4,
   35                                         find_in_term_with_positions/5,
   36                                         position_to_match/3,
   37                                         file_offset_line_position/4 ]).   38
   39:- 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.

   44called_at(Path, Clause, Locations) :-
   45    setof(L, Path^Clause^Locs^(
   46                 called_at_(Path, Clause, Locs),
   47                 member(L, Locs)
   48             ),
   49          Locations), !.
   50called_at(Path, Clause, Locations) :-
   51    name_callable(Clause, Callable),
   52    xref_source(Path),
   53    xref_called(Path, Callable, _By, _, CallerLine),
   54    % we couldn't find the definition, but we know it's in that form, so give that at least
   55    succ(CallerLine0, CallerLine),
   56    Locations = [_{range: _{start: _{line: CallerLine0, character: 0},
   57                            end: _{line: CallerLine, character: 0}}}].
   58
   59called_at_(Path, Clause, Locations) :-
   60    name_callable(Clause, Callable),
   61    xref_source(Path),
   62    xref_called(Path, Callable, _By, _, CallerLine),
   63    file_lines_start_end(Path, LineCharRange),
   64    file_offset_line_position(LineCharRange, Offset, CallerLine, 0),
   65    read_term_positions(Path, Offset, Offset, TermInfos),
   66    Clause = FuncName/Arity,
   67    find_occurences_of_callable(Path, FuncName, Arity, TermInfos, Matches, []),
   68    maplist(position_to_match(LineCharRange), Matches, Locations).
   69called_at_(Path, Clause, Locations) :-
   70    xref_source(Path),
   71    Clause = FuncName/Arity,
   72    DcgArity is Arity + 2,
   73    DcgClause = FuncName/DcgArity,
   74    name_callable(DcgClause, DcgCallable),
   75    xref_defined(Path, DcgCallable, dcg),
   76    name_callable(DcgClause, DcgCallable),
   77    xref_called(Path, DcgCallable, _By, _, CallerLine),
   78    file_lines_start_end(Path, LineCharRange),
   79    file_offset_line_position(LineCharRange, Offset, CallerLine, 0),
   80    read_term_positions(Path, Offset, Offset, TermInfos),
   81    find_occurences_of_callable(Path, FuncName, DcgArity, TermInfos, Matches, Tail0),
   82    % also look for original arity in a dcg context
   83    % TODO: modify this to check that it's inside a DCG if it has this
   84    % arity...but not in braces?
   85    find_occurences_of_callable(Path, FuncName, Arity, TermInfos, Tail0, []),
   86    maplist(position_to_match(LineCharRange), Matches, Locations).
   87:- else.   88called_at(Path, Callable, By, Ref) :-
   89    xref_called(Path, Callable, By),
   90    xref_defined(Path, By, Ref).
   91:- endif.   92
   93find_occurences_of_callable(_, _, _, [], Tail, Tail).
   94find_occurences_of_callable(Path, FuncName, Arity, [TermInfo|TermInfos], Matches, Tail) :-
   95    FindState = in_meta(false),
   96    find_in_term_with_positions(term_matches_callable(FindState, Path, FuncName, Arity),
   97                                TermInfo.term, TermInfo.subterm, Matches, Tail0),
   98    find_occurences_of_callable(Path, FuncName, Arity, TermInfos, Tail0, Tail).
   99
  100term_matches_callable(FindState, Path, FuncName, Arity, Term, Position) :-
  101    arg(1, Position, Start),
  102    arg(2, Position, End),
  103    ( arg(1, FindState, in_meta(_, MStart, MEnd)),
  104      once( Start > MEnd ; End < MStart )
  105    -> nb_setarg(1, FindState, false)
  106    ; true ),
  107    term_matches_callable_(FindState, Path, FuncName, Arity, Term, Position).
  108
  109term_matches_callable_(_, _, FuncName, Arity, Term, _) :-
  110    nonvar(Term), Term = FuncName/Arity.
  111term_matches_callable_(_, _, FuncName, Arity, Term, _) :-
  112    nonvar(Term),
  113    functor(T, FuncName, Arity),
  114    Term = T, !.
  115term_matches_callable_(State, _, FuncName, Arity, Term, _) :-
  116    nonvar(Term),
  117    % TODO check the argument
  118    arg(1, State, in_meta(N, _, _)),
  119    MArity is Arity - N,
  120    functor(T, FuncName, MArity),
  121    Term = T, !.
  122term_matches_callable_(State, Path, _, _, Term, Position) :-
  123    nonvar(Term), compound(Term),
  124    compound_name_arity(Term, ThisName, ThisArity),
  125    name_callable(ThisName/ThisArity, Callable),
  126    xref_meta(Path, Callable, Called),
  127    member(E, Called), nonvar(E), E = _+N, integer(N),
  128    arg(1, Position, Start),
  129    arg(2, Position, End),
  130    nb_setarg(1, State, in_meta(N, Start, End)),
  131    fail.
  132
  133defined_at(Path, Name/Arity, Location) :-
  134    name_callable(Name/Arity, Callable),
  135    xref_source(Path),
  136    xref_defined(Path, Callable, Ref),
  137    atom_concat('file://', Path, Doc),
  138    relative_ref_location(Doc, Callable, Ref, Location).
  139defined_at(Path, Name/Arity, Location) :-
  140    % maybe it's a DCG?
  141    DcgArity is Arity + 2,
  142    name_callable(Name/DcgArity, Callable),
  143    xref_source(Path),
  144    xref_defined(Path, Callable, Ref),
  145    atom_concat('file://', Path, Doc),
  146    relative_ref_location(Doc, Callable, Ref, Location).
  147
  148
  149find_subclause(Stream, Subclause, CallerLine, Locations) :-
  150    read_source_term_at_location(Stream, Term, [line(CallerLine),
  151                                                subterm_positions(Poses)]),
  152    findall(Offset, distinct(Offset, find_clause(Term, Offset, Poses, Subclause)),
  153            Offsets),
  154    collapse_adjacent(Offsets, StartOffsets),
  155    maplist(offset_line_char(Stream), StartOffsets, Locations).
  156
  157offset_line_char(Stream, Offset, position(Line, Char)) :-
  158    % seek(Stream, 0, bof, _),
  159    % for some reason, seek/4 isn't zeroing stream line position
  160    set_stream_position(Stream, '$stream_position'(0, 0, 0, 0)),
  161    setup_call_cleanup(
  162        open_null_stream(NullStream),
  163        copy_stream_data(Stream, NullStream, Offset),
  164        close(NullStream)
  165    ),
  166    stream_property(Stream, position(Pos)),
  167    stream_position_data(line_count, Pos, Line),
  168    stream_position_data(line_position, Pos, Char).
  169
  170collapse_adjacent([X|Rst], [X|CRst]) :-
  171    collapse_adjacent(X, Rst, CRst).
  172collapse_adjacent(X, [Y|Rst], CRst) :-
  173    succ(X, Y), !,
  174    collapse_adjacent(Y, Rst, CRst).
  175collapse_adjacent(_, [X|Rst], [X|CRst]) :- !,
  176    collapse_adjacent(X, Rst, CRst).
  177collapse_adjacent(_, [], []).

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

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

  183name_callable(Name/0, Name) :- atom(Name), !.
  184name_callable(Name/Arity, Callable) :-
  185    length(FakeArgs, Arity),
  186    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.

  192relative_ref_location(Here, _, position(Line0, Char1),
  193                      _{uri: Here, range: _{start: _{line: Line0, character: Char1},
  194                                            end: _{line: Line1, character: 0}}}) :-
  195    !, succ(Line0, Line1).
  196relative_ref_location(Here, _, local(Line1),
  197                      _{uri: Here, range: _{start: _{line: Line0, character: 1},
  198                                            end: _{line: NextLine, character: 0}}}) :-
  199    !, succ(Line0, Line1), succ(Line1, NextLine).
  200relative_ref_location(_, Goal, imported(Path), Location) :-
  201    atom_concat('file://', Path, ThereUri),
  202    xref_source(Path),
  203    xref_defined(Path, Goal, Loc),
  204    relative_ref_location(ThereUri, Goal, Loc, Location).

 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.

  210help_at_position(Path, Line1, Char0, S) :-
  211    clause_in_file_at_position(Clause, Path, line_char(Line1, Char0)),
  212    predicate_help(Path, Clause, S0),
  213    format_help(S0, S).

 format_help(+Help0, -Help1) is det

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

  218format_help(HelpFull, Help) :-
  219    split_string(HelpFull, "\n", " ", Lines0),
  220    exclude([Line]>>string_concat("Availability: ", _, Line),
  221            Lines0, Lines1),
  222    exclude([""]>>true, Lines1, Lines2),
  223    Lines2 = [HelpShort|_],
  224    split_string(HelpFull, "\n", "", HelpLines),
  225    selectchk(HelpShort, HelpLines, "", HelpLines0),
  226    append([HelpShort], HelpLines0, HelpLines1),
  227    atomic_list_concat(HelpLines1, "\n", Help).
  228
  229predicate_help(_, Pred, Help) :-
  230    nonvar(Pred),
  231    help_objects(Pred, exact, Matches), !,
  232    catch(help_html(Matches, exact-exact, HtmlDoc), _, fail),
  233    setup_call_cleanup(open_string(HtmlDoc, In),
  234                       load_html(stream(In), Dom, []),
  235                       close(In)),
  236    with_output_to(string(Help), html_text(Dom)).
  237predicate_help(HerePath, Pred, Help) :-
  238    xref_source(HerePath),
  239    name_callable(Pred, Callable),
  240    xref_defined(HerePath, Callable, Loc),
  241    location_path(HerePath, Loc, Path),
  242    once(xref_comment(Path, Callable, Summary, Comment)),
  243    pldoc_process:parse_comment(Comment, Path:0, Parsed),
  244    memberchk(mode(Signature, Mode), Parsed),
  245    memberchk(predicate(_, Summary, _), Parsed),
  246    format(string(Help), "  ~w is ~w.~n~n~w", [Signature, Mode, Summary]).
  247predicate_help(_, Pred/_Arity, Help) :-
  248    help_objects(Pred, dwim, Matches), !,
  249    catch(help_html(Matches, dwim-Pred, HtmlDoc), _, fail),
  250    setup_call_cleanup(open_string(HtmlDoc, In),
  251                       load_html(stream(In), Dom, []),
  252                       close(In)),
  253    with_output_to(string(Help), html_text(Dom)).
  254
  255location_path(HerePath, local(_), HerePath).
  256location_path(_, imported(Path), Path).
  257
  258linechar_offset(Stream, line_char(Line1, Char0), Offset) :-
  259    seek(Stream, 0, bof, _),
  260    seek_to_line(Stream, Line1),
  261    seek(Stream, Char0, current, Offset).
  262
  263seek_to_line(Stream, N) :-
  264    N > 1, !,
  265    skip(Stream, 0'\n),
  266    NN is N - 1,
  267    seek_to_line(Stream, NN).
  268seek_to_line(_, _).
  269
  270clause_variable_positions(Path, Line, Variables) :-
  271    file_lines_start_end(Path, LineCharRange),
  272    read_term_positions(Path, TermsWithPositions),
  273    % find the top-level term that the offset falls within
  274    file_offset_line_position(LineCharRange, Offset, Line, 0),
  275    member(TermInfo, TermsWithPositions),
  276    SubTermPoses = TermInfo.subterm,
  277    arg(1, SubTermPoses, TermFrom),
  278    arg(2, SubTermPoses, TermTo),
  279    between(TermFrom, TermTo, Offset), !,
  280    find_in_term_with_positions(
  281        [X, _]>>( \+ \+ ( X = '$var'(Name), ground(Name) ) ),
  282        TermInfo.term,
  283        TermInfo.subterm,
  284        VariablesPositions, []
  285    ),
  286    findall(
  287        VarName-Locations,
  288        group_by(
  289            VarName,
  290            Location,
  291            ( member(found_at('$var'(VarName), Location0-_), VariablesPositions),
  292              file_offset_line_position(LineCharRange, Location0, L1, C),
  293              succ(L0, L1),
  294              Location = position(L0, C)
  295            ),
  296            Locations
  297        ),
  298        Variables).
  299
  300clause_in_file_at_position(Clause, Path, Position) :-
  301    xref_source(Path),
  302    findall(Op, xref_op(Path, Op), Ops),
  303    setup_call_cleanup(
  304        open(Path, read, Stream, []),
  305        clause_at_position(Stream, Ops, Clause, Position),
  306        close(Stream)
  307    ).
  308
  309clause_at_position(Stream, Ops, Clause, Start) :-
  310    linechar_offset(Stream, Start, Offset), !,
  311    clause_at_position(Stream, Ops, Clause, Start, Offset).
  312clause_at_position(Stream, Ops, Clause, line_char(Line1, Char), Here) :-
  313    read_source_term_at_location(Stream, Terms, [line(Line1),
  314                                                 subterm_positions(SubPos),
  315                                                 operators(Ops),
  316                                                 error(Error)]),
  317    extract_clause_at_position(Stream, Ops, Terms, line_char(Line1, Char), Here,
  318                               SubPos, Error, Clause).
  319
  320extract_clause_at_position(Stream, Ops, _, line_char(Line1, Char), Here, _,
  321                           Error, Clause) :-
  322    nonvar(Error), !, Line1 > 1,
  323    LineBack is Line1 - 1,
  324    clause_at_position(Stream, Ops, Clause, line_char(LineBack, Char), Here).
  325extract_clause_at_position(_, _, Terms, _, Here, SubPos, _, Clause) :-
  326    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)=.

  332find_clause(Term, Offset, F-T, Clause) :-
  333    between(F, T, Offset),
  334    ground(Term), Clause = Term/0.
  335find_clause(Term, Offset, term_position(_, _, FF, FT, _), Name/Arity) :-
  336    between(FF, FT, Offset),
  337    functor(Term, Name, Arity).
  338find_clause(Term, Offset, term_position(F, T, _, _, SubPoses), Clause) :-
  339    between(F, T, Offset),
  340    Term =.. [_|SubTerms],
  341    find_containing_term(Offset, SubTerms, SubPoses, SubTerm, SubPos),
  342    find_clause(SubTerm, Offset, SubPos, Clause).
  343find_clause(Term, Offset, parentheses_term_position(F, T, SubPoses), Clause) :-
  344    between(F, T, Offset),
  345    find_clause(Term, Offset, SubPoses, Clause).
  346find_clause({SubTerm}, Offset, brace_term_position(F, T, SubPos), Clause) :-
  347    between(F, T, Offset),
  348    find_clause(SubTerm, Offset, SubPos, Clause).
  349
  350find_containing_term(Offset, [Term|_], [F-T|_], Term, F-T) :-
  351    between(F, T, Offset).
  352find_containing_term(Offset, [Term|_], [P|_], Term, P) :-
  353    P = term_position(F, T, _, _, _),
  354    between(F, T, Offset), !.
  355find_containing_term(Offset, [Term|_], [PP|_], Term, P) :-
  356    PP = parentheses_term_position(F, T, P),
  357    between(F, T, Offset), !.
  358find_containing_term(Offset, [BTerm|_], [BP|_], Term, P) :-
  359    BP = brace_term_position(F, T, P),
  360    {Term} = BTerm,
  361    between(F, T, Offset).
  362find_containing_term(Offset, [Terms|_], [LP|_], Term, P) :-
  363    LP = list_position(_F, _T, Ps, _),
  364    find_containing_term(Offset, Terms, Ps, Term, P).
  365find_containing_term(Offset, [Dict|_], [DP|_], Term, P) :-
  366    DP = dict_position(_, _, _, _, Ps),
  367    member(key_value_position(_F, _T, _SepF, _SepT, Key, _KeyPos, ValuePos),
  368           Ps),
  369    get_dict(Key, Dict, Value),
  370    find_containing_term(Offset, [Value], [ValuePos], Term, P).
  371find_containing_term(Offset, [_|Ts], [_|Ps], T, P) :-
  372    find_containing_term(Offset, Ts, Ps, T, P)