Implements hover request for package & attributes.

Philippe Gil · Philippe Gil · commit 54a8b511bb6c · 2023-10-23T16:21:06.000Z
Part of #1186
diff --git a/source/gpr/lsp-gpr_documentation.adb b/source/gpr/lsp-gpr_documentation.adb
@@ -0,0 +1,64 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                     Copyright (C) 2023, 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 Ada.Characters.Conversions;
+
+with Gpr_Parser.Common;
+
+with GPR2.Project.Registry.Attribute.Description;
+with GPR2.Project.Registry.Pack.Description;
+with VSS.Strings.Conversions;
+
+package body LSP.GPR_Documentation is
+
+   procedure Get_Tooltip_Text
+     (Self         : LSP.GPR_Files.File;
+      Position     : LSP.Structures.Position;
+      Tooltip_Text : out VSS.Strings.Virtual_String) is
+      use Gpr_Parser.Common;
+
+      Token  : constant Token_Reference := Self.Token (Position);
+
+      use GPR2.Project.Registry.Attribute.Description;
+      use GPR2.Project.Registry.Pack.Description;
+      use GPR2;
+      use Ada.Characters.Conversions;
+   begin
+
+      Tooltip_Text.Clear;
+
+      if Token.Data.Kind = Gpr_Identifier then
+         case Token.Previous (Exclude_Trivia => True).Data.Kind is
+            when Gpr_Package | Gpr_End =>
+               Tooltip_Text.Append
+                 (VSS.Strings.Conversions.To_Virtual_String
+                    (Get_Package_Description (Self.Get_Package (Position))));
+
+            when Gpr_For =>
+               Tooltip_Text.Append
+                 (VSS.Strings.Conversions.To_Virtual_String
+                    (Get_Attribute_Description ((
+                     Self.Get_Package (Position),
+                     +(Optional_Name_Type (To_String (Token.Text)))))));
+
+            when others =>
+               null;
+         end case;
+      end if;
+   end Get_Tooltip_Text;
+
+end LSP.GPR_Documentation;
diff --git a/source/gpr/lsp-gpr_documentation.ads b/source/gpr/lsp-gpr_documentation.ads
@@ -0,0 +1,34 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                     Copyright (C) 2023, 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.                                                          --
+------------------------------------------------------------------------------
+
+--  Subprogram to obtain documentation for packages & attributes.
+
+with LSP.GPR_Files;
+with LSP.Structures;
+
+with VSS.Strings;
+
+package LSP.GPR_Documentation is
+
+   procedure Get_Tooltip_Text
+     (Self         : LSP.GPR_Files.File;
+      Position     : LSP.Structures.Position;
+      Tooltip_Text : out VSS.Strings.Virtual_String);
+   --  Get all the information needed to produce tooltips (hover and completion
+   --  requests)
+
+end LSP.GPR_Documentation;
diff --git a/source/gpr/lsp-gpr_files.adb b/source/gpr/lsp-gpr_files.adb
@@ -47,6 +47,34 @@ package body LSP.GPR_Files is
    package Convert is new VSS.Strings.Formatters.Generic_Integers (Unit_Index);
    package Conversions renames VSS.Strings.Conversions;
 
+   function Is_Between
+     (Position : LSP.Structures.Position;
+      Span     : LSP.Structures.A_Range)
+            return Boolean
+   is ((Position.line = Span.start.line
+       and then Position.character >= Span.start.character)
+       or else (Position.line = Span.an_end.line
+         and then Position.character <= Span.an_end.character)
+       or else (Position.line > Span.start.line
+         and then Position.line < Span.an_end.line));
+   --  Checks if Position is inside Span
+
+   -----------------
+   -- Get_Package --
+   -----------------
+
+   function Get_Package
+     (Self : File; Position : LSP.Structures.Position) return GPR2.Package_Id
+   is
+   begin
+      for P of Self.Packages loop
+         if Is_Between (Position, P.Package_Range) then
+            return P.Name;
+         end if;
+      end loop;
+      return GPR2.Project_Level_Scope;
+   end Get_Package;
+
    --------
    -- Id --
    --------
