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

LSP Colours

Module with predicates for colourizing Prolog code, via library(prolog_colour).

author
- James Cash */
   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:- use_module(lsp_changes, [doc_text/2]).   22:- use_module(lsp_utils, [seek_to_line/2,
   23                          linechar_offset/3]).   24
   25token_types([namespace,
   26             type,
   27             class,
   28             enum,
   29             interface,
   30             struct,
   31             typeParameter,
   32             parameter,
   33             variable,
   34             property,
   35             enumMember,
   36             event,
   37             function,
   38             member,
   39             macro,
   40             keyword,
   41             modifier,
   42             comment,
   43             string,
   44             number,
   45             regexp,
   46             operator
   47            ]).
   48token_modifiers([declaration,
   49                 definition,
   50                 readonly,
   51                 static,
   52                 deprecated,
   53                 abstract,
   54                 async,
   55                 modification,
   56                 documentation,
   57                 defaultLibrary
   58                ]).
   59
   60token_types_dict(Dict) :-
   61    token_types(Types),
   62    length(Types, Len),
   63    Len0 is Len - 1,
   64    numlist(0, Len0, Ns),
   65    maplist([Type, Idx, Type-Idx]>>true, Types, Ns,
   66            Pairs),
   67    dict_create(Dict, _, Pairs).
 file_colours(+File, -Colours) is det
True when Colours is a list of colour information corresponding to the file File.
   73file_colours(File, Tuples) :-
   74    setup_call_cleanup(
   75        message_queue_create(Queue),
   76        ( thread_create(file_colours_helper(Queue, File), ThreadId),
   77          await_messages(Queue, Colours0, Colours0) ),
   78        ( thread_join(ThreadId),
   79          message_queue_destroy(Queue) )
   80    ),
   81    sort(2, @=<, Colours0, Colours),
   82    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.
   89file_range_colours(File, Start, End, Tuples) :-
   90    setup_call_cleanup(
   91        message_queue_create(Queue),
   92        ( thread_create(file_term_colours_helper(Queue, File, Start, End),
   93                        ThreadId),
   94          await_messages(Queue, Colours0, Colours0) ),
   95        ( thread_join(ThreadId),
   96          message_queue_destroy(Queue) )
   97    ),
   98    sort(2, @=<, Colours0, Colours),
   99    flatten_colour_terms(File, Colours, Tuples).
  100
  101file_stream(File, S) :-
  102    doc_text(File, Changes)
  103    -> open_string(Changes, S)
  104    ;  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
  112flatten_colour_terms(File, ColourTerms, Nums) :-
  113    token_types_dict(TokenDict),
  114    setup_call_cleanup(
  115        file_stream(File, S),
  116        ( set_stream_position(S, '$stream_position'(0,0,0,0)),
  117          colour_terms_to_tuples(ColourTerms, Nums-Nums,
  118                                 S, TokenDict,
  119                                 0, 0, 0) ),
  120        close(S)
  121    ).
  122
  123colour_terms_to_tuples([], _-[],
  124                       _Stream, _Dict,
  125                       _Offset, _Line, _Char).
  126colour_terms_to_tuples([Colour|Colours], Tuples-T0,
  127                       Stream, Dict,
  128                       LastOffset, LastLine, LastChar) :-
  129    colour_term_to_tuple(Stream, Dict,
  130                         LastOffset, LastLine, LastChar,
  131                         ThisOffset, ThisLine, ThisChar,
  132                         Colour,
  133                         T0-T1), !,
  134    colour_terms_to_tuples(Colours, Tuples-T1,
  135                           Stream, Dict,
  136                           ThisOffset, ThisLine, ThisChar).
  137colour_terms_to_tuples([colour(_Type, _, _)|Colours], Tuples,
  138                       Stream, Dict,
  139                       ThisOffset, ThisLine, ThisChar) :-
  140    % ( memberchk(Type, [clause, body, list, empty_list, brace_term, parentheses,
  141    %                    range, goal(_, _), head(_, _), dict, dict_content,
  142    %                    term, error])
  143    % -> true
  144    % ; debug(server, "Unhighlighted term ~w", [Type])
  145    % ),
  146    colour_terms_to_tuples(Colours, Tuples,
  147                           Stream, Dict,
  148                           ThisOffset, ThisLine, ThisChar).
  149
  150colour_term_to_tuple(Stream, Dict,
  151                     LastOffset, LastLine, LastChar,
  152                     Offset, Line, Char,
  153                     colour(Type, Offset, Len),
  154                     [DeltaLine, DeltaStart, Len, TypeCode, ModMask|T1]-T1) :-
  155    colour_type(Type, TypeCategory, Mods),
  156    get_dict(TypeCategory, Dict, TypeCode),
  157    mods_mask(Mods, ModMask), !,
  158    Seek is Offset - LastOffset,
  159    setup_call_cleanup(open_null_stream(NullStream),
  160                       copy_stream_data(Stream, NullStream, Seek),
  161                       close(NullStream)),
  162    stream_property(Stream, position(Pos)),
  163    stream_position_data(line_count, Pos, Line),
  164    stream_position_data(line_position, Pos, Char),
  165    ( Line == LastLine
  166    -> ( DeltaLine = 0,
  167         DeltaStart is Char - LastChar
  168       )
  169    ; ( DeltaLine is Line - LastLine,
  170        DeltaStart = Char
  171      )
  172    ).
  173
  174colour_type(directive,                namespace, []).
  175colour_type(head_term(_,              _),        function,  [declaration]).
  176colour_type(neck(directive),          operator,  [declaration]).
  177colour_type(neck(clause),             operator,  [definition]).
  178colour_type(neck(grammar_rule),       operator,  [definition]).
  179colour_type(goal_term(built_in,       A),        macro,     []) :- atom(A), !.
  180colour_type(goal_term(built_in,       _),        function,  [defaultLibrary]).
  181colour_type(goal_term(undefined,      _),        function,  []).
  182colour_type(goal_term(imported(_),    _),        function,  []).
  183colour_type(goal_term(local(_),       _),        function,  []).
  184colour_type(goal_term(extern(_,_),    _),        function,  []).
  185colour_type(goal_term(recursion,      _),        member,    []).
  186colour_type(goal_term(('dynamic'(_)), _),        parameter, []).
  187colour_type(atom,                     string,    []).
  188colour_type(var,                      variable,  []).
  189colour_type(singleton,                variable,  [readonly]).
  190colour_type(fullstop,                 operator,  []).
  191colour_type(control,                  operator,  []).
  192colour_type(dict_key,                 property,  []).
  193colour_type(dict_sep,                 operator,  []).
  194colour_type(string,                   string,    []).
  195colour_type(int,                      number,    []).
  196colour_type(comment(line),            comment,   []).
  197colour_type(comment(structured),      comment,   [documentation]).
  198colour_type(arity,                    parameter, []).
  199colour_type(functor,                  struct,    []).
  200colour_type(option_name,              struct,    []).
  201colour_type(predicate_indicator,      interface, []).
  202colour_type(predicate_indicator(_,    _),        interface, []).
  203colour_type(unused_import,            macro,     [deprecated]).
  204colour_type(undefined_import,         macro,     [deprecated]).
  205colour_type(dcg,                      regexp,    []).
  206colour_type(dcg(terminal),            regexp,    []).
  207colour_type(dcg(plain),               function,  []).
  208colour_type(dcg_right_hand_ctx,       regexp,    []).
  209colour_type(grammar_rule,             regexp,    []).
  210colour_type(identifier,               namespace, []).
  211colour_type(file(_),                  namespace, []).
  212colour_type(file_no_depend(_),        namespace, [abstract]).
  213colour_type(module(_),                namespace, []).
  214
  215mods_mask(Mods, Mask) :-
  216    mods_mask(Mods, 0, Mask).
  217
  218mods_mask([], Mask, Mask).
  219mods_mask([Mod|Mods], Mask0, Mask) :-
  220    token_modifiers(ModsList),
  221    nth0(N, ModsList, Mod),
  222    Mask1 is Mask0 \/ (1 << N),
  223    mods_mask(Mods, Mask1, Mask).
  224
  225%%% Helpers
 await_messages(+Queue, ?Head, -Tail) is det
