gnatdoc_24.0.0_8cc57c73/source/gnatdoc-comments-helpers.adb

------------------------------------------------------------------------------
--                    GNAT Documentation Generation Tool                    --
--                                                                          --
--                     Copyright (C) 2022-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 Libadalang.Common;

with GNATdoc.Comments.Extractor;
with GNATdoc.Comments.Utilities;

package body GNATdoc.Comments.Helpers is

   use Libadalang.Analysis;
   use Libadalang.Common;
   use VSS.Strings;
   use VSS.String_Vectors;

   function Get_Plain_Text_Description
     (Section : not null Section_Access)
      return VSS.String_Vectors.Virtual_String_Vector;
   --  Return description as plain text.

   function Get_Plain_Text_Description
     (Documentation : Structured_Comment;
      Name          : Defining_Name'Class)
      return VSS.String_Vectors.Virtual_String_Vector;
   --  Return description as plain text. Name is the defining name of the
   --  documented entity.

   function Get_Plain_Text_Description
     (Documentation : Structured_Comment;
      Name          : Defining_Name'Class;
      Subname       : Defining_Name'Class)
      return VSS.String_Vectors.Virtual_String_Vector;
   --  Return description as plain text. Name and Subname are defining names
   --  of the documented entity. This hierarhy is used for generic declarations
   --  only (name is a name of the formal and subname is a name of the
   --  component depends from the kind of formal (name of parameter,
   --  discriminant, etc.)).

   --------------------------
   -- Get_Ada_Code_Snippet --
   --------------------------

   function Get_Ada_Code_Snippet
     (Self : Structured_Comment'Class)
      return VSS.String_Vectors.Virtual_String_Vector is
   begin
      for Section of Self.Sections loop
         if Section.Kind = Snippet and Section.Symbol = "ada" then
            return Section.Text;
         end if;
      end loop;

      return VSS.String_Vectors.Empty_Virtual_String_Vector;
   end Get_Ada_Code_Snippet;

   --------------------------------
   -- Get_Plain_Text_Description --
   --------------------------------

   function Get_Plain_Text_Description
     (Section : not null Section_Access)
      return VSS.String_Vectors.Virtual_String_Vector
   is
      Text : VSS.String_Vectors.Virtual_String_Vector;

   begin
      case Section.Kind is
         when Formal =>
            Text.Append ("@formal " & Section.Name);

         when Enumeration_Literal =>
            Text.Append ("@enum " & Section.Name);

         when Field =>
            Text.Append ("@field " & Section.Name);

         when Parameter =>
            Text.Append ("@param " & Section.Name);

         when Returns =>
            pragma Assert (Section.Name.Is_Empty);
            Text.Append ("@return");

         when Raised_Exception =>
            Text.Append ("@exception " & Section.Name);

         when others =>
            raise Program_Error;
      end case;

      for Line of Section.Text loop
         Text.Append ("  " & Line);
      end loop;

      return Text;
   end Get_Plain_Text_Description;

   --------------------------------
   -- Get_Plain_Text_Description --
   --------------------------------

   function Get_Plain_Text_Description
     (Documentation : Structured_Comment)
      return VSS.String_Vectors.Virtual_String_Vector
   is
      Text : VSS.String_Vectors.Virtual_String_Vector;

   begin
      if Documentation.Has_Documentation then
         --  Copy content of the description section

         for Section of Documentation.Sections loop
            if Section.Kind = Description then
               Text := Section.Text;
            end if;
         end loop;

         --  Process generic formal parameters

         declare
            First_Entry : Boolean := True;

         begin
            for Section of Documentation.Sections loop
               if Section.Kind = Formal then
                  if First_Entry then
                     Text.Append (Empty_Virtual_String);
                     First_Entry := False;
                  end if;

                  Text.Append (Get_Plain_Text_Description (Section));
               end if;
            end loop;
         end;

         --  Process enumeration literals

         declare
            First_Entry : Boolean := True;

         begin
            for Section of Documentation.Sections loop
               if Section.Kind = Enumeration_Literal then
                  if First_Entry then
                     Text.Append (Empty_Virtual_String);
                     First_Entry := False;
                  end if;

                  Text.Append (Get_Plain_Text_Description (Section));
               end if;
            end loop;
         end;

         --  Process fields

         declare
            First_Entry : Boolean := True;

         begin
            for Section of Documentation.Sections loop
               if Section.Kind = Field then
                  if First_Entry then
                     Text.Append (Empty_Virtual_String);
                     First_Entry := False;
                  end if;

                  Text.Append (Get_Plain_Text_Description (Section));
               end if;
            end loop;
         end;

         --  Process parameters

         declare
            First_Entry : Boolean := True;

         begin
            for Section of Documentation.Sections loop
               if Section.Kind = Parameter then
                  if First_Entry then
                     Text.Append (Empty_Virtual_String);
                     First_Entry := False;
                  end if;

                  Text.Append (Get_Plain_Text_Description (Section));
               end if;
            end loop;
         end;

         --  Process return

         declare
            First_Entry : Boolean := True;

         begin
            for Section of Documentation.Sections loop
               if Section.Kind = Returns then
                  if First_Entry then
                     Text.Append (Empty_Virtual_String);
                     First_Entry := False;
                  end if;

                  Text.Append (Get_Plain_Text_Description (Section));
               end if;
            end loop;
         end;

         --  Process raised exceptions

         declare
            First_Entry : Boolean := True;

         begin
            for Section of Documentation.Sections loop
               if Section.Kind = Raised_Exception then
                  if First_Entry then
                     Text.Append (Empty_Virtual_String);
                     First_Entry := False;
                  end if;

                  Text.Append (Get_Plain_Text_Description (Section));
               end if;
            end loop;
         end;
      end if;

      return Text;
   end Get_Plain_Text_Description;

   --------------------------------
   -- Get_Plain_Text_Description --
   --------------------------------

   function Get_Plain_Text_Description
     (Documentation : Structured_Comment;
      Name          : Defining_Name'Class)
      return VSS.String_Vectors.Virtual_String_Vector is
   begin
      for Section of Documentation.Sections loop
         if Section.Kind in Component
           and then Section.Symbol = Utilities.To_Symbol (Name)
         then
            return Get_Plain_Text_Description (Section);
         end if;
      end loop;

      return Empty_Virtual_String_Vector;
   end Get_Plain_Text_Description;

   --------------------------------
   -- Get_Plain_Text_Description --
   --------------------------------

   function Get_Plain_Text_Description
     (Documentation : Structured_Comment;
      Name          : Defining_Name'Class;
      Subname       : Defining_Name'Class)
      return VSS.String_Vectors.Virtual_String_Vector
   is
      Symbol    : constant VSS.Strings.Virtual_String :=
        GNATdoc.Comments.Utilities.To_Symbol (Name);
      Subsymbol : constant VSS.Strings.Virtual_String :=
        GNATdoc.Comments.Utilities.To_Symbol (Subname);

   begin
      for Section of Documentation.Sections loop
         if Section.Kind = Formal and then Section.Symbol = Symbol then
            for Subsection of Section.Sections loop
               if Subsection.Kind in Component
                 and then Subsection.Symbol = Subsymbol
               then
                  return Get_Plain_Text_Description (Section);
               end if;
            end loop;
         end if;
      end loop;

      return Empty_Virtual_String_Vector;
   end Get_Plain_Text_Description;

   ----------------------------------
   -- Get_Plain_Text_Documentation --
   ----------------------------------

   procedure Get_Plain_Text_Documentation
     (Name          : Libadalang.Analysis.Defining_Name'Class;
      Options       : GNATdoc.Comments.Options.Extractor_Options;
      Code_Snippet  : out VSS.String_Vectors.Virtual_String_Vector;
      Documentation : out VSS.String_Vectors.Virtual_String_Vector)
   is
      Decl               : constant Basic_Decl := Name.P_Basic_Decl;
      Parent_Basic_Decl  : constant Basic_Decl := Decl.P_Parent_Basic_Decl;
      Decl_To_Extract    : Basic_Decl;
      Name_To_Extract    : Defining_Name;
      Subname_To_Extract : Defining_Name;
      Extracted          : Structured_Comment;

   begin
      if Decl.Kind in Ada_Concrete_Formal_Subp_Decl | Ada_Formal_Type_Decl
        or else (Decl.Kind = Ada_Object_Decl
                   and then Decl.Parent.Kind = Ada_Generic_Formal_Obj_Decl)
      then
         --  Formal of the generic declaration.

         Decl_To_Extract := Parent_Basic_Decl;
         Name_To_Extract := Name.As_Defining_Name;

      elsif Decl.Kind = Ada_Param_Spec
        and Parent_Basic_Decl.Kind
              in Ada_Concrete_Formal_Subp_Decl | Ada_Formal_Type_Decl
      then
         --  Parameter of the formal subprogram or formal access to subprogram
         --  type of the generic declaration.

         Decl_To_Extract := Parent_Basic_Decl.P_Parent_Basic_Decl;

         if Parent_Basic_Decl.Kind = Ada_Formal_Type_Decl then
            Name_To_Extract :=
              Parent_Basic_Decl.As_Formal_Type_Decl.F_Name;

         elsif Parent_Basic_Decl.Kind = Ada_Concrete_Formal_Subp_Decl then
            Name_To_Extract :=
              Parent_Basic_Decl.As_Concrete_Formal_Subp_Decl.F_Subp_Spec
                .F_Subp_Name;
         end if;

         Subname_To_Extract := Name.As_Defining_Name;

      elsif Decl.Kind
              in Ada_Generic_Package_Internal | Ada_Generic_Subp_Internal
      then
         --  Generic package or generic subprogram declarations

         Decl_To_Extract := Parent_Basic_Decl;

      elsif Decl.Kind in Ada_Abstract_Subp_Decl
                    | Ada_Entry_Decl
                    | Ada_Exception_Decl
                    | Ada_Expr_Function
                    | Ada_Generic_Package_Decl
                    | Ada_Generic_Package_Instantiation
                    | Ada_Null_Subp_Decl
                    | Ada_Number_Decl
                    | Ada_Object_Decl
                    | Ada_Package_Decl
                    | Ada_Package_Renaming_Decl
                    | Ada_Protected_Type_Decl
                    | Ada_Single_Protected_Decl
                    | Ada_Subp_Body
                    | Ada_Subp_Decl
                    | Ada_Subtype_Decl
                    | Ada_Task_Type_Decl
        or (Decl.Kind in Ada_Type_Decl
            and then Decl.As_Type_Decl.F_Type_Def.Kind
                     in Ada_Access_To_Subp_Def
                      | Ada_Array_Type_Def
                      | Ada_Decimal_Fixed_Point_Def
                      | Ada_Derived_Type_Def
                      | Ada_Enum_Type_Def
                      | Ada_Floating_Point_Def
                      | Ada_Interface_Type_Def
                      | Ada_Mod_Int_Type_Def
                      | Ada_Ordinary_Fixed_Point_Def
                      | Ada_Private_Type_Def
                      | Ada_Record_Type_Def
                      | Ada_Signed_Int_Type_Def
                      | Ada_Type_Access_Def)
      then
         Decl_To_Extract := Decl;

      elsif Decl.Kind = Ada_Single_Task_Type_Decl then
         Decl_To_Extract := Parent_Basic_Decl;

      elsif Decl.Kind in Ada_Param_Spec | Ada_Entry_Index_Spec
        and then Parent_Basic_Decl.Kind
                   in Ada_Subp_Decl | Ada_Entry_Decl | Ada_Entry_Body
      then
         --  Parameters of the subprograms and entries, family index of
         --  entries.

         Decl_To_Extract := Parent_Basic_Decl;
         Name_To_Extract := Name.As_Defining_Name;

      elsif Decl.Kind in Ada_Discriminant_Spec | Ada_Component_Decl
        and then Parent_Basic_Decl.Kind
                   in Ada_Protected_Type_Decl | Ada_Single_Protected_Decl
      then
         --  Discriminants and components of the protected types/objects.

         Decl_To_Extract := Parent_Basic_Decl;
         Name_To_Extract := Name.As_Defining_Name;

      elsif Decl.Kind = Ada_Enum_Literal_Decl then
         Decl_To_Extract :=
           Decl.As_Enum_Literal_Decl.P_Enum_Type.As_Basic_Decl;
         Name_To_Extract := Name.As_Defining_Name;

      elsif Decl.Kind in Ada_Discriminant_Spec | Ada_Component_Decl
        and then Parent_Basic_Decl.Kind in Ada_Type_Decl
        and then Parent_Basic_Decl.As_Type_Decl.F_Type_Def.Kind
                   = Ada_Record_Type_Def
      then
         Decl_To_Extract := Parent_Basic_Decl;
         Name_To_Extract := Name.As_Defining_Name;
      end if;

      if not Decl_To_Extract.Is_Null then
         GNATdoc.Comments.Extractor.Extract
           (Decl_To_Extract, Options, Extracted);

         if Name_To_Extract.Is_Null then
            Documentation := Get_Plain_Text_Description (Extracted);

         elsif Subname_To_Extract.Is_Null then
            Documentation :=
              Get_Plain_Text_Description (Extracted, Name_To_Extract);

         else
            Documentation :=
              Get_Plain_Text_Description
                (Extracted, Name_To_Extract, Subname_To_Extract);
         end if;

         Code_Snippet := Get_Ada_Code_Snippet (Extracted);
      end if;
   end Get_Plain_Text_Documentation;

end GNATdoc.Comments.Helpers;