------------------------------------------------------------------------------ -- Language Server Protocol -- -- -- -- Copyright (C) 2018-2021, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. This software is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- -- License for more details. You should have received a copy of the GNU -- -- General Public License distributed with this software; see file -- -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- -- of the license. -- ------------------------------------------------------------------------------ -- -- This package provides requests and notifications handler for Ada -- language. with Ada.Containers.Hashed_Maps; with Ada.Containers.Hashed_Sets; with VSS.String_Vectors; with GNATCOLL.VFS; use GNATCOLL.VFS; with GNATCOLL.Projects; with GNATCOLL.Traces; with LSP.Ada_Contexts; with LSP.Ada_Context_Sets; with LSP.Ada_Documents; with LSP.Ada_File_Sets; with LSP.File_Monitors; with LSP.Messages.Server_Requests; with LSP.Messages.Server_Responses; with LSP.Search; with LSP.Server_Backends; with LSP.Server_Request_Handlers; with LSP.Server_Notification_Receivers; with LSP.Servers; with LSP.Types; with LSP.Messages; package LSP.Ada_Handlers is type Message_Handler (Server : access LSP.Servers.Server; Trace : GNATCOLL.Traces.Trace_Handle) is limited new LSP.Server_Request_Handlers.Server_Request_Handler and LSP.Server_Notification_Receivers.Server_Notification_Receiver and LSP.Server_Backends.Server_Backend and LSP.Ada_Documents.Document_Provider with private; -- A handler of LSP notifications and requests from Ada language overriding procedure Handle_Error (Self : access Message_Handler); -- This procedure will be called when an unexpected error is raised in the -- request processing loop. procedure Cleanup (Self : access Message_Handler); -- Free memory referenced by Self subtype Context_Access is LSP.Ada_Context_Sets.Context_Access; function From_File (Self : Message_Handler'Class; File : Virtual_File) return LSP.Messages.DocumentUri; -- Turn Virtual_File to URI function To_File (Self : Message_Handler'Class; URI : LSP.Types.LSP_URI) return GNATCOLL.VFS.Virtual_File; -- Turn URI into Virtual_File private -- Options for refactoring/renaming type Renaming_Options is record In_Comments : Boolean := False; end record; -- Options for refactoring type Refactoring_Options is record Renaming : Renaming_Options; end record; -- Options for folding -- type Folding_Options is record Comments : Boolean := True; end record; -- Options holder -- type Options_Holder is record Refactoring : Refactoring_Options; -- Configuration options for refactoring Folding : Folding_Options; -- folding options end record; type Internal_Document_Access is access all LSP.Ada_Documents.Document; -- Container for documents indexed by URI package Document_Maps is new Ada.Containers.Hashed_Maps (Key_Type => GNATCOLL.VFS.Virtual_File, Element_Type => Internal_Document_Access, Hash => GNATCOLL.VFS.Full_Name_Hash, Equivalent_Keys => GNATCOLL.VFS."="); -- Container for the predefined source files package File_Sets is new Ada.Containers.Hashed_Sets (Element_Type => GNATCOLL.VFS.Virtual_File, Hash => GNATCOLL.VFS.Full_Name_Hash, Equivalent_Elements => GNATCOLL.VFS."=", "=" => GNATCOLL.VFS."="); type Get_Symbol_Access is access procedure (Self : LSP.Ada_Documents.Document; Context : LSP.Ada_Contexts.Context; Pattern : LSP.Search.Search_Pattern'Class; Canceled : access function return Boolean; Result : out LSP.Messages.Symbol_Vector); -- textDocument/documentSymbol handler Empty_Token : LSP.Types.LSP_Number_Or_String := (Is_Number => False, String => <>); type Load_Project_Status is (Valid_Project_Configured, Single_Project_Found, No_Project_Found, Multiple_Projects_Found, Invalid_Project_Configured); -- Variants for state of the project loaded into the handler: -- -- @value Valid_Project_Configured didChangeConfiguration provided a valid -- project -- -- @value Single_Project_Found no project in didChangeConfiguration, but -- just one project in Root dir -- -- @value No_Project_Found no project in didChangeConfiguration and no -- project in Root dir -- -- @value Multiple_Projects_Found no project in didChangeConfiguration and -- several projects in Root dir -- -- @value Invalid_Project_Configured didChangeConfiguration provided a -- valid project subtype Implicit_Project_Loaded is Load_Project_Status range No_Project_Found .. Invalid_Project_Configured; -- Project status when an implicit project loaded type Message_Handler (Server : access LSP.Servers.Server; Trace : GNATCOLL.Traces.Trace_Handle) is limited new LSP.Server_Request_Handlers.Server_Request_Handler and LSP.Server_Notification_Receivers.Server_Notification_Receiver and LSP.Server_Backends.Server_Backend and LSP.Ada_Documents.Document_Provider with record Contexts : LSP.Ada_Context_Sets.Context_Set; -- There is one context in this list per loaded project. -- There should always be at least one "project" context - if no .gpr -- is known to the server, this context should map to the implicit -- project. Client : LSP.Messages.InitializeParams; -- Client settings got during initialization request Root : Virtual_File; -- The directory passed under rootURI/rootPath during the initialize -- request. Diagnostics_Enabled : Boolean := True; -- Whether to publish diagnostics Token_Id : Integer := 0; -- An ever-increasing number used to generate unique progress tokens Indexing_Enabled : Boolean := True; -- Whether to index sources in the background. This should be True -- for normal use, and can be disabled for debug or testing purposes. Indexing_Token : LSP.Types.LSP_Number_Or_String := Empty_Token; -- The token of the current indexing progress sequence Files_To_Index : File_Sets.Set; -- Contains any files that need indexing. -- -- Indexing of sources is performed in the background as soon as needed -- (typically after a project load), and pre-indexes the Ada source -- files, so that subsequent request are fast. -- The way the "backgrounding" works is the following: -- -- * each request which should trigger indexing (for instance -- project load) adds files to Files_To_Index -- -- * the procedure Index_Files takes care of the indexing; it's also -- looking at the queue after each indexing to see if there -- are requests pending. If a request is pending, it stops -- indexing. -- -- * whenever the server has finished processing a notification -- or a requests, it looks at whether Files_To_Index contains -- files; if it does, it runs Index_Files Total_Files_Indexed : Natural := 0; Total_Files_To_Index : Positive := 1; -- These two fields are used to produce a progress bar for the indexing -- operations. Total_Files_To_Index starts at 1 so that the progress -- bar starts at 0%. Options : Options_Holder; Open_Documents : Document_Maps.Map; -- The documents that are currently open Get_Symbols : Get_Symbol_Access; -- textDocument/documentSymbol handler. Actual value depends on -- client's capabilities. Resource_Operations : LSP.Messages.Optional_ResourceOperationKindSet; -- Client capabilities to support resource operations in -- `WorkspaceEdit`s. Versioned_Documents : Boolean := False; -- Client capabilities to support versioned document changes in -- `WorkspaceEdit`s. Line_Folding_Only : Boolean := False; -- Client capabilities, folding only per lines Completion_Snippets_Enabled : Boolean := False; -- True if the client supports completion snippets Completion_Resolve_Properties : VSS.String_Vectors.Virtual_String_Vector; -- The list of CompletionItem properties that can be resolved -- lazily (i.e: when the item is selected on client-side) via -- the completionItem/resolve request. Range_Formatting_Enabled : Boolean := False; -- True if the handler has registered rangeFormatting provider Named_Notation_Threshold : Natural := 3; -- Defines the number of parameters/components at which point named -- notation is used for subprogram/aggregate completion snippets. Display_Method_Ancestry_Policy : LSP.Messages.AlsDisplayMethodAncestryOnNavigationPolicy := LSP.Messages.Usage_And_Abstract_Only; -- Defines the policy regarding the listing of -- overriding/overridden subprograms for navigation requests -- such as textDocument/definition, textDocument/declaration -- and textDocument/implementation. Follow_Symlinks : Boolean := True; -- False if the client disables symlink following. In this case -- URIs from client should match file names reported by LAL and -- GNATCOLL.Project. ---------------------- -- Project handling -- ---------------------- Project_Tree : GNATCOLL.Projects.Project_Tree_Access; -- The currently loaded project tree Project_Environment : GNATCOLL.Projects.Project_Environment_Access; -- The project environment for the currently loaded project Project_Predefined_Sources : LSP.Ada_File_Sets.Indexed_File_Set; -- A cache for the predefined sources in the loaded project (typically, -- runtime files). Project_Status : Load_Project_Status := No_Project_Found; -- Status of loading the project -- Scenario : LSP.Types.LSP_Any; -- Last used scenario variables -- Charset : Ada.Strings.Unbounded.Unbounded_String; -- Character set from didChangeConfiguration Project_Dirs_Loaded : File_Sets.Set; -- The directories to load in the "implicit project" File_Monitor : LSP.File_Monitors.File_Monitor_Access; -- Filesystem monitoring end record; overriding procedure Before_Work (Self : access Message_Handler; Message : LSP.Messages.Message'Class); overriding procedure After_Work (Self : access Message_Handler; Message : LSP.Messages.Message'Class); overriding function On_Initialize_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Initialize_Request) return LSP.Messages.Server_Responses.Initialize_Response; overriding function On_Shutdown_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Shutdown_Request) return LSP.Messages.Server_Responses.Shutdown_Response; overriding function On_CodeAction_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.CodeAction_Request) return LSP.Messages.Server_Responses.CodeAction_Response; overriding function On_Completion_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Completion_Request) return LSP.Messages.Server_Responses.Completion_Response; overriding function On_CompletionItemResolve_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.CompletionItemResolve_Request) return LSP.Messages.Server_Responses.CompletionItemResolve_Response; overriding function On_Definition_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Definition_Request) return LSP.Messages.Server_Responses.Location_Link_Response; overriding function On_Declaration_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Declaration_Request) return LSP.Messages.Server_Responses.Location_Link_Response; overriding function On_Implementation_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Implementation_Request) return LSP.Messages.Server_Responses.Location_Link_Response; overriding function On_Type_Definition_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Type_Definition_Request) return LSP.Messages.Server_Responses.Location_Link_Response; overriding function On_Highlight_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Highlight_Request) return LSP.Messages.Server_Responses.Highlight_Response; overriding function On_Hover_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Hover_Request) return LSP.Messages.Server_Responses.Hover_Response; overriding function On_References_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.References_Request) return LSP.Messages.Server_Responses.Location_Response; overriding function On_Signature_Help_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Signature_Help_Request) return LSP.Messages.Server_Responses.SignatureHelp_Response; overriding function On_Document_Links_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Document_Links_Request) return LSP.Messages.Server_Responses.Links_Response; overriding function On_Document_Symbols_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Document_Symbols_Request) return LSP.Messages.Server_Responses.Symbol_Response; overriding function On_Folding_Range_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Folding_Range_Request) return LSP.Messages.Server_Responses.FoldingRange_Response; overriding function On_Prepare_Call_Hierarchy_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Prepare_Call_Hierarchy_Request) return LSP.Messages.Server_Responses.PrepareCallHierarchy_Response; overriding function On_Incoming_Calls_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Incoming_Calls_Request) return LSP.Messages.Server_Responses.IncomingCalls_Response; overriding function On_Outgoing_Calls_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Outgoing_Calls_Request) return LSP.Messages.Server_Responses.OutgoingCalls_Response; overriding function On_Selection_Range_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Selection_Range_Request) return LSP.Messages.Server_Responses.SelectionRange_Response; overriding function On_Rename_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Rename_Request) return LSP.Messages.Server_Responses.Rename_Response; overriding function On_Prepare_Rename_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Prepare_Rename_Request) return LSP.Messages.Server_Responses.Prepare_Rename_Response; overriding function On_Execute_Command_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Execute_Command_Request) return LSP.Messages.Server_Responses.ExecuteCommand_Response; overriding function On_Workspace_Symbols_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Workspace_Symbols_Request) return LSP.Messages.Server_Responses.Symbol_Response; overriding function On_Workspace_Execute_Command_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Workspace_Execute_Command_Request) return LSP.Messages.Server_Responses.ExecuteCommand_Response; overriding function On_Color_Presentation_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Color_Presentation_Request) return LSP.Messages.Server_Responses.ColorPresentation_Response; overriding function On_Document_Color_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Document_Color_Request) return LSP.Messages.Server_Responses.DocumentColor_Response; overriding function On_ALS_Show_Dependencies_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.ALS_Show_Dependencies_Request) return LSP.Messages.Server_Responses.ALS_ShowDependencies_Response; overriding function On_ALS_Debug_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.ALS_Debug_Request) return LSP.Messages.Server_Responses.ALS_Debug_Response; overriding function On_Formatting_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Formatting_Request) return LSP.Messages.Server_Responses.Formatting_Response; overriding function On_Range_Formatting_Request (Self : access Message_Handler; Request : LSP.Messages.Server_Requests.Range_Formatting_Request) return LSP.Messages.Server_Responses.Range_Formatting_Response; overriding procedure On_Initialized_Notification (Self : access Message_Handler) is null; overriding procedure On_Exit_Notification (Self : access Message_Handler); overriding procedure On_DidChangeTextDocument_Notification (Self : access Message_Handler; Value : LSP.Messages.DidChangeTextDocumentParams); overriding procedure On_DidCloseTextDocument_Notification (Self : access Message_Handler; Value : LSP.Messages.DidCloseTextDocumentParams); overriding procedure On_DidOpenTextDocument_Notification (Self : access Message_Handler; Value : LSP.Messages.DidOpenTextDocumentParams); overriding procedure On_DidSaveTextDocument_Notification (Self : access Message_Handler; Value : LSP.Messages.DidSaveTextDocumentParams) is null; overriding procedure On_DidChangeConfiguration_Notification (Self : access Message_Handler; Value : LSP.Messages.DidChangeConfigurationParams); overriding procedure On_DidChangeWorkspaceFolders_Notification (Self : access Message_Handler; Value : LSP.Messages.DidChangeWorkspaceFoldersParams) is null; overriding procedure On_DidChangeWatchedFiles_Notification (Self : access Message_Handler; Value : LSP.Messages.DidChangeWatchedFilesParams); overriding procedure On_Cancel_Notification (Self : access Message_Handler; Value : LSP.Messages.CancelParams) is null; -- This is intentionally null procedure, because cancel is implemented by -- LSP server itself. overriding function Get_Open_Document (Self : access Message_Handler; URI : LSP.Messages.DocumentUri; Force : Boolean := False) return LSP.Ada_Documents.Document_Access; -- Return the open document for the given URI. -- If the document is not opened, then if Force a new document -- will be created and must be freed by the user else null will be -- returned. overriding function Get_Open_Document_Version (Self : access Message_Handler; URI : LSP.Messages.DocumentUri) return LSP.Messages.OptionalVersionedTextDocumentIdentifier; -- Return the version of an open document for the given URI. -- If the document is not opened, then it returns a -- VersionedTextDocumentIdentifier with a null version. function File_To_URI (Self : Message_Handler'Class; File : LSP.Types.LSP_String) return LSP.Types.LSP_String; -- Convert file name to URI end LSP.Ada_Handlers;