Helper predicate to accumulate messages from file_colours_helper/2 in a list.
  231await_messages(Q, H, T) :-
  232    thread_get_message(Q, Term),
  233    ( Term == done
  234    -> T = []
  235    ; ( T = [Term|T0],
  236        await_messages(Q, H, T0)
  237      )
  238    ).
 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.
  246file_colours_helper(Queue, File) :-
  247    setup_call_cleanup(
  248        file_stream(File, S),
  249        prolog_colourise_stream(
  250            S, File,
  251            {Queue}/[Cat, Start, Len]>>(
  252                thread_send_message(Queue, colour(Cat, Start, Len)))
  253        ),
  254        close(S)
  255    ),
  256    thread_send_message(Queue, done).
  257
  258nearest_term_start(Stream, StartL, TermStart) :-
  259    read_source_term_at_location(Stream, _, [line(StartL), error(Error)]),
  260    ( nonvar(Error)
  261    -> ( LineBack is StartL - 1,
  262         nearest_term_start(Stream, LineBack, TermStart) )
  263    ;  TermStart = StartL
  264    ).
  265
  266file_term_colours_helper(Queue, File,
  267                         line_char(StartL, _StartC),
  268                         End) :-
  269    setup_call_cleanup(
  270        file_stream(File, S),
  271        ( nearest_term_start(S, StartL, TermLine),
  272          seek(S, 0, bof, _),
  273          set_stream_position(S, '$stream_position'(0,0,0,0)),
  274          seek_to_line(S, TermLine),
  275          colourise_terms_to_position(Queue, File, S, 0-0, End)
  276        ),
  277        close(S)
  278    ),
  279    thread_send_message(Queue, done).
  280
  281colourise_terms_to_position(Queue, File, Stream, Prev, End) :-
  282    prolog_colourise_term(
  283        Stream, File,
  284        {Queue}/[Cat, Start, Len]>>(
  285            thread_send_message(Queue, colour(Cat, Start, Len))),
  286        []),
  287    stream_property(Stream, position(Pos)),
  288    stream_position_data(line_count, Pos, Line),
  289    stream_position_data(line_position, Pos, Char),
  290    End = line_char(EndL, EndC),
  291    ( Line-Char == Prev
  292    -> true
  293    ;  EndL =< Line
  294    -> true
  295    ;  ( EndL == Line, EndC =< Char )
  296    -> true
  297    ; colourise_terms_to_position(Queue, File, Stream, Line-Char, End)
  298    )