Rewrite workspace/executeCommand as a job

Refs #1141

Author: reznikmm

Makefile

@@ -35,7 +35,7 @@ TESTER=$(ROOTDIR)/.obj/tester/tester-run$(EXE)
 MOCHA_ALS_UPDATE=
 
 GPRBUILD_EXTRA=
-GPRBUILD_FLAGS=-m -j0 $(GPRBUILD_EXTRA)
+GPRBUILD_FLAGS=-m -j4 $(GPRBUILD_EXTRA)
 GPRBUILD=gprbuild $(GPRBUILD_FLAGS) -XSUPERPROJECT=
 GPRCLEAN_EXTRA=
 GPRCLEAN=gprclean -XSUPERPROJECT= $(GPRCLEAN_EXTRA)

source/ada/lsp-ada_commands.ads

@@ -26,8 +26,9 @@ with Ada.Tags;
 
 with VSS.String_Vectors;
 
-with LSP.Structures;
 with LSP.Errors;
+with LSP.Server_Jobs;
+with LSP.Structures;
 
 limited with LSP.Ada_Handlers;
 
@@ -49,6 +50,9 @@ package LSP.Ada_Commands is
    --  Commands are executed on the server side only.
    --  The Handler is the access to the message handler executing the command.
 
+   function Priority (Self : Command) return LSP.Server_Jobs.Job_Priority
+     is abstract;
+
    procedure Register (Value : Ada.Tags.Tag);
    --  Register a new command type. The type should be in Command'Class
 

source/ada/lsp-ada_driver.adb

@@ -43,6 +43,7 @@ with LSP.Ada_Declaration;
 with LSP.Ada_Document_Symbol;
 with LSP.Ada_Did_Change_Configurations;
 with LSP.Ada_Did_Change_Document;
+with LSP.Ada_Execute_Command;
 with LSP.Ada_Folding_Range;
 with LSP.Ada_Hover;
 with LSP.Ada_References;
@@ -85,6 +86,7 @@ with LSP.Server_Notifications.DidChangeConfiguration;
 with LSP.Server_Requests.Definition;
 with LSP.Server_Requests.Declaration;
 with LSP.Server_Requests.DocumentSymbol;
+with LSP.Server_Requests.ExecuteCommand;
 with LSP.Server_Requests.FoldingRange;
 with LSP.Server_Requests.Hover;
 with LSP.Server_Requests.References;
