Add --config option to specify a server configuration

This allows to setup the server with the wanted configuration
at startup, without having to speicify them via the 'initialize'
or the 'didChangeConfiguration' requests

Closes #1108

Author: AnthonyLeonardoGracio

README.md

@@ -91,6 +91,7 @@ The `ada_language_server` doesn't require any command line options,
 but it understands these options:
 
 * `--tracefile=<FILE>` - Full path to a file containing traces configuration
+* `--config=<FILE>` - Full path to a JSON file containing the server's configuration
 * `--help` - Display supported command like options and exit.
 
 You can turn some debugging and experimental features trought
@@ -99,7 +100,9 @@ You can turn some debugging and experimental features trought
 The server also gets configuration via `workspace/didChangeConfiguration`
 notification and `initializationOptions` of `initialize` request.
 See more [details here](doc/settings.md). Each LSP
-client provides its-own way to set such settings.
+client provides its-own way to set such settings. You can use the `--config`
+option if you want to provide the configuration directly via a JSON file
+instead of specifying it via the requests listed just above.
 
 ## Supported LSP Server Requests
 

source/ada/lsp-ada_driver.adb

@@ -20,6 +20,7 @@
 with Ada.Characters.Latin_1;
 with Ada.Text_IO;
 with Ada.Exceptions;          use Ada.Exceptions;
+with Ada.Strings.Unbounded;
 with GNAT.Command_Line;       use GNAT.Command_Line;
 with GNAT.Traceback.Symbolic; use GNAT.Traceback.Symbolic;
 with GNAT.OS_Lib;
@@ -33,9 +34,11 @@ with VSS.Application;
 with VSS.Standard_Paths;
 with VSS.Strings.Conversions;
 
+with GNATCOLL.JSON;
 with GNATCOLL.Memory;         use GNATCOLL.Memory;
 with GNATCOLL.Traces;         use GNATCOLL.Traces;
 with GNATCOLL.VFS;            use GNATCOLL.VFS;
+with GNATCOLL.Utils;
 
 with LSP.Ada_Handlers;
 with LSP.Ada_Handlers.Named_Parameters_Commands;
@@ -195,7 +198,9 @@ procedure LSP.Ada_Driver is
    GNATdebug              : constant Virtual_File := Create_From_Base
      (".gnatdebug");
 
-   Tracefile_Name         : aliased String_Access;
+   Traces_File_Path       : aliased String_Access;
+   Config_File_Path       : aliased String_Access;
+   Traces_File            : Virtual_File;
    Config_File            : Virtual_File;
    Help_Arg               : aliased Boolean := False;
    Version_Arg            : aliased Boolean := False;
@@ -210,10 +215,18 @@ begin
 
    Define_Switch
      (Cmdline,
-      Output      => Tracefile_Name'Access,
+      Output      => Traces_File_Path'Access,
       Long_Switch => "--tracefile=",
       Help        => "Full path to a file containing traces configuration");
 
+   Define_Switch
+     (Cmdline,
+      Output      => Config_File_Path'Access,
+      Long_Switch => "--config=",
+      Help        => "Full path to a JSON file containing initialization "
+      & "options for the server (i.e: all the settings that can be specified "
+      & "through LSP 'initialize' request's initializattionOptions)");
+
    Define_Switch
      (Cmdline,
       Output      => Language_GPR_Arg'Access,
@@ -251,15 +264,15 @@ begin
    --     - passed on the command line via --tracefile,
    --     - in a .gnatdebug file locally
    --     - in "traces.cfg" in the ALS home directory
-   if Tracefile_Name /= null
-     and then Tracefile_Name.all /= ""
+   if Traces_File_Path /= null
+     and then Traces_File_Path.all /= ""
    then
-      Config_File := Create (+Tracefile_Name.all);
-      if not Config_File.Is_Regular_File then
+      Traces_File := Create (+Traces_File_Path.all);
+      if not Traces_File.Is_Regular_File then
          Ada.Text_IO.Put_Line ("Could not find the specified traces file");
          GNAT.OS_Lib.OS_Exit (1);
       end if;
-      Parse_Config_File (Config_File);
+      Parse_Config_File (Traces_File);
 
    elsif GNATdebug.Is_Regular_File then
       Parse_Config_File (GNATdebug);
@@ -276,8 +289,46 @@ begin
            ".$T.$$.log:buffer_size=0");
    end if;
 