@@ -315,6 +343,26 @@ package body LSP.GPR_Files is
       begin
          if Current_Package.Name /= Project_Level_Scope then
             Current_Package.Last := Last_Index;
+
+            --  Initialize Package_Range
+
+            declare
+               Location_Range : Slocs.Source_Location_Range :=
+                 Gpr_Parser.Common.Sloc_Range
+                   (Gpr_Parser.Common.Data (Current_Package.First));
+            begin
+               Current_Package.Package_Range.start.line :=
+                 To_Position_Value (Location_Range.Start_Line);
+               Current_Package.Package_Range.start.character :=
+                 To_Position_Value (Location_Range.Start_Column);
+               Location_Range := Gpr_Parser.Common.Sloc_Range
+                 (Gpr_Parser.Common.Data (Current_Package.Last));
+               Current_Package.Package_Range.an_end.line :=
+                 To_Position_Value (Location_Range.Start_Line);
+               Current_Package.Package_Range.an_end.character :=
+                 To_Position_Value (Location_Range.Start_Column);
+            end;
+
             if not File.Packages.Contains (Current_Package.Name) then
                File.Packages.Insert (Current_Package.Name, Current_Package);
             end if;
@@ -981,4 +1029,21 @@ package body LSP.GPR_Files is
       end if;
    end Cleanup;
 
+   -----------
+   -- Token --
+   -----------
+
+   function Token
+     (Self     : File;
+      Position : LSP.Structures.Position)
+      return Gpr_Parser.Common.Token_Reference is
+      Sloc : constant Source_Location :=
+        (To_Line_Number (Position.line),
+         To_Column_Number (Position.character));
+
+   begin
+      return Self.Unit.Lookup_Token (Sloc);
+
+   end Token;
+
 end LSP.GPR_Files;
diff --git a/source/gpr/lsp-gpr_files.ads b/source/gpr/lsp-gpr_files.ads
@@ -42,6 +42,7 @@ with VSS.Strings;
 with VSS.Strings.Hash;
 with VSS.String_Vectors;
 
+with LSP.Structures;
 with LSP.Tracers;
 
 package LSP.GPR_Files is
@@ -104,6 +105,44 @@ package LSP.GPR_Files is
       Path : GPR2.Path_Name.Object) return File_Access;
    --  parse file if not yet parsed
 
+   function Get_Package
+     (Self : File; Position : LSP.Structures.Position) return GPR2.Package_Id;
+   --  return the Position's Package_Id. Returns Project_Level_Scope if
+   --  Position not inside a package.
+
+   function Token
+     (Self     : File;
+      Position : LSP.Structures.Position)
+      return Gpr_Parser.Common.Token_Reference;
+   --  Return File's Token at Position.
+
+   -------------------------------------------------
+   -- GPR Parser / LSP Slocs-Position conversions --
+   -------------------------------------------------
+
+   use Gpr_Parser_Support.Slocs;
+
+   function To_Position_Value
+     (Line : Gpr_Parser_Support.Slocs.Line_Number) return Natural is
+     (if Line = 0 then 0 else Natural (Line) - 1);
+
+   function To_Line_Number
+     (Line : Natural) return Gpr_Parser_Support.Slocs.Line_Number is
+     (Gpr_Parser_Support.Slocs.Line_Number (Line + 1));
+
+   function To_Position_Value
+     (Column : Gpr_Parser_Support.Slocs.Column_Number) return Natural is
+     (if Column = 0 then 0 else Natural (Column) - 1);
+
+   function To_Column_Number
+     (Line : Natural) return Gpr_Parser_Support.Slocs.Column_Number is
+     (Gpr_Parser_Support.Slocs.Column_Number (Line + 1));
+
+   function To_Position
+     (Location : Gpr_Parser_Support.Slocs.Source_Location)
+      return LSP.Structures.Position is
+     (To_Position_Value (Location.Line), To_Position_Value (Location.Column));
+
 private
 
    use GPR2;
@@ -311,6 +350,9 @@ private
                              Gpr_Parser.Common.No_Token;
       --  'Last' is at the package's end or at the end of the renaming.
 
