UB25-027: Add a custom request to list source directories

Allowing the extension to query them in order to add them to the workspace
if not already present.

This allows to search for files that come from imported projects that might
not be under the workspace root directory.

This works only for importing non-externally built source directories
for the moment.

Author: AnthonyLeonardoGracio

doc/source_dirs.md

@@ -0,0 +1,26 @@
+# Source dirs
+
+## Short introduction
+
+This is a custom request used by the VS Code extension to retrieve the project's source directories, allowing to add missing directories in the workspace when needed.
+
+## Change description
+
+We introduce three new types to represent the request parameters and results:
+
+```typescript
+
+interface ALS_Unit_Description {
+   name       : string; /* The source directory's name in VS Code */
+   uri : DocumentUri;   /* The source directory's uri */
+}
+```
+
+And a new request:
+
+  method: `workspace/alsSourceDirs`
+  params: null
+
+Returning the source directories of the loaded project like this:
+
+  result: `ALS_Source_Dir_Description[]`

integration/vscode/ada/src/extension.ts

@@ -24,12 +24,12 @@ import {
     ServerOptions,
 } from 'vscode-languageclient/node';
 import * as process from 'process';
-
 import GPRTaskProvider from './gprTaskProvider';
 import cleanTaskProvider from './cleanTaskProvider';
 import gnatproveTaskProvider from './gnatproveTaskProvider';
 import { alsCommandExecutor } from './alsExecuteCommand';
 import { ALSClientFeatures } from './alsClientFeatures';