@@ -213,6 +215,10 @@ procedure LSP.Ada_Driver is
      LSP.Ada_Document_Symbol.Ada_Document_Symbol_Handler
        (Ada_Handler'Unchecked_Access);
 
+   Ada_Execute_Command_Handler : aliased
+     LSP.Ada_Execute_Command.Execute_Command_Handler
+       (Ada_Handler'Unchecked_Access);
+
    Ada_Folding_Range_Handler : aliased
      LSP.Ada_Folding_Range.Ada_Folding_Range_Handler
        (Ada_Handler'Unchecked_Access);
@@ -449,6 +455,10 @@ begin
            (LSP.Server_Requests.DocumentSymbol.Request'Tag,
             Ada_Document_Symbol_Handler'Unchecked_Access);
 
+         Server.Register_Handler
+           (LSP.Server_Requests.ExecuteCommand.Request'Tag,
+            Ada_Execute_Command_Handler'Unchecked_Access);
+
          Server.Register_Handler
            (LSP.Server_Requests.FoldingRange.Request'Tag,
             Ada_Folding_Range_Handler'Unchecked_Access);

source/ada/lsp-ada_execute_command.adb

@@ -0,0 +1,146 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                        Copyright (C) 2024, 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.                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Tags.Generic_Dispatching_Constructor;
+with Ada.Unchecked_Deallocation;
+
+with VSS.Strings.Conversions;
+
+with LSP.Ada_Commands;
+with LSP.Ada_Handlers;
+with LSP.Ada_Request_Jobs;
+with LSP.Client_Message_Receivers;
+with LSP.Enumerations;
+with LSP.Errors;
+with LSP.Server_Requests.ExecuteCommand;
+with LSP.Structures;
+
+package body LSP.Ada_Execute_Command is
+
+   type Command_Access is access LSP.Ada_Commands.Command'Class;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (LSP.Ada_Commands.Command'Class, Command_Access);
+
+   type Ada_Execute_Command_Job
+     (Parent : not null access constant Execute_Command_Handler) is limited
+   new LSP.Ada_Request_Jobs.Ada_Request_Job (Priority => LSP.Server_Jobs.Low)
+     with record
+        Command : Command_Access;
+     end record;
+
+   overriding function Priority
+     (Self : Ada_Execute_Command_Job) return LSP.Server_Jobs.Job_Priority is
+       (if Self.Request.Canceled then LSP.Server_Jobs.Immediate
+        elsif Self.Command = null then LSP.Server_Jobs.Low
+        else Self.Command.Priority);
+   --  Use command priority when we have a command
+
+   overriding procedure Execute_Ada_Request
+     (Self   : in out Ada_Execute_Command_Job;
+      Client :
+        in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
+      Status : out LSP.Server_Jobs.Execution_Status);
+
+   function Create_Command is new Ada.Tags.Generic_Dispatching_Constructor
+     (T           => LSP.Ada_Commands.Command,
+      Parameters  => LSP.Structures.LSPAny_Vector,
+      Constructor => LSP.Ada_Commands.Create);
+
+   ----------------
+   -- Create_Job --
+   ----------------
+
+   overriding function Create_Job
+     (Self    : Execute_Command_Handler;
+      Message : LSP.Server_Messages.Server_Message_Access)
+      return LSP.Server_Jobs.Server_Job_Access
+   is
+      use type Ada.Tags.Tag;
+
+      Request : LSP.Server_Requests.ExecuteCommand.Request
+        renames LSP.Server_Requests.ExecuteCommand.Request (Message.all);
+
+      Params : LSP.Structures.ExecuteCommandParams renames Request.Params;
+
+      Tag : constant Ada.Tags.Tag :=
+        (if Params.command.Is_Empty then Ada.Tags.No_Tag
+         else Ada.Tags.Internal_Tag
+           (VSS.Strings.Conversions.To_UTF_8_String (Params.command)));
+
+      Command : constant Command_Access :=
+        (if Tag = Ada.Tags.No_Tag then null
+         else new LSP.Ada_Commands.Command'Class'
+           (Create_Command (Tag, Params.arguments'Unrestricted_Access)));
+
+      Result : constant LSP.Server_Jobs.Server_Job_Access :=
+        new Ada_Execute_Command_Job'
+          (Parent  => Self'Unchecked_Access,
+           Command => Command,
+           Request => LSP.Ada_Request_Jobs.Request_Access (Message));
+   begin
+      return Result;
+   end Create_Job;
+
+   -------------------------
+   -- Execute_Ada_Request --
+   -------------------------
+
+   overriding procedure Execute_Ada_Request
+     (Self   : in out Ada_Execute_Command_Job;
+      Client :
+        in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
+      Status : out LSP.Server_Jobs.Execution_Status)
+   is
+
+      Handler : constant not null access
+        LSP.Ada_Handlers.Message_Handler'Class :=
+          LSP.Ada_Handlers.Message_Handler'Class
+            (Self.Parent.Context.all)'Access;
+
+      Message : LSP.Server_Requests.ExecuteCommand.Request
+        renames LSP.Server_Requests.ExecuteCommand.Request (Self.Message.all);
+
+      Response : LSP.Structures.LSPAny_Or_Null;
+      Error    : LSP.Errors.ResponseError_Optional;
+
+   begin
+      Status := LSP.Server_Jobs.Done;
+
+      if Self.Command = null then
+         Client.On_Error_Response
+           (Message.Id,
+            (code    => LSP.Enumerations.InternalError,
+             message => "Unknown command"));
+
+      else
+         Self.Command.Execute
+           (Handler  => Handler,
+            Response => Response,
+            Error    => Error);
+
+         if Error.Is_Set then
+            Client.On_Error_Response (Message.Id, Error.Value);
+         else
+            Client.On_ExecuteCommand_Response (Message.Id, Response);
+         end if;
+
+         Free (Self.Command);
+      end if;
+   end Execute_Ada_Request;
+
+end LSP.Ada_Execute_Command;

source/ada/lsp-ada_execute_command.ads

@@ -0,0 +1,38 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                        Copyright (C) 2024, 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 handler and job types for workspace/executeCommand
+--  requests.
+
+with LSP.Ada_Job_Contexts;
+with LSP.Server_Jobs;
+with LSP.Server_Message_Handlers;
+with LSP.Server_Messages;
+
+package LSP.Ada_Execute_Command is
+
+   type Execute_Command_Handler
+     (Context : not null access LSP.Ada_Job_Contexts.Ada_Job_Context'Class) is
+       limited new LSP.Server_Message_Handlers.Server_Message_Handler
+         with null record;
+
+   overriding function Create_Job
+     (Self    : Execute_Command_Handler;
+      Message : LSP.Server_Messages.Server_Message_Access)
+        return LSP.Server_Jobs.Server_Job_Access;
+
+end LSP.Ada_Execute_Command;

source/ada/lsp-ada_handlers-executables_commands.ads

@@ -19,6 +19,7 @@
 
 with LSP.Ada_Commands;
 with LSP.Errors;
+with LSP.Server_Jobs;
 
 package LSP.Ada_Handlers.Executables_Commands is
 
@@ -38,6 +39,10 @@ private
       Response : in out LSP.Structures.LSPAny_Or_Null;
       Error    : in out LSP.Errors.ResponseError_Optional);
 
+   overriding function Priority (Self : Command)
+     return LSP.Server_Jobs.Job_Priority
+       is (LSP.Server_Jobs.Low);
+
    for Command'External_Tag use "als-executables";
 
 end LSP.Ada_Handlers.Executables_Commands;

source/ada/lsp-ada_handlers-mains_commands.ads

@@ -19,6 +19,7 @@
 
 with LSP.Ada_Commands;
 with LSP.Errors;
+with LSP.Server_Jobs;
 
 package LSP.Ada_Handlers.Mains_Commands is
 
@@ -38,6 +39,10 @@ private
       Response : in out LSP.Structures.LSPAny_Or_Null;
       Error    : in out LSP.Errors.ResponseError_Optional);
 
+   overriding function Priority (Self : Command)
+     return LSP.Server_Jobs.Job_Priority
+       is (LSP.Server_Jobs.Low);
+
    for Command'External_Tag use "als-mains";
 
 end LSP.Ada_Handlers.Mains_Commands;

source/ada/lsp-ada_handlers-named_parameters_commands.ads

@@ -20,6 +20,7 @@
 
 with LSP.Ada_Commands;
 with LSP.Errors;
+with LSP.Server_Jobs;
 
 package LSP.Ada_Handlers.Named_Parameters_Commands is
 
@@ -57,6 +58,10 @@ private
       Response : in out LSP.Structures.LSPAny_Or_Null;
       Error    : in out LSP.Errors.ResponseError_Optional);
 
+   overriding function Priority (Self : Command)
+     return LSP.Server_Jobs.Job_Priority
+       is (LSP.Server_Jobs.Low);
+
    function Write_Command
      (Self : Command) return LSP.Structures.LSPAny_Vector;
 

source/ada/lsp-ada_handlers-object_dir_commands.ads

@@ -20,6 +20,7 @@
 
 with LSP.Ada_Commands;
 with LSP.Errors;
+with LSP.Server_Jobs;
 
 package LSP.Ada_Handlers.Object_Dir_Commands is
 
@@ -39,6 +40,10 @@ private
       Response : in out LSP.Structures.LSPAny_Or_Null;
       Error    : in out LSP.Errors.ResponseError_Optional);
 
+   overriding function Priority (Self : Command)
+     return LSP.Server_Jobs.Job_Priority
+       is (LSP.Server_Jobs.Low);
+
    for Command'External_Tag use "als-object-dir";
 
 end LSP.Ada_Handlers.Object_Dir_Commands;

source/ada/lsp-ada_handlers-other_file_commands.ads

@@ -19,6 +19,7 @@
 
 with LSP.Ada_Commands;
 with LSP.Errors;
+with LSP.Server_Jobs;
 
 package LSP.Ada_Handlers.Other_File_Commands is
 
@@ -44,6 +45,10 @@ private
       Response : in out LSP.Structures.LSPAny_Or_Null;
       Error    : in out LSP.Errors.ResponseError_Optional);
 
+   overriding function Priority (Self : Command)
+     return LSP.Server_Jobs.Job_Priority
+       is (LSP.Server_Jobs.Low);
+
    for Command'External_Tag use "als-other-file";
 
 end LSP.Ada_Handlers.Other_File_Commands;