+      Package_Range    : LSP.Structures.A_Range := ((0, 0), (0, 0));
+      --  Useful to find to what package a LSP Position belongs.
+
       Attributes         : Attribute_Maps.Map;
       --  Attributes defined in the package
 
diff --git a/source/gpr/lsp-gpr_handlers.adb b/source/gpr/lsp-gpr_handlers.adb
@@ -28,6 +28,7 @@ with GPR2.Source_Reference;
 with LSP.Constants;
 with LSP.Enumerations;
 with LSP.Generic_Cancel_Check;
+with LSP.GPR_Documentation;
 with LSP.GPR_File_Readers;
 with LSP.GPR_Files.Symbols;
 with LSP.Servers;
@@ -424,6 +425,60 @@ package body LSP.GPR_Handlers is
       Self.Sender.On_DocumentSymbol_Response (Id, Response);
    end On_DocumentSymbol_Request;
 
+   ----------------------
+   -- On_Hover_Request --
+   ----------------------
+
+   overriding procedure On_Hover_Request
+     (Self  : in out Message_Handler;
+      Id    : LSP.Structures.Integer_Or_Virtual_String;
+      Value : LSP.Structures.HoverParams)
+   is
+
+      Response : LSP.Structures.Hover_Or_Null;
+
+      procedure Compute_Response;
+
+      ----------------------
+      -- Compute_Response --
+      ----------------------
+
+      procedure Compute_Response is
+         File         : constant LSP.GPR_Files.File_Access :=
+                           LSP.GPR_Files.Parse
+                             (File_Provider => Self'Unchecked_Access,
+                              Path          => Self.To_File
+                                                 (Value.textDocument.uri));
+         Tooltip_Text : VSS.Strings.Virtual_String;
+      begin
+
+         LSP.GPR_Documentation.Get_Tooltip_Text
+           (Self         => File.all,
+            Position     => Value.position,
+            Tooltip_Text => Tooltip_Text);
+
+         if Tooltip_Text.Is_Empty then
+            return;
+         end if;
+
+         Response := (Is_Null => False, others => <>);
+         Response.Value.contents := (Is_MarkupContent => False, others => <>);
+
+         --  Append the package/attribute description
+
+         Response.Value.contents.MarkedString_Vector.Append
+           (LSP.Structures.MarkedString'
+              (Is_Virtual_String => False,
+               language          => "plaintext",
+               value             => Tooltip_Text));
+
+      end Compute_Response;
+
+   begin
+      Compute_Response;
+      Self.Sender.On_Hover_Response (Id, Response);
+   end On_Hover_Request;
+
    ---------------------------
    -- On_Initialize_Request --
    ---------------------------
diff --git a/source/gpr/lsp-gpr_handlers.ads b/source/gpr/lsp-gpr_handlers.ads
@@ -141,6 +141,11 @@ private
      (Self  : in out Message_Handler;
       Value : LSP.Structures.DidOpenTextDocumentParams);
 
+   overriding procedure On_Hover_Request
+     (Self  : in out Message_Handler;
+      Id    : LSP.Structures.Integer_Or_Virtual_String;
+      Value : LSP.Structures.HoverParams);
+
    -----------------------------------------
    -- LSP.GPR_Documents.Document_Provider --
    -----------------------------------------
diff --git a/testsuite/gpr_lsp/hover/prj1.gpr b/testsuite/gpr_lsp/hover/prj1.gpr
@@ -0,0 +1,6 @@
+project Prj1 is
+for Source_Dirs use ("src");
+package Compiler is
+for Switches ("Ada") use ();
+end Compiler;
+end Prj1;
diff --git a/testsuite/gpr_lsp/hover/prj2.gpr b/testsuite/gpr_lsp/hover/prj2.gpr
@@ -0,0 +1,4 @@
+project Prj2 is
+for Source_Dirs use ("src");
+--  The list of source directories of the project.
+end Prj2;
diff --git a/testsuite/gpr_lsp/hover/test.json b/testsuite/gpr_lsp/hover/test.json
diff --git a/testsuite/gpr_lsp/hover/test.yaml b/testsuite/gpr_lsp/hover/test.yaml
