1:- module(lsp_colours, [file_colours/2,
    2                        file_range_colours/4,
    3                        token_types/1,
    4                        token_modifiers/1]).

   12:- use_module(library(apply), [maplist/4]).   13:- use_module(library(apply_macros)).   14:- use_module(library(debug), [debug/3]).   15:- use_module(library(lists), [numlist/3, nth0/3]).   16:- use_module(library(prolog_colour), [prolog_colourise_stream/3,
   17                                       prolog_colourise_term/4]).   18:- use_module(library(prolog_source), [read_source_term_at_location/3]).   19:- use_module(library(yall)).   20
   21:- include('_lsp_path_add.pl').   22:- use_module(lsp(lsp_changes), [doc_text/2]).   23:- use_module(lsp(lsp_utils), [seek_to_line/2,
   24                               linechar_offset/3]).   25
   26token_types([namespace,
   27             type,
   28             class,
   29             enum,
   30             interface,
   31             struct,
   32             typeParameter,
   33             parameter,
   34             variable,
   35             property,
   36             enumMember,
   37             event,
   38             function,
   39             member,
   40             macro,
   41             keyword,
   42             modifier,
   43             comment,
   44             string,
   45             number,
   46             regexp,
   47             operator
   48            ]).
   49token_modifiers([declaration,
   50                 definition,
   51                 readonly,
   52                 static,
   53                 deprecated,
   54                 abstract,
   55                 async,
   56                 modification,
   57                 documentation,
   58                 defaultLibrary
   59                ]).
   60
   61token_types_dict(Dict) :-
   62    token_types(Types),
   63    length(Types, Len),
   64    Len0 is Len - 1,
   65    numlist(0, Len0, Ns),
   66    maplist([Type, Idx, Type-Idx]>>true, Types, Ns,
   67            Pairs),
   68    dict_create(Dict, _, Pairs).

 file_colours(+File, -Colours) is det

True when Colours is a list of colour information corresponding to the file File.

   74file_colours(File, Tuples) :-
   75    setup_call_cleanup(
   76        message_queue_create(Queue),
   77        ( thread_create(file_colours_helper(Queue, File), ThreadId),
   78          await_messages(Queue, Colours0, Colours0) ),
   79        ( thread_join(ThreadId),
   80          message_queue_destroy(Queue) )
   81    ),
   82    sort(2, @=<, Colours0, Colours),
   83    flatten_colour_terms(File, Colours, Tuples).

 file_range_colours(+File, +Start, +End, -Colours) is det

True when Colours is a list of colour information corresponding to file File covering the terms between Start and End. Note that it may go beyond either bound.

   90file_range_colours(File, Start, End, Tuples) :-
   91    setup_call_cleanup(
   92        message_queue_create(Queue),
   93        ( thread_create(file_term_colours_helper(Queue, File, Start, End),
   94                        ThreadId),
   95          await_messages(Queue, Colours0, Colours0) ),
   96        ( thread_join(ThreadId),
   97          message_queue_destroy(Queue) )
   98    ),
   99    sort(2, @=<, Colours0, Colours),
  100    flatten_colour_terms(File, Colours, Tuples).
  101
  102file_stream(File, S) :-
  103    doc_text(File, Changes)
  104    -> open_string(Changes, S)
  105    ;  open(File, read, S).

 flatten_colour_terms(+File, +ColourTerms, -Nums) is det

Convert the list of ColourTerms like =colour(Category, Start, Length)= to a flat list of numbers in the format that LSP expects.

See also

