Remove context-specific logic from Alire package

For eng/ide/ada_language_server#1661

Author: eliericha

integration/vscode/ada/src/ExtensionState.ts

@@ -122,6 +122,7 @@ export class ExtensionState {
 
     public start = async () => {
         await Promise.all([this.gprClient.start(), this.adaClient.start()]);
+
         this.registerTaskDisposables();
         this.context.subscriptions.push(
             vscode.languages.registerCodeLensProvider('ada', this.codelensProvider),

integration/vscode/ada/src/clients.ts

@@ -136,6 +136,11 @@ export function createClient(
              * from .als.json or other applicable configuration files.
              */
             ({ ada: getExplicitlySetConfiguration() }),
+        /**
+         * Include a workDoneToken property in the 'initialize' request for the
+         * server to report progress.
+         */
+        progressOnInitialization: true,
     };
 
     // Create the language client

integration/vscode/ada/src/extension.ts

@@ -168,14 +168,14 @@ async function activateExtension(context: vscode.ExtensionContext) {
     adaExtState.adaClient.clientOptions.middleware = alsMiddleware;
     adaExtState.adaClient.registerFeature(new ALSClientFeatures());
 
-    await adaExtState.start();
-
     /**
      * Register commands first so that commands such as displaying the extension
      * Output become available even if the language servers fail to start.
      */
     registerCommands(context, adaExtState);
 
+    await adaExtState.start();
+
     await vscode.commands.executeCommand('setContext', ADA_CONTEXT, true);
 
     /**

source/ada/lsp-ada_handlers-project_loading.adb

@@ -63,6 +63,9 @@ package body LSP.Ada_Handlers.Project_Loading is
      GNATCOLL.Traces.Create ("ALS.RUNTIME_INDEXING", GNATCOLL.Traces.On);
    --  Trace to enable/disable runtime indexing. Useful for the testsuite.
 
+   Fallback_Msg : constant VSS.Strings.Virtual_String :=
+     "Falling back to other methods to load a project";
+
    type GPR2_Reporter is new GPR2.Reporter.Object with record
       Log : GPR2.Log.Object;
    end record;
@@ -136,8 +139,8 @@ package body LSP.Ada_Handlers.Project_Loading is
 
       C : constant Context_Access := new Context (Self.Tracer);
 
-      Reader : LSP.Ada_Handlers.File_Readers.LSP_File_Reader
-        (Self'Unchecked_Access);
+      Reader :
+        LSP.Ada_Handlers.File_Readers.LSP_File_Reader (Self'Unchecked_Access);
 
       Dirs : File_Sets.Set;
 
@@ -160,17 +163,17 @@ package body LSP.Ada_Handlers.Project_Loading is
       Create_In_Memory_Project
         ("fallback_context", Dirs, Project_Tree, Success);
 
-      pragma Assert
-        (Success, "Can't create an empty project for the fallback context");
+      pragma
+        Assert
+          (Success, "Can't create an empty project for the fallback context");
 
       --  Create a basic GPR2_Provider_And_Projects containing only the
       --  implicit project and load it.
       declare
          Provider : Libadalang.Project_Provider.GPR2_Provider_And_Projects :=
            (Provider =>
               Libadalang.Project_Provider.Create_Project_Unit_Provider
-                (Tree    => Project_Tree,
-                 Project => Project_Tree.Root_Project),
+                (Tree => Project_Tree, Project => Project_Tree.Root_Project),
             Projects => <>);
       begin
          Provider.Projects.Append (Project_Tree.Root_Project);
@@ -224,34 +227,54 @@ package body LSP.Ada_Handlers.Project_Loading is
            (LSP.Ada_Project_Loading.Configured_Project);
 
       elsif Is_Alire_Crate then
-         Tracer.Trace ("Workspace is an Alire crate");
-
-         Tracer.Trace ("Performing minimal Alire sync");
-         LSP.Alire.Conservative_Alire_Sync
-           (Self.Client.Root_Directory.Display_Full_Name, Alire_Error);
+         declare
 
-         if not Alire_Error.Is_Empty then
-            Tracer.Trace_Text ("Encountered errors: " & Alire_Error);
-            Self.Project_Status.Set_Alire_Messages ([Alire_Error]);
-         else
-            Tracer.Trace ("Determining project from 'alr show' output");
+            procedure Report_Alire_Errors;
 
-            LSP.Alire.Determine_Alire_Project
-              (Root    => Self.Client.Root_Directory.Display_Full_Name,
-               Error   => Alire_Error,
-               Project => Project_File);
+            procedure Report_Alire_Errors is
+            begin
+               --  If the error is multi-line, use a separate line for the
+               --  fallback message. Otherwise, keep a single line.
+               if Alire_Error.Split_Lines.Length > 1 then
+                  Alire_Error.Append (VSS.Characters.Latin.Line_Feed);
+               else
+                  Alire_Error.Append (": ");
+               end if;
+               Alire_Error.Append (Fallback_Msg);
 
-            if not Alire_Error.Is_Empty then
                Tracer.Trace_Text ("Encountered errors: " & Alire_Error);
                Self.Project_Status.Set_Alire_Messages ([Alire_Error]);
+            end Report_Alire_Errors;
+
+         begin
+
+            Tracer.Trace ("Workspace is an Alire crate");
+
+            Tracer.Trace ("Performing minimal Alire sync");
+            LSP.Alire.Conservative_Alire_Sync
+              (Self.Client.Root_Directory.Display_Full_Name, Alire_Error);
+
+            if not Alire_Error.Is_Empty then
+               Report_Alire_Errors;
             else
-               --  Report how we found the project
-               Self.Project_Status.Set_Project_Type
-                 (LSP.Ada_Project_Loading.Alire_Project);
-               Self.Project_Status.Set_Alire_Messages ([]);
-            end if;
+               Tracer.Trace ("Determining project from 'alr show' output");
 
-         end if;
+               LSP.Alire.Determine_Alire_Project
+                 (Root    => Self.Client.Root_Directory.Display_Full_Name,
+                  Error   => Alire_Error,
+                  Project => Project_File);
+
+               if not Alire_Error.Is_Empty then
+                  Report_Alire_Errors;
+               else
+                  --  Report how we found the project
+                  Self.Project_Status.Set_Project_Type
+                    (LSP.Ada_Project_Loading.Alire_Project);
+                  Self.Project_Status.Set_Alire_Messages ([]);
+               end if;
+
+            end if;
+         end;
 
       end if;
 
@@ -354,7 +377,8 @@ package body LSP.Ada_Handlers.Project_Loading is
 
          Load_Implicit_Project
            (Self,
-            (if Candidates.Length = 0 then LSP.Ada_Project_Loading.No_Project
+            (if Candidates.Length = 0
+             then LSP.Ada_Project_Loading.No_Project
              elsif Candidates.Length > 1
              then LSP.Ada_Project_Loading.Multiple_Projects
              else LSP.Ada_Project_Loading.Project_Not_Found));
@@ -857,8 +881,7 @@ package body LSP.Ada_Handlers.Project_Loading is
    is
       Project  : GPR2.Project.Tree.View_Builder.Object :=
         GPR2.Project.Tree.View_Builder.Create
-          (Project_Dir => GPR2.Path_Name.Create_Directory ("."),
-           Name        => Name);
+          (Project_Dir => GPR2.Path_Name.Create_Directory ("."), Name => Name);
       Values   : GPR2.Containers.Value_List;
       Opts     : GPR2.Options.Object;
       Reporter : GPR2_Reporter;

source/ada/lsp-ada_handlers.adb

@@ -2485,6 +2485,15 @@ package body LSP.Ada_Handlers is
       Token_Types     : LSP.Structures.Virtual_String_Vector;
       Token_Motifiers : LSP.Structures.Virtual_String_Vector;
    begin
+      if Value.workDoneToken.Is_Set then
+         Self.Sender.On_ProgressBegin_Work_Done
+           (Value.workDoneToken.Value,
+            (title       => "Initializing Ada Language Server",
+             cancellable => (Is_Set => True, Value => False),
+             message     => VSS.Strings.Empty_Virtual_String,
+             percentage  => (Is_Set => False)));
+      end if;
+
       Self.Client.Initialize (Value);
 
       Self.Highlighter.Initialize
@@ -2550,6 +2559,12 @@ package body LSP.Ada_Handlers is
          --  notification. See On_Initialized_Notification.
       end if;
 
+      if Value.workDoneToken.Is_Set then
+         Self.Sender.On_ProgressEnd_Work_Done
+            (Value.workDoneToken.Value,
+            (message => VSS.Strings.Empty_Virtual_String));
+      end if;
+
       Self.Sender.On_Initialize_Response (Id, Response);
 
       Log_Info.a_type := LSP.Enumerations.Log;

source/ada/lsp-alire.adb

@@ -44,9 +44,6 @@ package body LSP.Alire is
    Alire_Verbose : constant GNATCOLL_Tracers.Tracer :=
      GNATCOLL_Tracers.Create ("ALS.ALIRE.VERBOSE", GNATCOLL.Traces.From_Config);
 
-   Fallback_Msg : constant VSS.Strings.Virtual_String :=
-     "falling back to other methods to load a project";
-
    type Process_Listener is limited
      new Spawn.Process_Listeners.Process_Listener
    with record
@@ -258,8 +255,7 @@ package body LSP.Alire is
            GNAT.OS_Lib.Locate_Exec_On_Path ("alr");
       begin
          if ALR = null then
-            Error :=
-              "Alire executable ('alr') not found in PATH: " & Fallback_Msg;
+            Error := "Alire executable ('alr') not found in PATH";
             return;
          end if;
 
@@ -337,8 +333,7 @@ package body LSP.Alire is
             Error.Append (To_Virtual_String (Arg));
          end loop;
 
-         Error.Append ("' failed: ");
-         Error.Append (Fallback_Msg);
+         Error.Append ("' failed:");
          Error.Append (VSS.Characters.Latin.Line_Feed);
 
          if Decoder.Has_Error then

source/gpr/lsp-gpr_files.adb

@@ -1710,21 +1710,20 @@ package body LSP.GPR_Files is
    ---------------------
 
    procedure Set_Environment
-     (Client : LSP.Ada_Client_Capabilities.Client_Capability)
+     (Client : LSP.Ada_Client_Capabilities.Client_Capability;
+      Error  : out VSS.Strings.Virtual_String)
    is
    begin
       Env := GPR2.Environment.Process_Environment;
 
       if LSP.Alire.Should_Setup_Alire_Env (Client) then
-         declare
-            Error : VSS.Strings.Virtual_String;
-         begin
-            --  set Environment from Alire
-            LSP.Alire.Setup_Alire_Env
-              (Root        => Client.Root_Directory.Display_Full_Name,
-               Error       => Error,
-               Environment => Env);
-         end;
+         --  set Environment from Alire
+         LSP.Alire.Setup_Alire_Env
+           (Root        => Client.Root_Directory.Display_Full_Name,
+            Error       => Error,
+            Environment => Env);
+      else
+         Error := "";
       end if;
    end Set_Environment;
 

source/gpr/lsp-gpr_files.ads

@@ -292,7 +292,8 @@ package LSP.GPR_Files is
    --  Type_Id/String conversions
 
    procedure Set_Environment
-     (Client : LSP.Ada_Client_Capabilities.Client_Capability);
+     (Client : LSP.Ada_Client_Capabilities.Client_Capability;
+      Error  : out VSS.Strings.Virtual_String);
    --  Set environment to be used when parsing GPR files
 
    function Environment return GPR2.Environment.Object;

source/gpr/lsp-gpr_handlers.adb

@@ -37,6 +37,7 @@ with LSP.Utils;
 
 with Gpr_Parser.Common;
 with VSS.String_Vectors;
+with VSS.Strings;
 
 package body LSP.GPR_Handlers is
 
@@ -410,7 +411,23 @@ package body LSP.GPR_Handlers is
 
       Self.Client.Initialize (Value);
 
-      LSP.GPR_Files.Set_Environment (Self.Client);
+      declare
+         Alire_Error : VSS.Strings.Virtual_String;
+      begin
+         LSP.GPR_Files.Set_Environment (Self.Client, Alire_Error);
+
+         if not Alire_Error.Is_Empty then
+
+            Alire_Error.Prepend ("Error while setting up environment: ");
+
+            Self.Tracer.Trace_Text (Alire_Error);
+
+            Self.Sender.On_ShowMessage_Notification
+              ((LSP.Enumerations.Error, Alire_Error));
+
+         end if;
+
+      end;
 
       Capabilities.hoverProvider := LSP.Constants.True;
       Capabilities.definitionProvider := LSP.Constants.True;

testsuite/ada_lsp/project_diags.alire_without_alr/test.json

@@ -93,7 +93,7 @@
                "params": {
                   "diagnostics": [
                      {
-                        "message": "Alire executable ('alr') not found in PATH: falling back to other methods to load a project",
+                        "message": "Alire executable ('alr') not found in PATH: Falling back to other methods to load a project",
                         "range": {
                            "end": {
                               "character": 0,