1:- module(lsp_server, [main/0]).

    9:- use_module(library(apply), [maplist/2]).   10:- use_module(library(apply_macros)).   11:- use_module(library(debug), [debug/3, debug/1]).   12:- use_module(library(http/json), [atom_json_dict/3]).   13:- use_module(library(prolog_xref)).   14:- use_module(library(prolog_source), [directory_source_files/3]).   15:- use_module(library(utf8), [utf8_codes//1]).   16:- use_module(library(socket), [tcp_socket/1,
   17                                tcp_bind/2,
   18                                tcp_accept/3,
   19                                tcp_listen/2,
   20                                tcp_open_socket/2]).   21:- use_module(library(yall)).   22:- use_module(library(prolog_stack)).   23
   24:- include('_lsp_path_add.pl').   25
   26:- use_module(lsp(lsp_utils)).   27:- use_module(lsp(lsp_checking), [check_errors/2]).   28:- use_module(lsp(lsp_parser), [lsp_request//1]).   29:- use_module(lsp(lsp_changes), [handle_doc_changes/2]).   30:- use_module(lsp(lsp_completion), [completions_at/3]).   31:- use_module(lsp(lsp_colours), [file_colours/2,
   32                                 file_range_colours/4,
   33                                 token_types/1,
   34                                 token_modifiers/1]).   35:- use_module(lsp(lsp_formatter), [file_format_edits/2]).   36:- use_module(lsp(lsp_highlights), [highlights_at_position/3]).   37
   38main :-
   39    set_prolog_flag(debug_on_error, false),
   40    set_prolog_flag(report_error, true),
   41    set_prolog_flag(verbose, silent),
   42    set_prolog_flag(toplevel_prompt, ''),
   43    current_prolog_flag(argv, Args),
   44    debug(server),
   45    start(Args).
   46
   47start([stdio]) :- !,
   48    debug(server, "Starting stdio client", []),
   49    stdio_server.
   50start([port, Port]) :- !,
   51    debug(server, "Starting socket client on port ~w", [Port]),
   52    atom_number(Port, PortN),
   53    socket_server(PortN).
   54start(Args) :-
   55    debug(server, "Unknown args ~w", [Args]).
   56
   57:- dynamic shutdown_request_received/0.   58:- dynamic exit_request_received/0.   59
   60% stdio server
   61
   62stdio_server :-
   63    current_input(In),
   64    current_output(Out),
   65    stream_pair(StreamPair, In, Out),
   66    handle_requests_stream(StreamPair).
   67
   68% socket server
   69socket_server(Port) :-
   70    tcp_socket(Socket),
   71    tcp_bind(Socket, Port),
   72    tcp_listen(Socket, 5),
   73    tcp_open_socket(Socket, StreamPair),
   74    stream_pair(StreamPair, AcceptFd, _),
   75    dispatch_socket_client(AcceptFd).
   76
   77dispatch_socket_client(AcceptFd) :-
   78    tcp_accept(AcceptFd, Socket, Peer),
   79    % not doing this in a thread and not looping
   80    % since it doesn't really make sense to have multiple clients connected
   81    process_client(Socket, Peer).
   82
   83process_client(Socket, Peer) :-
   84    setup_call_cleanup(
   85        tcp_open_socket(Socket, StreamPair),
   86        ( debug(server, "Connecting new client ~w", [Peer]),
   87          handle_requests_stream(StreamPair) ),
   88        close(StreamPair)).
   89
   90% common stream handler
   91
   92handle_requests_stream(StreamPair) :-
   93    stream_pair(StreamPair, In, Out),
   94    set_stream(In, buffer(full)),
   95    set_stream(In, newline(posix)),
   96    set_stream(In, tty(false)),
   97    set_stream(In, representation_errors(error)),
   98    % handling UTF decoding in JSON parsing, but doing the auto-translation
   99    % causes Content-Length to be incorrect
  100    set_stream(In, encoding(octet)),
  101    set_stream(Out, encoding(utf8)),
  102    client_handler(A-A, In, Out).
  103
  104client_handler(Extra-ExtraTail, In, Out) :-
  105    wait_for_input([In], Ready, 1.0),
  106    ( exit_request_received
  107    -> debug(server(high), "ending client handler loop", [])
  108    ; ( Ready =@= []
  109      -> client_handler(Extra-ExtraTail, In, Out)
  110      ; fill_buffer(In),
  111        read_pending_codes(In, ReadCodes, Tail),
  112        ( Tail == []
  113        -> true
  114        ; ExtraTail = ReadCodes,
  115          handle_requests(Out, Extra, Remainder),
  116          client_handler(Remainder-Tail, In, Out) ) ) ).
  117
  118% [TODO] add multithreading? Guess that will also need a message queue
  119% to write to stdout
  120handle_requests(Out, In, Tail) :-
  121    phrase(lsp_request(Req), In, Rest), !,
  122    ignore(handle_request(Req, Out)),
  123    ( var(Rest)
  124    -> Tail = Rest
  125    ; handle_requests(Out, Rest, Tail) ).
  126handle_requests(_, T, T).
  127
  128% general handling stuff
  129
  130send_message(Stream, Msg) :-
  131    put_dict(jsonrpc, Msg, "2.0", VersionedMsg),
  132    atom_json_dict(JsonCodes, VersionedMsg, [as(codes), width(0)]),
  133    phrase(utf8_codes(JsonCodes), UTF8Codes),
  134    length(UTF8Codes, ContentLength),
  135    format(Stream, "Content-Length: ~w\r\n\r\n~s", [ContentLength, JsonCodes]),
  136    flush_output(Stream).
  137
  138handle_request(Req, OutStream) :-
  139    debug(server(high), "Request ~w", [Req.body]),
  140    catch_with_backtrace(
  141        ( ( shutdown_request_received
  142          -> ( Req.body.method == "exit"
  143             -> handle_msg(Req.body.method, Req.body, _Resp)
  144             ; send_message(OutStream, _{id: Req.body.id, error: _{code: -32600, message: "Invalid Request"}}) )
  145          ; ( handle_msg(Req.body.method, Req.body, Resp)
  146            -> true
  147            ; throw(error(domain_error(handleable_message, Req),
  148                          context(_Loc, "handle_msg/3 returned false"))) ),
  149            ( is_dict(Resp) -> send_message(OutStream, Resp) ; true ) ) ),
  150        Err,
  151        ( print_message(error, Err),
  152          get_dict(id, Req.body, Id),
  153          send_message(OutStream, _{id: Id,
  154                                    error: _{code: -32001,
  155                                             message: "server error"}})
  156        )).
  157
  158% Handling messages
  159
  160server_capabilities(_{textDocumentSync: _{openClose: true,
  161                                          change: 2, %incremental
  162                                          save: _{includeText: false},
  163                                          willSave: false,
  164                                          willSaveWaitUntil: false},
  165                      hoverProvider: true,
  166                      completionProvider: _{},
  167                      definitionProvider: true,
  168                      declarationProvider: true,
  169                      implementationProvider: true,
  170                      referencesProvider: true,
  171                      documentHighlightProvider: true,
  172                      documentSymbolProvider: true,
  173                      workspaceSymbolProvider: true,
  174                      codeActionProvider: false,

  176                      documentFormattingProvider: true,
  177                      documentRangeFormattingProvider: true,

  179                      renameProvider: true,
  180                      % documentLinkProvider: false,
  181                      % colorProvider: true,
  182                      foldingRangeProvider: false,
  183                      % [TODO]
  184                      % executeCommandProvider: _{commands: ["query", "assert"]},
  185                      semanticTokensProvider: _{legend: _{tokenTypes: TokenTypes,
  186                                                          tokenModifiers: TokenModifiers},
  187                                                range: true,
  188                                                % [TODO] implement deltas
  189                                                full: _{delta: false}},
  190                      workspace: _{workspaceFolders: _{supported: true,
  191                                                       changeNotifications: true}}}

  191)

  191 :-
  192    token_types(TokenTypes),
  193    token_modifiers(TokenModifiers)

  193.
  194
  195:- dynamic loaded_source/1.  196
  197% messages (with a response)
  198handle_msg("initialize", Msg,
  199           _{id: Id, result: _{capabilities: ServerCapabilities}}) :-
  200    _{id: Id, params: Params} :< Msg, !,
  201    ( Params.rootUri \== null
  202    -> ( url_path(Params.rootUri, RootPath),
  203         directory_source_files(RootPath, Files, [recursive(true)]),
  204         maplist([F]>>assert(loaded_source(F)), Files) )
  205    ; true ),
  206    server_capabilities(ServerCapabilities).
  207handle_msg("shutdown", Msg, _{id: Id, result: []}) :-
  208    _{id: Id} :< Msg,
  209    debug(server, "received shutdown message", []),
  210    asserta(shutdown_request_received).
  211handle_msg("exit", _Msg, false) :-
  212    debug(server, "received exit, shutting down", []),
  213    asserta(exit_request_received),
  214    ( shutdown_request_received
  215    -> debug(server, "Post-shutdown exit, okay", [])
  216    ;  debug(server, "No shutdown, unexpected exit", []),
  217       halt(1) ).
  218handle_msg("textDocument/hover", Msg, _{id: Id, result: Response}) :-
  219    _{params: _{position: _{character: Char0, line: Line0},
  220                textDocument: _{uri: Doc}}, id: Id} :< Msg,
  221    url_path(Doc, Path),
  222    Line1 is Line0 + 1,
  223    (  help_at_position(Path, Line1, Char0, Help)
  224    -> Response = _{contents: _{kind: plaintext, value: Help}}
  225    ;  Response = null  ).
  226handle_msg("textDocument/documentSymbol", Msg, _{id: Id, result: Symbols}) :-
  227    _{id: Id, params: _{textDocument: _{uri: Doc}}} :< Msg,
  228    url_path(Doc, Path), !,
  229    xref_source(Path),
  230    findall(
  231        Symbol,
  232        ( xref_defined(Path, Goal, local(Line)),
  233          succ(Line, NextLine),
  234          succ(Line0, Line),
  235          functor(Goal, Name, Arity),
  236          format(string(GoalName), "~w/~w", [Name, Arity]),
  237          Symbol = _{name: GoalName,
  238                     kind: 12, % function
  239                     location:
  240                     _{uri: Doc,
  241                       range: _{start: _{line: Line0, character: 1},
  242                                end: _{line: NextLine, character: 0}}}}
  243        ),
  244        Symbols).
  245handle_msg("textDocument/definition", Msg, _{id: Id, result: Location}) :-
  246    _{id: Id, params: Params} :< Msg,
  247    _{textDocument: _{uri: Doc},
  248      position: _{line: Line0, character: Char0}} :< Params,
  249    url_path(Doc, Path),
  250    succ(Line0, Line1),
  251    clause_in_file_at_position(Name/Arity, Path, line_char(Line1, Char0)),
  252    defined_at(Path, Name/Arity, Location).
  253handle_msg("textDocument/definition", Msg, _{id: Msg.id, result: null}) :- !.
  254handle_msg("textDocument/references", Msg, _{id: Id, result: Locations}) :-
  255    _{id: Id, params: Params} :< Msg,
  256    _{textDocument: _{uri: Uri},
  257      position: _{line: Line0, character: Char0}} :< Params,
  258    url_path(Uri, Path),
  259    succ(Line0, Line1),
  260    clause_in_file_at_position(Clause, Path, line_char(Line1, Char0)),
  261    findall(
  262        Location,
  263        ( loaded_source(Doc),
  264          url_path(DocUri, Doc),
  265          called_at(Doc, Clause, Locs0),
  266          % handle the case where Caller = imported(Path)?
  267          maplist([D0, D]>>put_dict(uri, D0, DocUri, D), Locs0, Locs1),
  268          member(Location, Locs1)
  269        ),
  270        Locations0), !,
  271    ordered_locations(Locations0, Locations).
  272handle_msg("textDocument/references", Msg, _{id: Msg.id, result: null}) :- !.
  273handle_msg("textDocument/completion", Msg, _{id: Id, result: Completions}) :-
  274    _{id: Id, params: Params} :< Msg,
  275    _{textDocument: _{uri: Uri},
  276      position: _{line: Line0, character: Char0}} :< Params,
  277    url_path(Uri, Path),
  278    succ(Line0, Line1),
  279    completions_at(Path, line_char(Line1, Char0), Completions).
  280handle_msg("textDocument/formatting", Msg, _{id: Id, result: Edits}) :-
  281    _{id: Id, params: Params} :< Msg,
  282    _{textDocument: _{uri: Uri}} :< Params,
  283    url_path(Uri, Path),
  284    file_format_edits(Path, Edits).
  285handle_msg("textDocument/rangeFormatting", Msg, _{id: Id, result: Edits}) :-
  286    _{id: Id, params: Params} :< Msg,
  287    _{textDocument: _{uri: Uri}, range: Range} :< Params,
  288    url_path(Uri, Path),
  289    file_format_edits(Path, Edits0),
  290    include(edit_in_range(Range), Edits0, Edits).
  291handle_msg("textDocument/documentHighlight", Msg, _{id: Id, result: Locations}) :-
  292    _{id: Id, params: Params} :< Msg,
  293    _{textDocument: _{uri: Uri},
  294      position: _{line: Line0, character: Char0}} :< Params,
  295    url_path(Uri, Path),
  296    succ(Line0, Line1),
  297    highlights_at_position(Path, line_char(Line1, Char0), Locations), !.
  298handle_msg("textDocument/documentHighlight", Msg, _{id: Id, result: null}) :-
  299    _{id: Id} :< Msg.
  300handle_msg("textDocument/rename", Msg, _{id: Id, result: Result}) :-
  301    _{id: Id, params: Params} :< Msg,
  302    _{textDocument: _{uri: Uri},
  303      position: _{line: Line0, character: Char0},
  304      newName: NewName} :< Params,
  305    url_path(Uri, Path),
  306    succ(Line0, Line1),
  307    % highlights_at_position gives us the location & span of the variables
  308    % using the 4-arity version instead of 3 so we can specify it should only match a variable
  309    lsp_highlights:highlights_at_position(Path, line_char(Line1, Char0), '$var'(_),
  310                                          Positions),
  311    maplist([P0, P1]>>put_dict(newText, P0, NewName, P1), Positions, Edits),
  312    atom_string(AUri, Uri), % dict key must be an atom
  313    dict_create(Changes, _, [AUri=Edits]),
  314    Result = _{changes: Changes}.
  315handle_msg("textDocument/rename", Msg, _{id: Id, error: _{message: "Nothing that can be renamed here.",
  316                                                          code: -32602}}) :-
  317    _{id: Id} :< Msg.
  318handle_msg("textDocument/semanticTokens", Msg, Response) :-
  319    handle_msg("textDocument/semanticTokens/full", Msg, Response).
  320handle_msg("textDocument/semanticTokens/full", Msg,
  321           _{id: Id, result: _{data: Highlights}}) :-
  322    _{id: Id, params: Params} :< Msg,
  323    _{textDocument: _{uri: Uri}} :< Params,
  324    url_path(Uri, Path), !,
  325    xref_source(Path),
  326    file_colours(Path, Highlights).
  327handle_msg("textDocument/semanticTokens/range", Msg,
  328           _{id: Id, result: _{data: Highlights}}) :-
  329    _{id: Id, params: Params} :< Msg,
  330    _{textDocument: _{uri: Uri}, range: Range} :< Params,
  331    _{start: _{line: StartLine0, character: StartChar},
  332      end: _{line: EndLine0, character: EndChar}} :< Range,
  333    url_path(Uri, Path), !,
  334    succ(StartLine0, StartLine), succ(EndLine0, EndLine),
  335    xref_source(Path),
  336    file_range_colours(Path,
  337                       line_char(StartLine, StartChar),
  338                       line_char(EndLine, EndChar),
  339                       Highlights).
  340% notifications (no response)
  341handle_msg("textDocument/didOpen", Msg, Resp) :-
  342    _{params: _{textDocument: TextDoc}} :< Msg,
  343    _{uri: FileUri} :< TextDoc,
  344    url_path(FileUri, Path),
  345    ( loaded_source(Path) ; assertz(loaded_source(Path)) ),
  346    check_errors_resp(FileUri, Resp).
  347handle_msg("textDocument/didChange", Msg, false) :-
  348    _{params: _{textDocument: TextDoc,
  349                contentChanges: Changes}} :< Msg,
  350    _{uri: Uri} :< TextDoc,
  351    url_path(Uri, Path),
  352    handle_doc_changes(Path, Changes).
  353handle_msg("textDocument/didSave", Msg, Resp) :-
  354    _{params: Params} :< Msg,
  355    check_errors_resp(Params.textDocument.uri, Resp).
  356handle_msg("textDocument/didClose", Msg, false) :-
  357    _{params: _{textDocument: TextDoc}} :< Msg,
  358    _{uri: FileUri} :< TextDoc,
  359    url_path(FileUri, Path),
  360    retractall(loaded_source(Path)).
  361handle_msg("initialized", Msg, false) :-
  362    debug(server, "initialized ~w", [Msg]).
  363handle_msg("$/cancelRequest", _Msg, false).
  364% wildcard
  365handle_msg(_, Msg, _{id: Id, error: _{code: -32603, message: "Unimplemented"}}) :-
  366    _{id: Id} :< Msg, !,
  367    debug(server, "unknown message ~w", [Msg]).
  368handle_msg(_, Msg, false) :-
  369    debug(server, "unknown notification ~w", [Msg]).
  370
  371check_errors_resp(FileUri, _{method: "textDocument/publishDiagnostics",
  372                             params: _{uri: FileUri, diagnostics: Errors}}) :-
  373    url_path(FileUri, Path),
  374    check_errors(Path, Errors).
  375check_errors_resp(_, false) :-
  376    debug(server, "Failed checking errors", []).
  377
  378edit_in_range(Range, Edit) :-
  379    _{start: _{line: RStartLine, character: RStartChar},
  380      end: _{line: REndLine, character: REndChar}} :< Range,
  381    _{start: _{line: EStartLine, character: EStartChar},
  382      end: _{line: EEndLine, character: EEndChar}} :< Edit.range,
  383    RStartLine =< EStartLine, REndLine >= EEndLine,
  384    ( RStartLine == EStartLine
  385    -> RStartChar =< EStartChar
  386    % do we care to restrict the *end* of the edit?
  387    ; ( REndLine == EEndLine
  388      -> REndChar >= EEndChar
  389      ; true ) ).

 ordered_locations(+Locations:list(dict), +Locations:list(dict)) is det

Sort range dictionaries into ascending order of start line.

  394ordered_locations(Locations, OrderedLocations) :-
  395    maplist([D, SL-D]>>( get_dict(range, D, Range),
  396                         get_dict(start, Range, Start),
  397                         get_dict(line, Start, SL) ),
  398            Locations,
  399            Locs1),
  400    sort(1, @=<, Locs1, Locs2),
  401    maplist([_-D, D]>>true, Locs2, OrderedLocations)