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(json), [atom_json_dict/3]).   13:- use_module(library(pure_input), [phrase_from_stream/2]).   14:- use_module(library(prolog_xref)).   15:- use_module(library(prolog_source), [directory_source_files/3]).   16:- use_module(library(utf8), [utf8_codes//1]).   17:- use_module(library(socket), [tcp_socket/1,
   18                                tcp_bind/2,
   19                                tcp_accept/3,
   20                                tcp_listen/2,
   21                                tcp_open_socket/2]).   22:- use_module(library(yall)).   23:- use_module(library(prolog_stack)).   24
   25:- include('_lsp_path_add.pl').   26
   27:- use_module(lsp(lsp_utils)).   28:- use_module(lsp(lsp_checking), [check_errors/2]).   29:- use_module(lsp(lsp_parser), [lsp_request//1]).   30:- use_module(lsp(lsp_changes), [handle_doc_changes/2]).   31:- use_module(lsp(lsp_completion), [completions_at/3]).   32:- use_module(lsp(lsp_colours), [file_colours/2,
   33                                 file_range_colours/4,
   34                                 token_types/1,
   35                                 token_modifiers/1]).   36:- use_module(lsp(lsp_refactor), [rename_at_location/4]).   37:- use_module(lsp(lsp_formatter), [file_format_edits/2]).   38:- use_module(lsp(lsp_highlights), [highlights_at_position/3]).   39:- use_module(lsp(lsp_source), [loaded_source/1]).   40
   41main :-
   42    set_prolog_flag(debug_on_error, false),
   43    set_prolog_flag(report_error, true),
   44    set_prolog_flag(verbose, silent),
   45    set_prolog_flag(toplevel_prompt, ''),
   46    current_prolog_flag(argv, Args),
   47    debug(server),
   48    start(Args).
   49
   50start([stdio]) :- !,
   51    debug(server, "Starting stdio client", []),
   52    stdio_server.
   53start([port, Port]) :- !,
   54    debug(server, "Starting socket client on port ~w", [Port]),
   55    atom_number(Port, PortN),
   56    socket_server(PortN).
   57start(Args) :-
   58    debug(server, "Unknown args ~w", [Args]).
   59
   60:- dynamic shutdown_request_received/0.   61:- dynamic exit_request_received/0.   62
   63% stdio server
   64
   65stdio_server :-
   66    current_input(In),
   67    current_output(Out),
   68    stream_pair(StreamPair, In, Out),
   69    handle_requests_stream(StreamPair).
   70
   71% socket server
   72socket_server(Port) :-
   73    tcp_socket(Socket),
   74    tcp_bind(Socket, Port),
   75    tcp_listen(Socket, 5),
   76    tcp_open_socket(Socket, StreamPair),
   77    stream_pair(StreamPair, AcceptFd, _),
   78    dispatch_socket_client(AcceptFd).
   79
   80dispatch_socket_client(AcceptFd) :-
   81    tcp_accept(AcceptFd, Socket, Peer),
   82    % not doing this in a thread and not looping
   83    % since it doesn't really make sense to have multiple clients connected
   84    process_client(Socket, Peer).
   85
   86process_client(Socket, Peer) :-
   87    setup_call_cleanup(
   88        tcp_open_socket(Socket, StreamPair),
   89        ( debug(server, "Connecting new client ~w", [Peer]),
   90          handle_requests_stream(StreamPair) ),
   91        close(StreamPair)).
   92
   93% common stream handler
   94
   95handle_requests_stream(StreamPair) :-
   96    stream_pair(StreamPair, In, Out),
   97    set_stream(In, buffer(full)),
   98    set_stream(In, newline(posix)),
   99    set_stream(In, tty(false)),
  100    set_stream(In, representation_errors(error)),
  101    % handling UTF decoding in JSON parsing, but doing the auto-translation
  102    % causes Content-Length to be incorrect
  103    set_stream(In, encoding(octet)),
  104    set_stream(Out, encoding(utf8)),
  105    client_handler(In, Out).
  106
  107:- multifile prolog:message//1.  108
  109% Prevent default error message from being displayed when throwing to break loop
  110prolog:message(break_client_handler_loop) --> [ ].
  111
  112% [TODO] add multithreading? Guess that will also need a message queue
  113% to write to stdout
  114client_handler(In, Out) :-
  115    catch(handle_requests(In, Out),
  116          break_client_handler_loop,
  117          debug(server(high), "ending client handler loop", [])).
  118
  119handle_requests(In, Out) :-
  120    % Parse an unlimited number of requests from the input stream, responding
  121    % to each one as it is received.
  122    phrase_from_stream(unlimited(request_and_response(Out)), In).
  123
  124request_and_response(Out) -->
  125    % Parse an LSP request from the input stream
  126    (  lsp_request(Req)
  127    -> % As a side effect, respond to the request
  128       { ignore(handle_request(Req, Out)) }
  129    ;  % Failure of `lsp_request//1` indicates an unparsable RPC request
  130       { debug(server(high), "unparsable RPC request", []),
  131         send_message(Out, _{id: null,
  132                             error: _{code: -32700, % JSON RPC ParseError
  133                                      message: "unparsable request"}}),
  134         % Since `Content-Length` may not have parsed correctly, we don't know
  135         % how much input to skip. Probably safest to shutdown (stdio server)
  136         % or at least ask socket clients to reconnect.
  137         throw(break_client_handler_loop) } ).
  138
  139% general handling stuff
  140
  141send_message(Stream, Msg) :-
  142    put_dict(jsonrpc, Msg, "2.0", VersionedMsg),
  143    atom_json_dict(JsonCodes, VersionedMsg, [as(codes), width(0)]),
  144    phrase(utf8_codes(JsonCodes), UTF8Codes),
  145    length(UTF8Codes, ContentLength),
  146    format(Stream, "Content-Length: ~w\r\n\r\n~s", [ContentLength, JsonCodes]),
  147    flush_output(Stream).
  148
  149handle_request(Req, OutStream) :-
  150    debug(server(high), "Request ~w", [Req.body]),
  151    catch_with_backtrace(
  152        ( ( shutdown_request_received
  153          -> ( Req.body.method == "exit"
  154             -> handle_msg(Req.body.method, Req.body, _Resp)
  155             ; send_message(OutStream, _{id: Req.body.id, error: _{code: -32600, message: "Invalid Request"}}) )
  156          ; ( handle_msg(Req.body.method, Req.body, Resp)
  157            -> true
  158            ; throw(error(domain_error(handleable_message, Req),
  159                          context(_Loc, "handle_msg/3 returned false"))) ),
  160            ( is_dict(Resp) -> send_message(OutStream, Resp) ; true ) ) ),
  161        Err,
  162        ( print_message(error, Err),
  163          get_dict(id, Req.body, Id),
  164          send_message(OutStream, _{id: Id,
  165                                    error: _{code: -32001,
  166                                             message: "server error"}})
  167        )).
  168
  169% Handling messages
  170
  171:- dynamic client_encoding/1.  172
  173:- dynamic client_hover_format/1.  174
  175server_capabilities(_{textDocumentSync: _{openClose: true,
  176                                          change: 2, %incremental
  177                                          save: _{includeText: false},
  178                                          willSave: false,
  179                                          willSaveWaitUntil: false},
  180                      hoverProvider: true,
  181                      completionProvider: _{},
  182                      definitionProvider: true,
  183                      declarationProvider: true,
  184                      implementationProvider: true,
  185                      referencesProvider: true,
  186                      documentHighlightProvider: true,
  187                      documentSymbolProvider: true,
  188                      workspaceSymbolProvider: true,
  189                      codeActionProvider: false,
  190                      positionEncoding: Encoding,

  192                      documentFormattingProvider: true,
  193                      documentRangeFormattingProvider: true,

  195                      renameProvider: true,
  196                      % documentLinkProvider: false,
  197                      % colorProvider: true,
  198                      foldingRangeProvider: false,
  199                      % [TODO]
  200                      % executeCommandProvider: _{commands: ["query", "assert"]},
  201                      semanticTokensProvider: _{legend: _{tokenTypes: TokenTypes,
  202                                                          tokenModifiers: TokenModifiers},
  203                                                range: true,
  204                                                % [TODO] implement deltas
  205                                                full: _{delta: false}},
  206                      workspace: _{workspaceFolders: _{supported: true,
  207                                                       changeNotifications: true}}}

  207)

  207 :-
  208    token_types(TokenTypes),
  209    token_modifiers(TokenModifiers),
  210    client_encoding(Encoding)

  210.
  211
  212% messages (with a response)
  213handle_msg("initialize", Msg,
  214           _{id: Id, result: _{capabilities: ServerCapabilities}}) :-
  215    _{id: Id, params: Params} :< Msg, !,
  216    % Get project root
  217    ( Params.rootUri \== null
  218    -> ( url_path(Params.rootUri, RootPath),
  219         directory_source_files(RootPath, Files, [recursive(true), if(true)]),
  220         maplist([F]>>assert(loaded_source(F)), Files) )
  221    ; true ),
  222    % Get encoding capabilities
  223    % not actually using right now...
  224    ( ( get_dict(capabilities, Params, Capabilities),
  225        get_dict(general, Capabilities, GeneralSettings),
  226        get_dict(positionEncodings, GeneralSettings, ClientPositions),
  227        memberchk("utf-32", ClientPositions) )
  228    -> Encoding = 'utf-32'
  229    ;  Encoding = 'utf-16' ),
  230    retractall(client_encoding(_)),
  231    assertz(client_encoding(Encoding)),
  232    % Get hover format capabilities
  233    ( ( get_dict(textDocument, Capabilities, TextSettings),
  234        get_dict(hover, TextSettings, HoverSettings),
  235        get_dict(contentFormat, HoverSettings, HoverFormats),
  236        memberchk("markdown", HoverFormats) )
  237    -> HoverFormat = markdown
  238    ;  HoverFormat = plaintext ),
  239    retractall(client_hover_format(_)),
  240    assertz(client_hover_format(HoverFormat)),
  241    server_capabilities(ServerCapabilities).
  242handle_msg("shutdown", Msg, _{id: Id, result: []}) :-
  243    _{id: Id} :< Msg,
  244    debug(server, "received shutdown message", []),
  245    asserta(shutdown_request_received).
  246handle_msg("exit", _Msg, false) :-
  247    debug(server, "received exit, shutting down", []),
  248    asserta(exit_request_received),
  249    ( shutdown_request_received
  250    -> debug(server, "Post-shutdown exit, okay", []),
  251       throw(break_client_handler_loop)
  252    ;  debug(server, "No shutdown, unexpected exit", []),
  253       halt(1) ).
  254handle_msg("textDocument/hover", Msg, _{id: Id, result: Response}) :-
  255    _{params: _{position: _{character: Char0, line: Line0},
  256                textDocument: _{uri: Doc}}, id: Id} :< Msg,
  257    url_path(Doc, Path),
  258    Line1 is Line0 + 1,
  259    client_hover_format(Format),
  260    (  help_at_position(Format, Path, Line1, Char0, Help)
  261    -> Response = _{contents: _{kind: Format, value: Help}}
  262    ;  Response = null  ).
  263handle_msg("textDocument/documentSymbol", Msg, _{id: Id, result: Symbols}) :-
  264    _{id: Id, params: _{textDocument: _{uri: Doc}}} :< Msg,
  265    url_path(Doc, Path), !,
  266    xref_source(Path),
  267    findall(
  268        Symbol,
  269        ( xref_defined(Path, Goal, local(Line)),
  270          succ(Line, NextLine),
  271          succ(Line0, Line),
  272          functor(Goal, Name, Arity),
  273          format(string(GoalName), "~w/~w", [Name, Arity]),
  274          Symbol = _{name: GoalName,
  275                     kind: 12, % function
  276                     location:
  277                     _{uri: Doc,
  278                       range: _{start: _{line: Line0, character: 1},
  279                                end: _{line: NextLine, character: 0}}}}
  280        ),
  281        Symbols).
  282handle_msg("textDocument/definition", Msg, _{id: Id, result: Location}) :-
  283    _{id: Id, params: Params} :< Msg,
  284    _{textDocument: _{uri: Doc},
  285      position: _{line: Line0, character: Char0}} :< Params,
  286    url_path(Doc, Path),
  287    succ(Line0, Line1),
  288    clause_in_file_at_position(Name/Arity, Path, line_char(Line1, Char0)),
  289    defined_at(Path, Name/Arity, Location).
  290handle_msg("textDocument/definition", Msg, _{id: Msg.id, result: null}) :- !.
  291handle_msg("textDocument/references", 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    clause_in_file_at_position(Clause, Path, line_char(Line1, Char0)),
  298    findall(
  299        Location,
  300        ( loaded_source(Doc),
  301          url_path(DocUri, Doc),
  302          called_at(Doc, Clause, Locs0),
  303          % handle the case where Caller = imported(Path)?
  304          maplist({DocUri}/[D0, D]>>put_dict(uri, D0, DocUri, D), Locs0, Locs1),
  305          member(Location, Locs1)
  306        ),
  307        Locations0), !,
  308    ordered_locations(Locations0, Locations).
  309handle_msg("textDocument/references", Msg, _{id: Msg.id, result: null}) :- !.
  310handle_msg("textDocument/completion", Msg, _{id: Id, result: Completions}) :-
  311    _{id: Id, params: Params} :< Msg,
  312    _{textDocument: _{uri: Uri},
  313      position: _{line: Line0, character: Char0}} :< Params,
  314    url_path(Uri, Path),
  315    succ(Line0, Line1),
  316    completions_at(Path, line_char(Line1, Char0), Completions).
  317handle_msg("textDocument/formatting", Msg, _{id: Id, result: Edits}) :-
  318    _{id: Id, params: Params} :< Msg,
  319    _{textDocument: _{uri: Uri}} :< Params,
  320    url_path(Uri, Path),
  321    file_format_edits(Path, Edits).
  322handle_msg("textDocument/rangeFormatting", Msg, _{id: Id, result: Edits}) :-
  323    _{id: Id, params: Params} :< Msg,
  324    _{textDocument: _{uri: Uri}, range: Range} :< Params,
  325    url_path(Uri, Path),
  326    file_format_edits(Path, Edits0),
  327    include(edit_in_range(Range), Edits0, Edits).
  328handle_msg("textDocument/documentHighlight", Msg, _{id: Id, result: Locations}) :-
  329    _{id: Id, params: Params} :< Msg,
  330    _{textDocument: _{uri: Uri},
  331      position: _{line: Line0, character: Char0}} :< Params,
  332    url_path(Uri, Path),
  333    succ(Line0, Line1),
  334    highlights_at_position(Path, line_char(Line1, Char0), Locations), !.
  335handle_msg("textDocument/documentHighlight", Msg, _{id: Id, result: null}) :-
  336    _{id: Id} :< Msg.
  337handle_msg("textDocument/rename", Msg, _{id: Id, result: Result}) :-
  338    _{id: Id, params: Params} :< Msg,
  339    _{textDocument: _{uri: Uri},
  340      position: _{line: Line0, character: Char0},
  341      newName: NewName} :< Params,
  342    succ(Line0, Line1),
  343    rename_at_location(Uri, line_char(Line1, Char0), NewName, Changes),
  344    Result = _{changes: Changes}.
  345handle_msg("textDocument/rename", Msg, _{id: Id, error: _{message: "Nothing that can be renamed here.",
  346                                                          code: -32602}}) :-
  347    _{id: Id} :< Msg.
  348handle_msg("textDocument/semanticTokens", Msg, Response) :-
  349    handle_msg("textDocument/semanticTokens/full", Msg, Response).
  350handle_msg("textDocument/semanticTokens/full", Msg,
  351           _{id: Id, result: _{data: Highlights}}) :-
  352    _{id: Id, params: Params} :< Msg,
  353    _{textDocument: _{uri: Uri}} :< Params,
  354    url_path(Uri, Path), !,
  355    xref_source(Path),
  356    file_colours(Path, Highlights).
  357handle_msg("textDocument/semanticTokens/range", Msg,
  358           _{id: Id, result: _{data: Highlights}}) :-
  359    _{id: Id, params: Params} :< Msg,
  360    _{textDocument: _{uri: Uri}, range: Range} :< Params,
  361    _{start: _{line: StartLine0, character: StartChar},
  362      end: _{line: EndLine0, character: EndChar}} :< Range,
  363    url_path(Uri, Path), !,
  364    succ(StartLine0, StartLine), succ(EndLine0, EndLine),
  365    xref_source(Path),
  366    file_range_colours(Path,
  367                       line_char(StartLine, StartChar),
  368                       line_char(EndLine, EndChar),
  369                       Highlights).
  370% notifications (no response)
  371handle_msg("textDocument/didOpen", Msg, Resp) :-
  372    _{params: _{textDocument: TextDoc}} :< Msg,
  373    _{uri: FileUri} :< TextDoc,
  374    url_path(FileUri, Path),
  375    ( loaded_source(Path) ; assertz(loaded_source(Path)) ),
  376    check_errors_resp(FileUri, Resp).
  377handle_msg("textDocument/didChange", Msg, false) :-
  378    _{params: _{textDocument: TextDoc,
  379                contentChanges: Changes}} :< Msg,
  380    _{uri: Uri} :< TextDoc,
  381    url_path(Uri, Path),
  382    handle_doc_changes(Path, Changes).
  383handle_msg("textDocument/didSave", Msg, Resp) :-
  384    _{params: Params} :< Msg,
  385    check_errors_resp(Params.textDocument.uri, Resp).
  386handle_msg("textDocument/didClose", Msg, false) :-
  387    _{params: _{textDocument: TextDoc}} :< Msg,
  388    _{uri: FileUri} :< TextDoc,
  389    url_path(FileUri, Path),
  390    retractall(loaded_source(Path)).
  391handle_msg("initialized", Msg, false) :-
  392    debug(server, "initialized ~w", [Msg]).
  393handle_msg("$/cancelRequest", _Msg, false).
  394% wildcard
  395handle_msg(_, Msg, _{id: Id, error: _{code: -32603, message: "Unimplemented"}}) :-
  396    _{id: Id} :< Msg, !,
  397    debug(server, "unknown message ~w", [Msg]).
  398handle_msg(_, Msg, false) :-
  399    debug(server, "unknown notification ~w", [Msg]).
  400
  401check_errors_resp(FileUri, _{method: "textDocument/publishDiagnostics",
  402                             params: _{uri: FileUri, diagnostics: Errors}}) :-
  403    url_path(FileUri, Path),
  404    check_errors(Path, Errors).
  405check_errors_resp(_, false) :-
  406    debug(server, "Failed checking errors", []).
  407
  408edit_in_range(Range, Edit) :-
  409    _{start: _{line: RStartLine, character: RStartChar},
  410      end: _{line: REndLine, character: REndChar}} :< Range,
  411    _{start: _{line: EStartLine, character: EStartChar},
  412      end: _{line: EEndLine, character: EEndChar}} :< Edit.range,
  413    RStartLine =< EStartLine, REndLine >= EEndLine,
  414    ( RStartLine == EStartLine
  415    -> RStartChar =< EStartChar
  416    % do we care to restrict the *end* of the edit?
  417    ; ( REndLine == EEndLine
  418      -> REndChar >= EEndChar
  419      ; true ) ).

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

Sort range dictionaries into ascending order of start line.

  424ordered_locations(Locations, OrderedLocations) :-
  425    maplist([D, SL-D]>>( get_dict(range, D, Range),
  426                         get_dict(start, Range, Start),
  427                         get_dict(line, Start, SL) ),
  428            Locations,
  429            Locs1),
  430    sort(1, @=<, Locs1, Locs2),
  431    maplist([_-D, D]>>true, Locs2, OrderedLocations)