Add a base type for server request jobs

reznikmm · reznikmm · commit 7528dcc50756 · 2024-03-26T14:58:59.000Z
to keep request cancelation logic. Use it in hover and references requests. Refs #1141
diff --git a/source/ada/lsp-ada_hover.adb b/source/ada/lsp-ada_hover.adb
@@ -25,33 +25,27 @@ with LSP.Ada_Context_Sets;
 with LSP.Ada_Documentation;
 with LSP.Client_Message_Receivers;
 with LSP.Predefined_Completion;
+with LSP.Server_Request_Jobs;
 with LSP.Server_Requests.Hover;
 with LSP.Structures;
 with LSP.Utils;
 
 package body LSP.Ada_Hover is
 
    type Ada_Hover_Job
-     (Parent : not null access constant Ada_Hover_Handler)
-   is limited new LSP.Server_Jobs.Server_Job with record
-      Message       : LSP.Server_Messages.Server_Message_Access;
-   end record;
+     (Parent : not null access constant Ada_Hover_Handler) is limited
+   new LSP.Server_Request_Jobs.Server_Request_Job
+     (Priority => LSP.Server_Jobs.High)
+        with null record;
 
    type Ada_Hover_Job_Access is access all Ada_Hover_Job;
 
-   overriding function Priority
-     (Self : Ada_Hover_Job) return LSP.Server_Jobs.Job_Priority is
-       (LSP.Server_Jobs.High);
-
-   overriding procedure Execute
+   overriding procedure Execute_Request
      (Self   : in out Ada_Hover_Job;
       Client :
         in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
       Status : out LSP.Server_Jobs.Execution_Status);
 
-   overriding function Message (Self : Ada_Hover_Job)
-     return LSP.Server_Messages.Server_Message_Access is (Self.Message);
-
    ----------------
    -- Create_Job --
    ----------------
@@ -64,16 +58,16 @@ package body LSP.Ada_Hover is
       Result : constant Ada_Hover_Job_Access :=
         new Ada_Hover_Job'
           (Parent  => Self'Unchecked_Access,
-           Message => Message);
+           Request => LSP.Server_Request_Jobs.Request_Access (Message));
    begin
       return LSP.Server_Jobs.Server_Job_Access (Result);
    end Create_Job;
 
-   -------------
-   -- Execute --
-   -------------
+   ---------------------
+   -- Execute_Request --
+   ---------------------
 