- https://microsoft.github.io/language-server-protocol/specifications/specification-3-16/#textDocument_semanticTokens

  113flatten_colour_terms(File, ColourTerms, Nums) :-
  114    token_types_dict(TokenDict),
  115    setup_call_cleanup(
  116        file_stream(File, S),
  117        ( set_stream_position(S, '$stream_position'(0,0,0,0)),
  118          colour_terms_to_tuples(ColourTerms, Nums-Nums,
  119                                 S, TokenDict,
  120                                 0, 0, 0) ),
  121        close(S)
  122    ).
  123
  124colour_terms_to_tuples([], _-[],
  125                       _Stream, _Dict,
  126                       _Offset, _Line, _Char).
  127colour_terms_to_tuples([Colour|Colours], Tuples-T0,
  128                       Stream, Dict,
  129                       LastOffset, LastLine, LastChar) :-
  130    colour_term_to_tuple(Stream, Dict,
  131                         LastOffset, LastLine, LastChar,
  132                         ThisOffset, ThisLine, ThisChar,
  133                         Colour,
  134                         T0-T1), !,
  135    colour_terms_to_tuples(Colours, Tuples-T1,
  136                           Stream, Dict,
  137                           ThisOffset, ThisLine, ThisChar).
  138colour_terms_to_tuples([colour(_Type, _, _)|Colours], Tuples,
  139                       Stream, Dict,
  140                       ThisOffset, ThisLine, ThisChar) :-
  141    % ( memberchk(Type, [clause, body, list, empty_list, brace_term, parentheses,
  142    %                    range, goal(_, _), head(_, _), dict, dict_content,
  143    %                    term, error])
  144    % -> true
  145    % ; debug(server, "Unhighlighted term ~w", [Type])
  146    % ),
  147    colour_terms_to_tuples(Colours, Tuples,
  148                           Stream, Dict,
  149                           ThisOffset, ThisLine, ThisChar).
  150
  151colour_term_to_tuple(Stream, Dict,
  152                     LastOffset, LastLine, LastChar,
  153                     Offset, Line, Char,
  154                     colour(Type, Offset, Len),
  155                     [DeltaLine, DeltaStart, Len, TypeCode, ModMask|T1]-T1) :-
  156    colour_type(Type, TypeCategory, Mods),
  157    get_dict(TypeCategory, Dict, TypeCode),
  158    mods_mask(Mods, ModMask), !,
  159    Seek is Offset - LastOffset,
  160    setup_call_cleanup(open_null_stream(NullStream),
  161                       copy_stream_data(Stream, NullStream, Seek),
  162                       close(NullStream)),
  163    stream_property(Stream, position(Pos)),
  164    stream_position_data(line_count, Pos, Line),
  165    stream_position_data(line_position, Pos, Char),
  166    ( Line == LastLine
  167    -> ( DeltaLine = 0,
  168         DeltaStart is Char - LastChar
  169       )
  170    ; ( DeltaLine is Line - LastLine,
  171        DeltaStart = Char
  172      )
  173    ).
  174
  175colour_type(directive,                namespace, []).
  176colour_type(head_term(_,              _),        function,  [declaration]).
  177colour_type(neck(directive),          operator,  [declaration]).
  178colour_type(neck(clause),             operator,  [definition]).
  179colour_type(neck(grammar_rule),       operator,  [definition]).
  180colour_type(goal_term(built_in,       A),        macro,     []) :- atom(A), !.
  181colour_type(goal_term(built_in,       _),        function,  [defaultLibrary]).
  182colour_type(goal_term(undefined,      _),        function,  []).
  183colour_type(goal_term(imported(_),    _),        function,  []).
  184colour_type(goal_term(local(_),       _),        function,  []).
  185colour_type(goal_term(extern(_,_),    _),        function,  []).
  186colour_type(goal_term(recursion,      _),        member,    []).
  187colour_type(goal_term(('dynamic'(_)), _),        parameter, []).
  188colour_type(atom,                     string,    []).
  189colour_type(var,                      variable,  []).
  190colour_type(singleton,                variable,  [readonly]).
  191colour_type(fullstop,                 operator,  []).
  192colour_type(control,                  operator,  []).
  193colour_type(dict_key,                 property,  []).
  194colour_type(dict_sep,                 operator,  []).
  195colour_type(string,                   string,    []).
  196colour_type(int,                      number,    []).
  197colour_type(comment(line),            comment,   []).
  198colour_type(comment(structured),      comment,   [documentation]).
  199colour_type(arity,                    parameter, []).
  200colour_type(functor,                  struct,    []).
  201colour_type(option_name,              struct,    []).
  202colour_type(predicate_indicator,      interface, []).
  203colour_type(predicate_indicator(_,    _),        interface, []).
  204colour_type(unused_import,            macro,     [deprecated]).
  205colour_type(undefined_import,         macro,     [deprecated]).
  206colour_type(dcg,                      regexp,    []).
  207colour_type(dcg(terminal),            regexp,    []).
  208colour_type(dcg(plain),               function,  []).
  209colour_type(dcg_right_hand_ctx,       regexp,    []).
  210colour_type(grammar_rule,             regexp,    []).
  211colour_type(identifier,               namespace, []).
  212colour_type(file(_),                  namespace, []).
  213colour_type(file_no_depend(_),        namespace, [abstract]).
  214colour_type(module(_),                namespace, []).
  215
  216mods_mask(Mods, Mask) :-
  217    mods_mask(Mods, 0, Mask).
  218
  219mods_mask([], Mask, Mask).
  220mods_mask([Mod|Mods], Mask0, Mask) :-
  221    token_modifiers(ModsList),
  222    nth0(N, ModsList, Mod),
  223    Mask1 is Mask0 \/ (1 << N),
  224    mods_mask(Mods, Mask1, Mask).
  225
  226%%% Helpers

 await_messages(+Queue, ?Head, -Tail) is det