+import { string } from 'fp-ts';
 
 let alsTaskProvider: vscode.Disposable[] = [
     vscode.tasks.registerTaskProvider(GPRTaskProvider.gprBuildType, new GPRTaskProvider()),
@@ -125,6 +125,60 @@ export function activate(context: vscode.ExtensionContext): void {
 
     context.subscriptions.push(vscode.workspace.onDidChangeConfiguration(configChanged));
     context.subscriptions.push(vscode.commands.registerCommand('ada.otherFile', otherFileHandler));
+
+    //  Check if we need to add some source directories to the workspace (e.g: when imported projects'
+    //  source directories are not placed under the root project's directory).
+    client.onReady().then(() => {
+        client.sendRequest("workspace/alsSourceDirs").then(
+            data => {
+                const source_dirs = JSON.parse(JSON.stringify(data));
+                const workspace_folders = vscode.workspace.workspaceFolders ?? []
+                let workspace_dirs_to_add: { uri: vscode.Uri, name?: string | undefined}[] = []
+
+                for (var source_dir of source_dirs) {
+                    const source_dir_uri = vscode.Uri.parse(source_dir.uri)
+                    let source_dir_path = source_dir_uri.path
+                    let workspace_folder_path = workspace_folders[0].uri.path
+
+                    function is_subdirectory(dir: string, parent: string) {
+                        //  Use lower-case on Windows since drives can be specified in VS Code either
+                        //  with lower or upper case characters.
+                        if (process.platform == "win32") {
+                            dir = dir.toLowerCase();
+                            parent = parent.toLowerCase();
+                        }
+
+                        return dir.startsWith(parent + '/');
+
+                    }
+
+                    //  If the source directory is not under one of the workspace folders, push this
+                    //  source directory to the workspace folders to add later.
+                    if (!workspace_folders.some(workspace_folder =>
+                        is_subdirectory(source_dir_path, workspace_folder.uri.path))) {
+                        workspace_dirs_to_add.push({name: source_dir.name, uri: source_dir_uri});
+                    }
+                }
+
+                //  If there are some source directories missing in the workspace, ask the user
+                //  to add them in his workspace.
+                if (workspace_dirs_to_add.length > 0) {
+                    vscode.window
+                        .showInformationMessage("Some project source directories are not "
+                            + "listed in your workspace: do you want to add them?", "Yes", "No")
+                        .then(answer => {
+                            if (answer === "Yes") {
+                                for (var workspace_dir of workspace_dirs_to_add) {
+                                  vscode.workspace.updateWorkspaceFolders(
+                                        vscode.workspace.workspaceFolders ? vscode.workspace.workspaceFolders.length : 0, null,
+                                        workspace_dir);
+                                    }
+                            }
+                        })
+                }
+            }
+        )
+    })
 }
 
 export function deactivate(): void {

scripts/generate.py

@@ -322,6 +322,9 @@
     ('textDocument/alsShowDependencies', 'ALS_Show_Dependencies',
      'ALS_ShowDependenciesParams',
      'ALS_ShowDependencies_Response'),
+    ('workspace/alsSourceDirs', 'ALS_Source_Dirs',
+     None,
+     'ALS_SourceDirs_Response'),
     ('$/alsDebug', 'ALS_Debug', 'ALSDebugParams', 'ALS_Debug_Response'),
     ('$/alsCheckSyntax', 'ALS_Check_Syntax', 'ALS_Check_Syntax_Params',
      'ALS_Check_Syntax_Response'),

source/ada/lsp-ada_context_sets.adb

@@ -158,12 +158,16 @@ package body LSP.Ada_Context_Sets is
    ----------------------------
 
    function All_Source_Directories
-     (Self : Context_Set'Class) return GNATCOLL.VFS.File_Array
+     (Self                     : Context_Set'Class;
+      Include_Externally_Built : Boolean := False)
+      return GNATCOLL.VFS.File_Array
    is
       Consolidated_Set : LSP.Ada_File_Sets.File_Sets.Set;
    begin
       for C of Self.Contexts loop
-         Consolidated_Set.Union (C.List_Source_Directories);
+         Consolidated_Set.Union
+           (C.List_Source_Directories
+              (Include_Externally_Built => Include_Externally_Built));
       end loop;
 
       declare

source/ada/lsp-ada_context_sets.ads

@@ -59,10 +59,13 @@ package LSP.Ada_Context_Sets is
    --  Number of files in all contexts
 
    function All_Source_Directories
-     (Self : Context_Set'Class) return GNATCOLL.VFS.File_Array;
-   --  Return the list of all source directories for writable projects
-   --  in the context (ie, excluding externally-built projects). Each
-   --  dirctory is present only once in the resulting array.
+     (Self                     : Context_Set'Class;
+      Include_Externally_Built : Boolean := False)
+      return GNATCOLL.VFS.File_Array;
+   --  Return the list of all source directories for writable projects in the
+   --  context, including externally built projects' source directories when
+   --  Include_Externally_Built is set to True.
+   --  Each dirctory is present only once in the resulting array.
 
    procedure Cleanup (Self : in out Context_Set'Class);
    --  Free memory referenced by Self

source/ada/lsp-ada_contexts.adb

@@ -237,9 +237,15 @@ package body LSP.Ada_Contexts is
    -----------------------------
 
    function List_Source_Directories
-     (Self : Context) return LSP.Ada_File_Sets.File_Sets.Set is
+     (Self                     : Context;
+      Include_Externally_Built : Boolean := False)
+      return LSP.Ada_File_Sets.File_Sets.Set is
    begin
-      return Self.Source_Dirs;
+      if Include_Externally_Built then
+         return Self.External_Source_Dirs;
+      else
+         return Self.Source_Dirs;
+      end if;
    end List_Source_Directories;
 
    -------------------------
@@ -651,13 +657,23 @@ package body LSP.Ada_Contexts is
          end loop;
 
          Self.Source_Dirs.Clear;
+         Self.External_Source_Dirs.Clear;
+
          for Dir of Source_Dirs
            (Project                  => Root,
             Recursive                => True,
             Include_Externally_Built => False)
          loop
             Self.Source_Dirs.Include (Dir);
          end loop;
+
+         for Dir of Source_Dirs
+           (Project                  => Root,
+            Recursive                => True,
+            Include_Externally_Built => True)
+         loop
+            Self.External_Source_Dirs.Include (Dir);
+         end loop;
       end Update_Source_Files;
 
       --------------------------

source/ada/lsp-ada_contexts.ads

@@ -196,8 +196,11 @@ package LSP.Ada_Contexts is
    --  Return the analysis units for all Ada sources known to this context
 
    function List_Source_Directories
-     (Self : Context) return LSP.Ada_File_Sets.File_Sets.Set;
-   --  List the source directories in non-externally-built projects
+     (Self                     : Context;
+      Include_Externally_Built : Boolean := False)
+      return LSP.Ada_File_Sets.File_Sets.Set;
+   --  List the source directories, including externally built projects' source
+   --  directories when Include_Externally_Built is set to True.
 
    function Get_AU
      (Self    : Context;
@@ -298,6 +301,9 @@ private
       --  All the source dirs in the loaded project, not including
       --  the externally built projects
 
+      External_Source_Dirs : LSP.Ada_File_Sets.File_Sets.Set;
+      --  All the source dirs coming from externally built projects
+
       PP_Options : Utils.Command_Lines.Command_Line
                     (Pp.Command_Lines.Descriptor'Access);
       --  Object to keep gnatpp options

source/ada/lsp-ada_handlers.adb

@@ -3098,9 +3098,40 @@ package body LSP.Ada_Handlers is
       return Response;
    end On_References_Request;
 
-   ----------------------------------
+   --------------------------------
+   -- On_ALS_Source_Dirs_Request --
+   --------------------------------
+
+   overriding function On_ALS_Source_Dirs_Request
+     (Self    : access Message_Handler;
+      Request : LSP.Messages.Server_Requests.ALS_Source_Dirs_Request)
+      return LSP.Messages.Server_Responses.ALS_SourceDirs_Response
+   is
+      Response : LSP.Messages.Server_Responses.ALS_SourceDirs_Response
+        (Is_Error => False);
+      Unit_Desc : LSP.Messages.ALS_Source_Dir_Description;
+      Source_Dirs : constant GNATCOLL.VFS.File_Array :=
+        Self.Contexts.All_Source_Directories
+          (Include_Externally_Built => True);
+   begin
+      for Dir of Source_Dirs loop
+         Unit_Desc :=
+           (name => VSS.Strings.Conversions.To_Virtual_String
+              (+Dir.Base_Dir_Name),
+            uri  =>
+              File_To_URI (Dir.Display_Full_Name));
+         Response.result.Append (Unit_Desc);
+      end loop;
+
+      Self.Trace.Trace
+        ("Response.result.length: " & Response.result.Length'Img);
+
+      return Response;
+   end On_ALS_Source_Dirs_Request;
+
+   --------------------------------------
    -- On_ALS_Show_Dependencies_Request --
-   ----------------------------------
+   --------------------------------------
 
    overriding function On_ALS_Show_Dependencies_Request
      (Self    : access Message_Handler;

source/ada/lsp-ada_handlers.ads

@@ -526,6 +526,11 @@ private
       Request : LSP.Messages.Server_Requests.ALS_Show_Dependencies_Request)
       return LSP.Messages.Server_Responses.ALS_ShowDependencies_Response;
 
+   overriding function On_ALS_Source_Dirs_Request
+     (Self    : access Message_Handler;
+      Request : LSP.Messages.Server_Requests.ALS_Source_Dirs_Request)
+      return LSP.Messages.Server_Responses.ALS_SourceDirs_Response;
+
    overriding function On_ALS_Debug_Request
      (Self    : access Message_Handler;
       Request : LSP.Messages.Server_Requests.ALS_Debug_Request)

source/ada/lsp-error_decorators.adb

@@ -626,6 +626,26 @@ package body LSP.Error_Decorators is
       return LSP.Messages.Server_Responses.ALS_ShowDependencies_Response
       renames ALS_Show_Dependencies_Request;
 
+   -----------------------------
+   -- ALS_Source_Dirs_Request --
+   -----------------------------
+
+   function ALS_Source_Dirs_Request is new Generic_Request
+     (Request    =>
+         LSP.Messages.Server_Requests.ALS_Source_Dirs_Request,
+      Response   =>
+         LSP.Messages.Server_Responses.ALS_SourceDirs_Response,
+      Handler    =>
+         LSP.Server_Request_Handlers.Server_Request_Handler,
+      On_Request =>
+         LSP.Server_Request_Handlers.On_ALS_Source_Dirs_Request);
+
+   overriding function On_ALS_Source_Dirs_Request
+     (Self    : access Error_Decorator;
+      Request : LSP.Messages.Server_Requests.ALS_Source_Dirs_Request)
+      return LSP.Messages.Server_Responses.ALS_SourceDirs_Response
+      renames ALS_Source_Dirs_Request;
+
    --------------------------
    -- On_ALS_Debug_Request --
    --------------------------