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

  185                      documentFormattingProvider: true,
  186                      documentRangeFormattingProvider: true,

  188                      renameProvider: true,
  189                      % documentLinkProvider: false,
  190                      % colorProvider: true,
  191                      foldingRangeProvider: false,
  192                      % [TODO]
  193                      % executeCommandProvider: _{commands: ["query", "assert"]},
  194                      semanticTokensProvider: _{legend: _{tokenTypes: TokenTypes,
  195                                                          tokenModifiers: TokenModifiers},
  196                                                range: true,
  197                                                % [TODO] implement deltas
  198                                                full: _{delta: false}},
  199                      workspace: _{workspaceFolders: _{supported: true,
  200                                                       changeNotifications: true}}}

  200)

  200 :-
  201    token_types(TokenTypes),
  202    token_modifiers(TokenModifiers)

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

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

Sort range dictionaries into ascending order of start line.

  404ordered_locations(Locations, OrderedLocations) :-
  405    maplist([D, SL-D]>>( get_dict(range, D, Range),
  406                         get_dict(start, Range, Start),
  407                         get_dict(line, Start, SL) ),
  408            Locations,
  409            Locs1),
  410    sort(1, @=<, Locs1, Locs2),
  411    maplist([_-D, D]>>true, Locs2, OrderedLocations)