-   overriding procedure Execute
+   overriding procedure Execute_Request
      (Self   : in out Ada_Hover_Job;
       Client :
         in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
@@ -209,6 +203,6 @@ package body LSP.Ada_Hover is
       end if;
 
       Client.On_Hover_Response (Message.Id, Response);
-   end Execute;
+   end Execute_Request;
 
 end LSP.Ada_Hover;
diff --git a/source/ada/lsp-ada_references.adb b/source/ada/lsp-ada_references.adb
@@ -31,6 +31,7 @@ with LSP.Ada_Id_Iterators;
 with LSP.Client_Message_Receivers;
 with LSP.Enumerations;
 with LSP.Locations;
+with LSP.Server_Request_Jobs;
 with LSP.Server_Requests.References;
 with LSP.Structures;
 
@@ -47,34 +48,28 @@ package body LSP.Ada_References is
      (Reversible_Iterator, Iterator_Access);
 
    type Ada_References_Job
-     (Parent : not null access constant Ada_References_Handler)
-   is limited new LSP.Server_Jobs.Server_Job with record
-      Message       : LSP.Server_Messages.Server_Message_Access;
-      Is_Enum       : Boolean := False;
-      Response      : LSP.Structures.Location_Vector_Or_Null;
-      Filter        : LSP.Locations.File_Span_Sets.Set;
-      Contexts      : LSP.Ada_Context_Sets.Context_Lists.List;
-      Context       : LSP.Ada_Context_Sets.Context_Access;
-      Iterator      : Iterator_Access;
-      Cursor        : LSP.Ada_File_Sets.File_Sets.Cursor;
-      Definition    : Libadalang.Analysis.Defining_Name;
+     (Parent : not null access constant Ada_References_Handler) is limited
+   new LSP.Server_Request_Jobs.Server_Request_Job
+     (Priority => LSP.Server_Jobs.Low) with
+   record
+      Is_Enum    : Boolean := False;
+      Response   : LSP.Structures.Location_Vector_Or_Null;
+      Filter     : LSP.Locations.File_Span_Sets.Set;
+      Contexts   : LSP.Ada_Context_Sets.Context_Lists.List;
+      Context    : LSP.Ada_Context_Sets.Context_Access;
+      Iterator   : Iterator_Access;
+      Cursor     : LSP.Ada_File_Sets.File_Sets.Cursor;
+      Definition : Libadalang.Analysis.Defining_Name;
    end record;
 
    type Ada_References_Job_Access is access all Ada_References_Job;
 
-   overriding function Priority
-     (Self : Ada_References_Job) return LSP.Server_Jobs.Job_Priority is
-       (LSP.Server_Jobs.Low);
-
-   overriding procedure Execute
+   overriding procedure Execute_Request
      (Self   : in out Ada_References_Job;
       Client :
         in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
       Status : out LSP.Server_Jobs.Execution_Status);
 
-   overriding function Message (Self : Ada_References_Job)
-     return LSP.Server_Messages.Server_Message_Access is (Self.Message);
-
    function Get_Reference_Kind
      (Self               : Ada_References_Job'Class;
       Node               : Libadalang.Analysis.Ada_Node'Class;
@@ -101,19 +96,19 @@ package body LSP.Ada_References is
       Result : constant Ada_References_Job_Access :=
         new Ada_References_Job'
           (Parent  => Self'Unchecked_Access,
-           Message => Message,
+           Request => LSP.Server_Request_Jobs.Request_Access (Message),
            others  => <>);
    begin
       Result.Contexts := Self.Context.Contexts_For_File (File);
 
       return LSP.Server_Jobs.Server_Job_Access (Result);
    end Create_Job;
 
-   -------------
-   -- Execute --
-   -------------
+   ---------------------
+   -- Execute_Request --
+   ---------------------
 
-   overriding procedure Execute
+   overriding procedure Execute_Request
      (Self   : in out Ada_References_Job;
       Client :
         in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
@@ -232,7 +227,7 @@ package body LSP.Ada_References is
          Client.On_References_Response (Message.Id, Self.Response);
          Status := LSP.Server_Jobs.Done;
       end if;
-   end Execute;
+   end Execute_Request;
 
    ------------------------
    -- Get_Reference_Kind --
diff --git a/source/server/lsp-server_request_jobs.adb b/source/server/lsp-server_request_jobs.adb
@@ -0,0 +1,45 @@
+------------------------------------------------------------------------------
+--                         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 LSP.Constants;
+
+package body LSP.Server_Request_Jobs is
+
+   -------------
+   -- Execute --
+   -------------
+
+   overriding procedure Execute
+     (Self   : in out Server_Request_Job;
+      Client : in out LSP.Client_Message_Receivers.Client_Message_Receiver'
+        Class;
+      Status :    out LSP.Server_Jobs.Execution_Status)
+   is
+   begin
+      if Self.Request.Canceled then
+         Client.On_Error_Response
+           (Self.Request.Id,
+            (code    => LSP.Constants.RequestCancelled,
+             message => "Request was canceled"));
+
+         Status := LSP.Server_Jobs.Done;
+      else
+         Execute_Request (Server_Request_Job'Class (Self), Client, Status);
+      end if;
+   end Execute;
+
+end LSP.Server_Request_Jobs;
diff --git a/source/server/lsp-server_request_jobs.ads b/source/server/lsp-server_request_jobs.ads
@@ -0,0 +1,61 @@
+------------------------------------------------------------------------------
+--                         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 a base type for server requests jobs. It implements
+--  request cancelation logic: if the request has been canceled then the job
+--  has Immediate priority and its execution just sends the corresponding
+--  error code.
+
+with LSP.Client_Message_Receivers;
+with LSP.Server_Jobs;
+with LSP.Server_Messages;
+with LSP.Server_Requests;
+
+package LSP.Server_Request_Jobs is
+   pragma Preelaborate;
+
+   type Request_Access is
+     access all LSP.Server_Requests.Server_Request'Class;
+
+   type Server_Request_Job (Priority : LSP.Server_Jobs.Job_Priority)
+     is abstract limited new LSP.Server_Jobs.Server_Job with
+   record
+       Request : Request_Access;
+   end record;
+
+   procedure Execute_Request
+     (Self   : in out Server_Request_Job;
+      Client :
+        in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
+      Status : out LSP.Server_Jobs.Execution_Status) is abstract;
+
+   overriding function Priority
+     (Self : Server_Request_Job) return LSP.Server_Jobs.Job_Priority is
+       (if Self.Request.Canceled then LSP.Server_Jobs.Immediate
+        else Self.Priority);
+
+   overriding procedure Execute
+     (Self   : in out Server_Request_Job;
+      Client :
+        in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
+      Status : out LSP.Server_Jobs.Execution_Status);
+
+   overriding function Message (Self : Server_Request_Job)
+     return LSP.Server_Messages.Server_Message_Access is
+       (LSP.Server_Messages.Server_Message_Access (Self.Request));
+
+end LSP.Server_Request_Jobs;