-   if Tracefile_Name /= null then
-      Free (Tracefile_Name);
+   if Traces_File_Path /= null then
+      Free (Traces_File_Path);
+   end if;
+
+   --  Look for a config file, that contains the configuration for the server
+   --  (i.e: the configuration that can be specified through the 'initialize'
+   --  request initializationOptions).
+
+   if Config_File_Path /= null
+     and then Config_File_Path.all /= ""
+   then
+      Config_File := Create (+Config_File_Path.all);
+
+      if not Config_File.Is_Regular_File then
+         Ada.Text_IO.Put_Line ("Could not find the specified config file");
+         GNAT.OS_Lib.OS_Exit (1);
+      end if;
+
+      declare
+         JSON_Contents : GNAT.Strings.String_Access := Config_File.Read_File;
+         Parse_Result  : GNATCOLL.JSON.Read_Result;
+      begin
+         Parse_Result := GNATCOLL.JSON.Read (JSON_Contents.all);
+         GNAT.Strings.Free (JSON_Contents);
+
+         if not Parse_Result.Success then
+            Ada.Text_IO.Put_Line
+              ("Error when parsing config file at "
+               & GNATCOLL.Utils.Image (Parse_Result.Error.Line, 1)
+               & ":"
+               & GNATCOLL.Utils.Image (Parse_Result.Error.Column, 1));
+            Ada.Text_IO.Put_Line
+              (Ada.Strings.Unbounded.To_String (Parse_Result.Error.Message));
+            GNAT.OS_Lib.OS_Exit (1);
+         end if;
+
+         Ada_Handler.Change_Configuration (Parse_Result.Value);
+      end;
+
+      Free (Config_File_Path);
    end if;
 
    Server_Trace.Trace ("ALS version: " & $VERSION);

source/ada/lsp-ada_handlers.adb

@@ -28,7 +28,6 @@ with Ada.Unchecked_Deallocation;
 
 with GNAT.OS_Lib; use GNAT.OS_Lib;
 with GNAT.Strings;
-with GNATCOLL.JSON;
 with GNATCOLL.Utils;             use GNATCOLL.Utils;
 
 with VSS.Characters.Latin;
@@ -319,11 +318,6 @@ package body LSP.Ada_Handlers is
    --  Attempt to load the given project file, with the scenario provided.
    --  This unloads all currently loaded project contexts.
 
-   procedure Change_Configuration
-     (Self  : access Message_Handler;
-      Ada   : LSP.Types.LSP_Any);
-   --  Change server configuration with settings from Ada JSON object.
-
    procedure Mark_Source_Files_For_Indexing (Self : access Message_Handler);
    --  Mark all sources in all projects for indexing. This factorizes code
    --  between Load_Project and Load_Implicit_Project.
@@ -4234,8 +4228,8 @@ package body LSP.Ada_Handlers is
    --------------------------
 
    procedure Change_Configuration
