Merge branch 'topic/gil-1338-alire-toml-file-support' into 'master'

Add Alire/GPR support

Closes #1338

See merge request eng/ide/ada_language_server!1578

Author: Philippe Gil

source/ada/lsp-ada_client_capabilities.adb

@@ -17,6 +17,8 @@
 
 pragma Ada_2022;
 
+with URIs;
+
 with VSS.Characters.Latin;
 with VSS.JSON.Streams;
 with VSS.String_Vectors;
@@ -25,6 +27,7 @@ with VSS.Strings.Conversions;
 with LSP.Ada_Configurations;
 with LSP.Constants;
 with LSP.Enumerations;
+with LSP.GPR_Files;
 with LSP.Structures.Unwrap;
 
 with LSP.Structures.LSPAny_Vectors;
@@ -205,6 +208,9 @@ package body LSP.Ada_Client_Capabilities is
       end if;
 
       Self.Parse_Experimental;
+
+      LSP.GPR_Files.Set_Environment (Client_Capability (Self));
+
    end Initialize;
 
    ------------------------
@@ -593,4 +599,21 @@ package body LSP.Ada_Client_Capabilities is
       return (if Result.Is_Set then Result.Value else False);
    end Versioned_Documents;
 
+   --------------------
+   -- Root_Directory --
+   --------------------
+
+   function Root_Directory (Client : Client_Capability'Class)
+      return GNATCOLL.VFS.Virtual_File
+   is
+      Value : constant VSS.Strings.Virtual_String := Client.Root;
+      Root  : constant String :=
+                 VSS.Strings.Conversions.To_UTF_8_String (Value);
+   begin
+      return GNATCOLL.VFS.Create_From_UTF8
+               (if Value.Starts_With ("file://")
+                then URIs.Conversions.To_File (Root, True)
+               else Root);
+   end Root_Directory;
+
 end LSP.Ada_Client_Capabilities;

source/ada/lsp-ada_client_capabilities.ads

@@ -15,6 +15,8 @@
 -- of the license.                                                          --
 ------------------------------------------------------------------------------
 
+with GNATCOLL.VFS;
+
 with VSS.Strings;
 
 with LSP.Structures;
@@ -46,6 +48,10 @@ package LSP.Ada_Client_Capabilities is
    --  if not rootUri/rootPath is provided, then it means no folder is open.
    --  Return an empty string in this case.
 
+   function Root_Directory
+     (Client : Client_Capability'Class) return GNATCOLL.VFS.Virtual_File;
+   --  Return the root directory of the client workspace
+
    procedure Set_Root_If_Empty
      (Self  : in out Client_Capability'Class;
       Value : VSS.Strings.Virtual_String);

source/ada/lsp-ada_handlers-project_loading.adb

@@ -29,11 +29,9 @@ with Libadalang.Preprocessing;
 
 with VSS.Strings.Conversions;
 
-with Spawn.Environments;
-
 with LSP.Ada_Contexts;
 with LSP.Ada_Context_Sets;
-with LSP.Ada_Handlers.Alire;
+with LSP.Alire;
 with LSP.Ada_Handlers.File_Readers;
 with LSP.Ada_Indexing;
 with LSP.Enumerations;
@@ -85,10 +83,6 @@ package body LSP.Ada_Handlers.Project_Loading is
    --  Mark all sources in all projects for indexing. This factorizes code
    --  between Load_Project and Load_Implicit_Project.
 
-   function Root
-     (Self : Message_Handler'Class) return GNATCOLL.VFS.Virtual_File;
-   --  Return the root directory of the client workspace
-
    ---------------------------
    -- Ensure_Project_Loaded --
    ---------------------------
@@ -125,7 +119,7 @@ package body LSP.Ada_Handlers.Project_Loading is
       if not Self.Client.Root.Is_Empty then
          declare
             Files : GNATCOLL.VFS.File_Array_Access :=
-              Root (Self).Read_Dir (GNATCOLL.VFS.Files_Only);
+              Self.Client.Root_Directory.Read_Dir (GNATCOLL.VFS.Files_Only);
          begin
             for X of Files.all loop
                if X.Has_Suffix (".gpr") then
@@ -203,7 +197,7 @@ package body LSP.Ada_Handlers.Project_Loading is
       --  root directory in the workspace.
 
       if not Self.Client.Root.Is_Empty then
-         Self.Project_Dirs_Loaded.Include (Root (Self));
+         Self.Project_Dirs_Loaded.Include (Self.Client.Root_Directory);
       end if;
 
       Reload_Implicit_Project_Dirs (Self);
@@ -313,8 +307,11 @@ package body LSP.Ada_Handlers.Project_Loading is
       --  relative path; if so, we're assuming it's relative
       --  to Self.Root.
 
-      if not Project_File.Is_Absolute_Path and then not Self.Client.Root.Is_Empty then
-         Project_File := GNATCOLL.VFS.Join (Root (Self), Project_File);
+      if not Project_File.Is_Absolute_Path
+        and then not Self.Client.Root.Is_Empty
+      then
+         Project_File := GNATCOLL.VFS.Join (Self.Client.Root_Directory,
+                                            Project_File);
       end if;
 
       --  Unload the project tree and the project environment
@@ -424,30 +421,24 @@ package body LSP.Ada_Handlers.Project_Loading is
       Environment : GPR2.Environment.Object :=
         GPR2.Environment.Process_Environment;
 
-      Alire_TOML  : constant GNATCOLL.VFS.Virtual_File :=
-        (if Self.Client.Root.Is_Empty then GNATCOLL.VFS.No_File
-         else Root (Self).Create_From_Dir ("alire.toml"));
-
    begin
-      if Alire_TOML.Is_Regular_File
-        and Spawn.Environments.System_Environment.Value ("ALIRE") /= "True"
-      then
+      if LSP.Alire.Alire_Active (Self.Client) then
 
          Self.Tracer.Trace ("Check alire:");
 
          if Project.Is_Empty then
 
-            LSP.Ada_Handlers.Alire.Determine_Alire_Project
-              (Root        => Root (Self).Display_Full_Name,
+            LSP.Alire.Determine_Alire_Project
+              (Root        => Self.Client.Root_Directory.Display_Full_Name,
                Has_Alire   => Has_Alire,
                Error       => Errors,
                Project     => Project);
 
             Status := Alire_Project;
          end if;
 
-         LSP.Ada_Handlers.Alire.Setup_Alire_Env
-            (Root        => Root (Self).Display_Full_Name,
+         LSP.Alire.Setup_Alire_Env
+            (Root        => Self.Client.Root_Directory.Display_Full_Name,
             Has_Alire   => Has_Alire,
             Error       => Errors,
             Environment => Environment);
@@ -628,23 +619,6 @@ package body LSP.Ada_Handlers.Project_Loading is
       end if;
    end Reload_Project;
 
-   ----------
-   -- Root --
-   ----------
-
-   function Root
-     (Self : Message_Handler'Class) return GNATCOLL.VFS.Virtual_File
-   is
-      Value : constant VSS.Strings.Virtual_String := Self.Client.Root;
-      Root  : constant String :=
-        VSS.Strings.Conversions.To_UTF_8_String (Value);
-   begin
-      return GNATCOLL.VFS.Create_From_UTF8
-        (if Value.Starts_With ("file://")
-         then URIs.Conversions.To_File (Root, True)
-         else Root);
-   end Root;
-
    ---------------------------------------
    -- Update_Project_Predefined_Sources --
    ---------------------------------------

source/ada/lsp-ada_handlers-alire.adb renamed to source/ada/lsp-alire.adb

@@ -17,6 +17,7 @@
 
 with Ada.Streams;
 with GNAT.OS_Lib;
+with GNATCOLL.VFS;
 
 with VSS.Stream_Element_Vectors;
 with VSS.Strings.Conversions;
@@ -25,12 +26,13 @@ with VSS.String_Vectors;
 with VSS.Characters.Latin;
 with VSS.Regular_Expressions;
 
+with Spawn.Environments;
 with Spawn.Processes;
 with Spawn.Processes.Monitor_Loop;
 with Spawn.Process_Listeners;
 with Spawn.String_Vectors;
 
-package body LSP.Ada_Handlers.Alire is
+package body LSP.Alire is
 
    type Process_Listener is limited
      new Spawn.Process_Listeners.Process_Listener with record
@@ -347,4 +349,20 @@ package body LSP.Ada_Handlers.Alire is
       end loop;
    end Standard_Output_Available;
 
-end LSP.Ada_Handlers.Alire;
+   ------------------
+   -- Alire_Active --
+   ------------------
+
+   function Alire_Active
+     (Client : LSP.Ada_Client_Capabilities.Client_Capability) return Boolean is
+      Alire_TOML  : constant GNATCOLL.VFS.Virtual_File :=
+                      (if Client.Root.Is_Empty then GNATCOLL.VFS.No_File
+                       else Client.Root_Directory.Create_From_Dir
+                         ("alire.toml"));
+
+   begin
+      return Alire_TOML.Is_Regular_File
+        and Spawn.Environments.System_Environment.Value ("ALIRE") /= "True";
+   end Alire_Active;
+
+end LSP.Alire;

source/ada/lsp-ada_handlers-alire.ads renamed to source/ada/lsp-alire.ads

@@ -19,10 +19,16 @@
 
 with GPR2.Environment;
 
+with LSP.Ada_Client_Capabilities;
+
 with VSS.Strings;
 
 private
-package LSP.Ada_Handlers.Alire is
+package LSP.Alire is
+
+   function Alire_Active
+     (Client : LSP.Ada_Client_Capabilities.Client_Capability) return Boolean;
+   --  True if 'alire.toml' exists at 'Client' root & $ALIRE variable is True
 
    procedure Determine_Alire_Project
      (Root        : String;
@@ -39,4 +45,4 @@ package LSP.Ada_Handlers.Alire is
       Environment : in out GPR2.Environment.Object);
    --  Run `alr printenv` and set up the obtained environment variables
 
-end LSP.Ada_Handlers.Alire;
+end LSP.Alire;

source/ada/lsp-utils.ads

@@ -131,4 +131,9 @@ package LSP.Utils is
      (VSS.Strings.Conversions.To_Virtual_String (Value.Display_Full_Name));
    --  Cast Virtual_File to Virtual_String
 
+   function To_Virtual_String
+     (Path : GPR2.Path_Name.Object) return VSS.Strings.Virtual_String is
+     (VSS.Strings.Conversions.To_Virtual_String (Path.Value));
+   --  Cast GPR2.Path_Name.Object to Virtual_String
+
 end LSP.Utils;

source/gpr/lsp-gpr_client_capabilities.adb

@@ -104,7 +104,9 @@ package body LSP.GPR_Did_Change_Document is
 
       --  Load gpr tree & prepare diagnostics
 
-      Self.Document.Load (Self.Parent.Context.Get_Configuration);
+      Self.Document.Load
+        (Client        => Self.Parent.Context.Get_Client.all,
+         Configuration => Self.Parent.Context.Get_Configuration);
 
       --  Build GPR file for LSP needs.
 

source/gpr/lsp-gpr_client_capabilities.ads

@@ -150,6 +150,7 @@ package body LSP.GPR_Documents is
 
    procedure Load
      (Self          : in out Document;
+      Client        : LSP.Ada_Client_Capabilities.Client_Capability;
       Configuration : LSP.Ada_Configurations.Configuration) is
 
       procedure Update_Diagnostics;
@@ -186,7 +187,7 @@ package body LSP.GPR_Documents is
          Context           => Configuration.Context,
          Build_Path        => Configuration.Build_Path (Self.File),
          File_Reader       => Self.File_Provider.Get_File_Reader,
-         Environment       => Self.Environment);
+         Environment       => LSP.GPR_Files.Environment);
 
       Update_Diagnostics;