Helper predicate to accumulate messages from file_colours_helper/2 in a list.

  232await_messages(Q, H, T) :-
  233    thread_get_message(Q, Term),
  234    ( Term == done
  235    -> T = []
  236    ; ( T = [Term|T0],
  237        await_messages(Q, H, T0)
  238      )
  239    ).

 file_colours_helper(+Queue, +File) is det

Use prolog_colourise_stream/3 to accumulate a list of colour terms. Does it in this weird way sending messages to a queue because the predicate takes a closure but we want to get a list of all of the terms.

  247file_colours_helper(Queue, File) :-
  248    setup_call_cleanup(
  249        file_stream(File, S),
  250        prolog_colourise_stream(
  251            S, File,
  252            {Queue}/[Cat, Start, Len]>>(
  253                thread_send_message(Queue, colour(Cat, Start, Len)))
  254        ),
  255        close(S)
  256    ),
  257    thread_send_message(Queue, done).
  258
  259nearest_term_start(Stream, StartL, TermStart) :-
  260    read_source_term_at_location(Stream, _, [line(StartL), error(Error)]),
  261    ( nonvar(Error)
  262    -> ( LineBack is StartL - 1,
  263         nearest_term_start(Stream, LineBack, TermStart) )
  264    ;  TermStart = StartL
  265    ).
  266
  267file_term_colours_helper(Queue, File,
  268                         line_char(StartL, _StartC),
  269                         End) :-
  270    setup_call_cleanup(
  271        file_stream(File, S),
  272        ( nearest_term_start(S, StartL, TermLine),
  273          seek(S, 0, bof, _),
  274          set_stream_position(S, '$stream_position'(0,0,0,0)),
  275          seek_to_line(S, TermLine),
  276          colourise_terms_to_position(Queue, File, S, 0-0, End)
  277        ),
  278        close(S)
  279    ),
  280    thread_send_message(Queue, done).
  281
  282colourise_terms_to_position(Queue, File, Stream, Prev, End) :-
  283    prolog_colourise_term(
  284        Stream, File,
  285        {Queue}/[Cat, Start, Len]>>(
  286            thread_send_message(Queue, colour(Cat, Start, Len))),
  287        []),
  288    stream_property(Stream, position(Pos)),
  289    stream_position_data(line_count, Pos, Line),
  290    stream_position_data(line_position, Pos, Char),
  291    End = line_char(EndL, EndC),
  292    ( Line-Char == Prev
  293    -> true
  294    ;  EndL =< Line
  295    -> true
  296    ;  ( EndL == Line, EndC =< Char )
  297    -> true
  298    ; colourise_terms_to_position(Queue, File, Stream, Line-Char, End)
  299    )