-     (Self  : access Message_Handler;
-      Ada   : LSP.Types.LSP_Any)
+     (Self    : access Message_Handler;
+      Options : GNATCOLL.JSON.JSON_Value'Class)
    is
       use type GNATCOLL.JSON.JSON_Value_Type;
 
@@ -4275,9 +4269,9 @@ package body LSP.Ada_Handlers is
       Variables : Scenario_Variable_List;
 
       function Property (Name : String) return VSS.Strings.Virtual_String is
-        (if Ada.Has_Field (Name)
+        (if Options.Has_Field (Name)
          then VSS.Strings.Conversions.To_Virtual_String
-           (String'(Get (Get (Ada, Name))))
+           (String'(Options.Get (Name)))
          else VSS.Strings.Empty_Virtual_String);
 
       ------------------
@@ -4309,7 +4303,7 @@ package body LSP.Ada_Handlers is
                    Value.dynamicRegistration.Is_Set = True;
 
    begin
-      if Ada.Kind = GNATCOLL.JSON.JSON_Object_Type then
+      if Options.Kind = GNATCOLL.JSON.JSON_Object_Type then
          Relocate := Property (relocateBuildTree);
          Root := Property (rootDir);
          Charset := Property (defaultCharset);
@@ -4320,76 +4314,80 @@ package body LSP.Ada_Handlers is
             File := Self.URI_To_File (File);
          end if;
 
-         if Ada.Has_Field (scenarioVariables) and then
-           Ada.Get (scenarioVariables).Kind  = GNATCOLL.JSON.JSON_Object_Type
+         if Options.Has_Field (scenarioVariables) and then
+           Options.Get
+             (scenarioVariables).Kind  = GNATCOLL.JSON.JSON_Object_Type
          then
-            Ada.Get (scenarioVariables).Map_JSON_Object (Add_Variable'Access);
+            Options.Get
+              (scenarioVariables).Map_JSON_Object (Add_Variable'Access);
          end if;
 
          --  It looks like the protocol does not allow clients to say whether
          --  or not they want diagnostics as part of
          --  InitializeParams.capabilities.textDocument. So we support
          --  deactivating of diagnostics via a setting here.
-         if Ada.Has_Field (enableDiagnostics) then
-            Self.Diagnostics_Enabled := Ada.Get (enableDiagnostics);
+         if Options.Has_Field (enableDiagnostics) then
+            Self.Diagnostics_Enabled := Options.Get (enableDiagnostics);
          end if;
 
          --  Similarly to diagnostics, we support selectively activating
          --  indexing in the parameters to this request.
-         if Ada.Has_Field (enableIndexing) then
-            Self.Indexing_Enabled := Ada.Get (enableIndexing);
+         if Options.Has_Field (enableIndexing) then
+            Self.Indexing_Enabled := Options.Get (enableIndexing);
          end if;
 
          --  Retrieve the different textDocument/rename options if specified
 
-         if Ada.Has_Field (renameInComments) then
+         if Options.Has_Field (renameInComments) then
             Self.Options.Refactoring.Renaming.In_Comments :=
-              Ada.Get (renameInComments);
+              Options.Get (renameInComments);
          end if;
 
-         if Ada.Has_Field (foldComments) then
-            Self.Options.Folding.Comments := Ada.Get (foldComments);
+         if Options.Has_Field (foldComments) then
+            Self.Options.Folding.Comments := Options.Get (foldComments);
          end if;
 
          --  Retrieve the number of parameters / components at which point
          --  named notation is used for subprogram/aggregate completion
          --  snippets.
 
-         if Ada.Has_Field (namedNotationThreshold) then
-            Self.Named_Notation_Threshold := Ada.Get (namedNotationThreshold);
+         if Options.Has_Field (namedNotationThreshold) then
+            Self.Named_Notation_Threshold :=
+              Options.Get (namedNotationThreshold);
          end if;
 
-         if Ada.Has_Field (logThreshold) then
-            Self.Log_Threshold := Ada.Get (logThreshold);
+         if Options.Has_Field (logThreshold) then
+            Self.Log_Threshold := Options.Get (logThreshold);
          end if;
 
          --  Check the 'useCompletionSnippets' flag to see if we should use
          --  snippets in completion (if the client supports it).
          if not Self.Completion_Snippets_Enabled then
             Self.Use_Completion_Snippets := False;
-         elsif Ada.Has_Field (useCompletionSnippets) then
-            Self.Use_Completion_Snippets := Ada.Get (useCompletionSnippets);
+         elsif Options.Has_Field (useCompletionSnippets) then
+            Self.Use_Completion_Snippets :=
+              Options.Get (useCompletionSnippets);
          end if;
 
          --  Retrieve the policy for displaying type hierarchy on navigation
          --  requests.
-         if Ada.Has_Field (displayMethodAncestryOnNavigation) then
+         if Options.Has_Field (displayMethodAncestryOnNavigation) then
             Self.Display_Method_Ancestry_Policy :=
               LSP.Messages.AlsDisplayMethodAncestryOnNavigationPolicy'Value
-                (Ada.Get (displayMethodAncestryOnNavigation));
+                (Options.Get (displayMethodAncestryOnNavigation));
          end if;
 
          --  Retrieve the follow symlinks policy.
 
-         if Ada.Has_Field (followSymlinks) then
-            Self.Follow_Symlinks := Ada.Get (followSymlinks);
+         if Options.Has_Field (followSymlinks) then
+            Self.Follow_Symlinks := Options.Get (followSymlinks);
          end if;
 
-         if Ada.Has_Field (documentationStyle) then
+         if Options.Has_Field (documentationStyle) then
             begin
                Self.Options.Documentation.Style :=
                  GNATdoc.Comments.Options.Documentation_Style'Value
-                   (Ada.Get (documentationStyle));
+                   (Options.Get (documentationStyle));
 
             exception
                when Constraint_Error =>
@@ -4401,12 +4399,12 @@ package body LSP.Ada_Handlers is
 
       if not File.Is_Empty then
          Self.Load_Project
-           (File,
-            Variables,
-            Charset,
-            Valid_Project_Configured,
-            Relocate,
-            Root);
+           (Project_File        => File,
+            Scenario            => Variables,
+            Charset             => Charset,
+            Status              => Valid_Project_Configured,
+            Relocate_Build_Tree => Relocate,
+            Root_Dir            => Root);
       end if;
 
       Self.Ensure_Project_Loaded;

source/ada/lsp-ada_handlers.ads

@@ -21,6 +21,7 @@
 with Ada.Containers.Hashed_Maps;
 with Ada.Containers.Hashed_Sets;
 
+with GNATCOLL.JSON;
 with GNATCOLL.VFS;    use GNATCOLL.VFS;
 with GNATCOLL.Projects;
 with GNATCOLL.Traces;
@@ -63,6 +64,11 @@ package LSP.Ada_Handlers is
    --  This procedure will be called when an unexpected error is raised in the
    --  request processing loop.
 
+   procedure Change_Configuration
+     (Self    : access Message_Handler;
+      Options : GNATCOLL.JSON.JSON_Value'Class);
+   --  Change server configuration with settings from Ada JSON object.
+
    procedure Stop_File_Monitoring (Self : access Message_Handler);
 
    procedure Cleanup (Self : access Message_Handler);