Rewrite Ada_Indexing as a new server job

Refs #1141

Author: reznikmm

source/ada/lsp-ada_indexing.adb

@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------------
 --                         Language Server Protocol                         --
 --                                                                          --
---                       Copyright (C) 2023, AdaCore                        --
+--                     Copyright (C) 2023-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- --
@@ -22,12 +22,15 @@ with VSS.Strings.Templates;
 
 package body LSP.Ada_Indexing is
 
-   -----------------
-   -- Index_Files --
-   -----------------
-
-   procedure Index_Files (Self : in out Indexing_Job'Class) is
+   -------------
+   -- Execute --
+   -------------
 
+   overriding procedure Execute
+     (Self   : in out Indexing_Job;
+      Client :
+        in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class)
+   is
       use type LSP.Ada_Handlers.Project_Stamp;
 
       procedure Emit_Progress_Report (Files_Indexed, Total_Files : Natural);
@@ -51,7 +54,7 @@ package body LSP.Ada_Indexing is
 
          Self.Progress_Report_Sent := Current;
 
-         Self.Server.On_ProgressReport_Work_Done
+         Client.On_ProgressReport_Work_Done
            (Self.Indexing_Token,
             (percentage => (True, (Files_Indexed * 100) / Total_Files),
              message    =>
@@ -63,7 +66,7 @@ package body LSP.Ada_Indexing is
 
    begin
       if Self.Total_Files_Indexed = 0 then
-         Self.Server.On_ProgressBegin_Work_Done
+         Client.On_ProgressBegin_Work_Done
            (Self.Indexing_Token,
             (title => "Indexing", percentage => (True, 0), others => <>));
       end if;
@@ -109,28 +112,10 @@ package body LSP.Ada_Indexing is
       if Self.Files_To_Index.Is_Empty then
          --  Indexing done.
 
-         Self.Server.On_ProgressEnd_Work_Done
+         Client.On_ProgressEnd_Work_Done
            (Self.Indexing_Token, (message => <>));
-
-         return;
       end if;
-
-      declare
-         Job : LSP.Server_Jobs.Server_Jobs_Access :=
-           new Indexing_Job'
-             (Server               => Self.Server.all'Unchecked_Access,
-              Handler              => Self.Handler.all'Unchecked_Access,
-              Files_To_Index       => Self.Files_To_Index,
-              Indexing_Token       => Self.Indexing_Token,
-              Total_Files_Indexed  => Self.Total_Files_Indexed,
-              Total_Files_To_Index => Self.Total_Files_To_Index,
-              Progress_Report_Sent => Self.Progress_Report_Sent,
-              Project_Stamp        => Self.Project_Stamp);
-
-      begin
-         Self.Server.Enqueue (Job);
-      end;
-   end Index_Files;
+   end Execute;
 
    -----------------------
    -- Schedule_Indexing --
@@ -155,7 +140,7 @@ package body LSP.Ada_Indexing is
            Server.Allocate_Request_Id;
          Token : constant LSP.Structures.ProgressToken :=
            Handler.Allocate_Progress_Token ("indexing");
-         Job   : LSP.Server_Jobs.Server_Jobs_Access :=
+         Job   : LSP.Server_Jobs.Server_Job_Access :=
            new Indexing_Job'
              (Server               => Server,
               Handler              => Handler,
@@ -167,7 +152,7 @@ package body LSP.Ada_Indexing is
               Project_Stamp        => Project_Stamp);
 
       begin
-         Job.Server.On_Progress_Create_Request (Id, (token => Token));
+         Server.On_Progress_Create_Request (Id, (token => Token));
          --  FIXME: wait response before sending progress notifications.
          --  Currenctly, we just send a `window/workDoneProgress/create`
          --  request and immediately after this start sending notifications.
@@ -178,16 +163,4 @@ package body LSP.Ada_Indexing is
       end;
    end Schedule_Indexing;
 
-   ----------------------------------
-   -- Visit_Server_Message_Visitor --
-   ----------------------------------
-
-   overriding procedure Visit_Server_Message_Visitor
-     (Self  : Indexing_Job;
-      Value : in out
-        LSP.Server_Message_Visitors.Server_Message_Visitor'Class) is
-   begin
-      Self'Unrestricted_Access.Index_Files;
-   end Visit_Server_Message_Visitor;
-
 end LSP.Ada_Indexing;

source/ada/lsp-ada_indexing.ads

@@ -23,8 +23,9 @@ with GNATCOLL.VFS;
 with LSP.Ada_Configurations;
 with LSP.Ada_Handlers;
 with LSP.Server_Jobs;
-private with LSP.Server_Message_Visitors;
 limited with LSP.Servers;
+private with LSP.Client_Message_Receivers;
+private with LSP.Server_Messages;
 private with LSP.Structures;
 
 package LSP.Ada_Indexing is
@@ -42,7 +43,7 @@ package LSP.Ada_Indexing is
       Project_Stamp : LSP.Ada_Handlers.Project_Stamp;
       Files         : File_Sets.Set);
 
-   type Indexing_Job (<>) is new LSP.Server_Jobs.Abstract_Server_Job
+   type Indexing_Job (<>) is new LSP.Server_Jobs.Server_Job
      with private;
 
 private
@@ -64,7 +65,7 @@ private
    type Indexing_Job
      (Server  : not null access LSP.Servers.Server'Class;
       Handler : not null access LSP.Ada_Handlers.Message_Handler'Class) is
-        new LSP.Server_Jobs.Abstract_Server_Job (Server) with
+        new LSP.Server_Jobs.Server_Job with
    record
       Files_To_Index       : File_Sets.Set;
       --  Contains any files that need indexing.
@@ -84,11 +85,19 @@ private
       Project_Stamp        : LSP.Ada_Handlers.Project_Stamp;
    end record;
 
-   overriding procedure Visit_Server_Message_Visitor
-     (Self  : Indexing_Job;
-      Value : in out
-        LSP.Server_Message_Visitors.Server_Message_Visitor'Class);
+   overriding function Priority
+     (Self : Indexing_Job) return LSP.Server_Jobs.Job_Priority is
+       (LSP.Server_Jobs.Low);
 
-   procedure Index_Files (Self : in out Indexing_Job'Class);
+   overriding function Is_Done (Self : Indexing_Job) return Boolean is
+     (Self.Files_To_Index.Is_Empty);
+
+   overriding procedure Execute
+     (Self   : in out Indexing_Job;
+      Client :
+        in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class);
+
+   overriding function Message (Self : Indexing_Job)
+     return LSP.Server_Messages.Server_Message_Access is (null);
 
 end LSP.Ada_Indexing;

source/server/lsp-job_schedulers.adb

@@ -62,16 +62,26 @@ package body LSP.Job_Schedulers is
 
          if Job.Assigned then
             Message := null;
-
-            if Job.Priority in Self.Jobs'Range then
-               Self.Jobs (Job.Priority).Append (Job);
-            else
-               Self.Blocker := Job;
-            end if;
+            Self.Enqueue (Job);
          end if;
       end if;
    end Create_Job;
 
+   -------------
+   -- Enqueue --
+   -------------
+
+   procedure Enqueue
+     (Self : in out Job_Scheduler'Class;
+      Job  : not null LSP.Server_Jobs.Server_Job_Access) is
+   begin
+      if Job.Priority in Self.Jobs'Range then
+         Self.Jobs (Job.Priority).Append (Job);
+      else
+         Self.Blocker := Job;
+      end if;
+   end Enqueue;
+
    --------------
    -- Has_Jobs --
    --------------

source/server/lsp-job_schedulers.ads

@@ -46,6 +46,11 @@ package LSP.Job_Schedulers is
    --  If there is no handler for the message, then the scheduler doesn't
    --  accept message and server should destroy it.
 
+   procedure Enqueue
+     (Self : in out Job_Scheduler'Class;
+      Job  : not null LSP.Server_Jobs.Server_Job_Access);
+   --  Put Job into the job queue.
+
    procedure Process_High_Priority_Job
      (Self    : in out Job_Scheduler'Class;
       Client  :

source/server/lsp-server_jobs.ads

@@ -17,7 +17,6 @@
 
 with LSP.Client_Message_Receivers;
 with LSP.Server_Messages;
-limited with LSP.Servers;
 
 package LSP.Server_Jobs is
    pragma Preelaborate;
@@ -54,16 +53,15 @@ package LSP.Server_Jobs is
 
    procedure Complete
      (Self : in out Server_Job;
-      Next : LSP.Server_Messages.Server_Message_Access) is null
-       with Pre'Class => Is_Done (Self);
+      Next : LSP.Server_Messages.Server_Message_Access) is null;
    --  Complete message execution. The next message is provided if any.
    --  Currently this is called only for Fence jobs.
 
    procedure Cancel
      (Self   : in out Server_Job;
       Client :
         in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class)
-          is abstract;
+          is null;
    --  Cancel job execution. Use Client to send messages if required.
 
    --  function Progress (Self : Server_Job) return Job_Progress is abstract;
@@ -78,11 +76,4 @@ package LSP.Server_Jobs is
 
    type Server_Job_Access is access all Server_Job'Class;
 
-   type Abstract_Server_Job
-     (Server  : not null access LSP.Servers.Server'Class) is
-     new LSP.Server_Messages.Server_Message with null record;
-   --  This type should be deleted after migration to Server_Job type.
-
-   type Server_Jobs_Access is access all Abstract_Server_Job'Class;
-
 end LSP.Server_Jobs;

source/server/lsp-servers.adb

@@ -117,15 +117,10 @@ package body LSP.Servers is
 
    procedure Enqueue
      (Self : in out Server'Class;
-      Job  : in out LSP.Server_Jobs.Server_Jobs_Access)
-   is
-      use type LSP.Server_Jobs.Server_Jobs_Access;
-
+      Job  : in out LSP.Server_Jobs.Server_Job_Access) is
    begin
-      if Job /= null then
-         Self.Input_Queue.Enqueue (Server_Message_Access (Job));
-         Job := null;
-      end if;
+      Self.Scheduler.Enqueue (Job);
+      Job := null;
    end Enqueue;
 
    --------------

source/server/lsp-servers.ads

@@ -111,7 +111,7 @@ package LSP.Servers is
 
    procedure Enqueue
      (Self : in out Server'Class;
-      Job  : in out LSP.Server_Jobs.Server_Jobs_Access);
+      Job  : in out LSP.Server_Jobs.Server_Job_Access);
    --  Put server job into the queue.
 
    function Allocate_Request_Id