Merge branch 'issue_19' into 'main'

Add Table_Alignment algorithm

Closes #19

See merge request eng/libadalang/prettier-ada!29

src/prettier_ada-document_vector_vectors.ads

@@ -0,0 +1,13 @@
+--
+--  Copyright (C) 2024, AdaCore
+--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+--
+
+with Ada.Containers.Vectors;
+with Prettier_Ada.Document_Vectors;
+
+package Prettier_Ada.Document_Vector_Vectors is new
+   Ada.Containers.Vectors
+     (Positive,
+      Prettier_Ada.Document_Vectors.Vector,
+      Prettier_Ada.Document_Vectors."=");

src/prettier_ada-documents-builders.adb

@@ -435,4 +435,158 @@ package body Prettier_Ada.Documents.Builders is
    procedure Reset_Document_Id
      renames Prettier_Ada.Documents.Implementation.Reset_Document_Id;
 
+   ---------------------
+   -- Alignment_Table --
+   ---------------------
+
+   function Alignment_Table
+     (Rows : Document_Table; Must_Break : Boolean := True) return Document_Type
+   is
+      Elements   : Prettier_Ada.Document_Vector_Vectors.Vector;
+      Separators : Prettier_Ada.Document_Vector_Vectors.Vector;
+
+      procedure Normalize_Table;
+      --  Splits Rows into Elements and Separators.
+      --  Separators are placed between elements so this ensures that for each
+      --  row:
+      --    Elements (row).Length = Separators (row).Length - 1
+      --
+      --  Example:
+      --
+      --  Rows: [[E11, S11, E12, S12, E13], [E21, S21, E22, S22, E23]]
+      --
+      --  Results in:
+      --
+      --  Elements: [[E11, E12, E13], [E21, E22, E23]]
+      --  Separators: [[S11, S12], [S21, S22]]
+
+      ---------------------
+      -- Normalize_Table --
+      ---------------------
+
+      procedure Normalize_Table is
+      begin
+         --  Iterate through all rows
+
+         for Row_Index in Rows.First_Index .. Rows.Last_Index loop
+            declare
+               use Prettier_Ada.Document_Vector_Vectors;
+
+               use type Ada.Containers.Count_Type;
+
+               Row : constant Constant_Reference_Type :=
+                 Rows.Constant_Reference (Row_Index);
+               --  This is the current row
+
+               --  For each row, we will have a list of elements and a list
+               --  of separators.
+
+               Row_Elements   : Prettier_Ada.Document_Vectors.Vector;
+               Row_Separators : Prettier_Ada.Document_Vectors.Vector;
+
+               Elements_Aggregate : Prettier_Ada.Document_Vectors.Vector;
+               --  Elements that follow another element are aggregated
+               --  together.
+
+            begin
+               --  Iterate through all columns
+
+               for Column_Index in Row.First_Index .. Row.Last_Index loop
+                  declare
+                     use Prettier_Ada.Document_Vectors;
+
+                     Table_Element :
+                       constant Prettier_Ada
+                                  .Document_Vectors
+                                  .Constant_Reference_Type :=
+                         Row.Constant_Reference (Column_Index);
+
+                     Is_Separator : constant Boolean :=
+                       Table_Element.Bare_Document.Kind in Document_Command
+                       and then Table_Element.Bare_Document.Command.Kind
+                                in Command_Alignment_Table_Separator;
+                     --  A table element can either be an element or a
+                     --  separator.
+                  begin
+                     if Is_Separator then
+                        --  Start by adding Elements_Aggregate to Row_Elements
+
+                        if Elements_Aggregate.Is_Empty then
+                           --  No elements before the separator. Simply add an
+                           --  empty string.
+
+                           Row_Elements.Append
+                             (Text
+                                (Ada.Strings.Unbounded.Null_Unbounded_String));
+
+                        elsif Elements_Aggregate.Length = 1 then
+                           Row_Elements.Append
+                             (Elements_Aggregate.First_Element);
+
+                        else
+                           Row_Elements.Append (Group (Elements_Aggregate));
+                        end if;
+
+                        Elements_Aggregate.Clear;
+
+                        --  Then add the separator to Row_Separators
+
+                        Row_Separators.Append (Table_Element);
+
+                     else
+                        Elements_Aggregate.Append (Table_Element);
+                     end if;
+                  end;
+               end loop;
+
+               --  If the last element of this row is not a separator, then
+               --  Elements_Aggregate won't be empty. If so, add it to
+               --  Row_Elements.
+
+                  if not Elements_Aggregate.Is_Empty then
+                     if Elements_Aggregate.Length = 1 then
+                        Row_Elements.Append (Elements_Aggregate.First_Element);
+
+                     else
+                        Row_Elements.Append (Group (Elements_Aggregate));
+                     end if;
+                  end if;
+
+               --  Flush this row's elements and separators
+               Elements.Append (Row_Elements);
+               Separators.Append (Row_Separators);
+            end;
+         end loop;
+      end Normalize_Table;
+
+   begin
+      Normalize_Table;
+
+      return
+        Wrap_Command
+          (new Command_Type'
+                 (Kind       => Command_Alignment_Table,
+                  Alignment_Table_Elements   => Elements,
+                  Alignment_Table_Separators => Separators,
+                  Alignment_Table_Must_Break => Must_Break));
+   end Alignment_Table;
+
+   -------------------------------
+   -- Alignment_Table_Separator --
+   -------------------------------
+
+   function Alignment_Table_Separator
+     (Aligner_Text : Ada.Strings.Unbounded.Unbounded_String)
+      return Document_Type
+   is
+   begin
+      return
+        Wrap_Command
+          (new Command_Type'
+                 (Kind                           =>
+                    Command_Alignment_Table_Separator,
+                  Alignment_Table_Separator_Text =>
+                    To_Prettier_String (Aligner_Text)));
+   end Alignment_Table_Separator;
+
 end Prettier_Ada.Documents.Builders;

src/prettier_ada-documents-builders.ads

@@ -4,6 +4,7 @@
 --
 
 with Prettier_Ada.Document_Vectors;
+with Prettier_Ada.Document_Vector_Vectors;
 
 --  This package provides functions to build a Document_Type.
 --  The API mimics the original Prettier builders API with the following
@@ -17,6 +18,7 @@ with Prettier_Ada.Document_Vectors;
 package Prettier_Ada.Documents.Builders is
 
    subtype Document_Vector is Prettier_Ada.Document_Vectors.Vector;
+   subtype Document_Table is Prettier_Ada.Document_Vector_Vectors.Vector;
 
    No_Document : constant Document_Type;
 
@@ -171,6 +173,16 @@ package Prettier_Ada.Documents.Builders is
       return Document_Type;
    --  Join an array of Documents with a Separator
 
+   function Alignment_Table
+     (Rows : Document_Table; Must_Break : Boolean := True)
+      return Document_Type;
+   --  Create a new Aligment_Table Document Command
+
+   function Alignment_Table_Separator
+     (Aligner_Text : Ada.Strings.Unbounded.Unbounded_String)
+      return Document_Type;
+   --  Create a new Aligment_Table_Separator Document Command
+
 private
 
    No_Document : constant Document_Type := Prettier_Ada.Documents.No_Document;

src/prettier_ada-documents-implementation.ads

@@ -7,6 +7,7 @@ with Ada.Containers;
 with Ada.Strings.Unbounded;
 
 with Prettier_Ada.Document_Vectors;
+with Prettier_Ada.Document_Vector_Vectors;
 
 with VSS.Strings;
 
@@ -69,6 +70,10 @@ private package Prettier_Ada.Documents.Implementation is
      (Text : Ada.Strings.Unbounded.Unbounded_String) return Prettier_String;
    --  Converts an Unbounded_String into a Prettier_String
 
+   subtype Document_Vector is Prettier_Ada.Document_Vectors.Vector;
+
+   subtype Document_Table is Prettier_Ada.Document_Vector_Vectors.Vector;
+
    type Command_Kind is
      (Command_Align,
       Command_Break_Parent,
@@ -82,7 +87,9 @@ private package Prettier_Ada.Documents.Implementation is
       Command_Line,
       Command_Line_Suffix,
       Command_Line_Suffix_Boundary,
-      Command_Trim);
+      Command_Trim,
+      Command_Alignment_Table,
+      Command_Alignment_Table_Separator);
 
    type Command_Type (Kind : Command_Kind) is record
       case Kind is
@@ -135,6 +142,14 @@ private package Prettier_Ada.Documents.Implementation is
 
          when Command_Trim =>
             null;
+
+         when Command_Alignment_Table =>
+            Alignment_Table_Elements   : Document_Table;
+            Alignment_Table_Separators : Document_Table;
+            Alignment_Table_Must_Break : Boolean;
+
+         when Command_Alignment_Table_Separator =>
+            Alignment_Table_Separator_Text : Prettier_String;
       end case;
    end record;
 

src/prettier_ada-documents-json.adb

@@ -3,6 +3,7 @@
 --  SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 --
 
+with Ada.Assertions;
 with Ada.Containers;
 with Ada.Containers.Hashed_Maps;
 
@@ -14,9 +15,32 @@ with GNATCOLL.JSON;
 with Prettier_Ada.Documents.Implementation;
 use Prettier_Ada.Documents.Implementation;
 with Prettier_Ada.Document_Vectors;
+with Prettier_Ada.Document_Vector_Vectors;
 
 package body Prettier_Ada.Documents.Json is
    subtype Document_Vector is Prettier_Ada.Document_Vectors.Vector;
+   subtype Document_Table is Prettier_Ada.Document_Vector_Vectors.Vector;
+
+   function Assert_Equal (Actual, Expected : Command_Kind) return Boolean;
+   --  Returns True is Actual = Expected, else raises an Assertion_Error.
+
+   -------------------
+   --  Assert_Equal --
+   -------------------
+
+   function Assert_Equal (Actual, Expected : Command_Kind) return Boolean
+   is
+   begin
+      Ada.Assertions.Assert
+        (Actual = Expected,
+         "Unexpected Command_Type. Actual: """
+         & Actual'Image
+         & """. Expected: """
+         & Expected'Image
+         & """.");
+
+      return True;
+   end Assert_Equal;
 
    function Wrap_Command
      (Command : Command_Access; Id : Natural) return Document_Type
@@ -44,6 +68,9 @@ package body Prettier_Ada.Documents.Json is
       function From_Document_List (List : Document_Vector) return JSON_Value;
       --  Serialize a document list
 
+      function From_Document_Table (Table : Document_Table) return JSON_Value;
+      --  Serialize a document table
+
       function From_Command (Command : Command_Type) return JSON_Value;
       --  Serialize a command
 
@@ -92,6 +119,20 @@ package body Prettier_Ada.Documents.Json is
          return Create (Elements);
       end From_Document_List;
 
+      -------------------------
+      -- From_Document_Table --
+      -------------------------
+
+      function From_Document_Table (Table : Document_Table) return JSON_Value
+      is
+         Elements : JSON_Array;
+      begin
+         for Row of Table loop
+            Append (Elements, From_Document_List (Row));
+         end loop;
+         return Create (Elements);
+      end From_Document_Table;
+
       ------------------
       -- From_Command --
       ------------------
@@ -215,6 +256,24 @@ package body Prettier_Ada.Documents.Json is
 
             when Command_Trim =>
                Result.Set_Field ("command", "trim");
+
+            when Command_Alignment_Table =>
+               Result.Set_Field ("kind", "alignmentTable");
+               Result.Set_Field
+                 ("elements",
+                  From_Document_Table (Command.Alignment_Table_Elements));
+               Result.Set_Field
+                 ("separators",
+                  From_Document_Table (Command.Alignment_Table_Separators));
+               Result.Set_Field
+                 ("mustBreak", Command.Alignment_Table_Must_Break);
+
+            when Command_Alignment_Table_Separator =>
+               Result.Set_Field ("kind", "alignmentTableSeparator");
+               Result.Set_Field
+                 ("text",
+                  VSS.Strings.Conversions.To_UTF_8_String
+                    (Command.Alignment_Table_Separator_Text.Text));
          end case;
 
          return Result;
@@ -368,6 +427,22 @@ package body Prettier_Ada.Documents.Json is
          --  TODO: Add description
          --  TODO: Add Pre and Post contracts
 
+         function To_Command_Alignment_Table
+           (Json : GNATCOLL.JSON.JSON_Value)
+            return Command_Type
+         with Post => Assert_Equal
+                        (To_Command_Alignment_Table'Result.Kind,
+                         Command_Alignment_Table);
+         --  Decodes Json as a Alignment_Table command
+
+         function To_Command_Alignment_Table_Separator
+           (Json : GNATCOLL.JSON.JSON_Value)
+            return Command_Type
+         with Post => Assert_Equal
+                        (To_Command_Alignment_Table_Separator'Result.Kind,
+                         Command_Alignment_Table_Separator);
+         --  Decodes Json as a Alignment_Table_Separator command
+
          ----------------------
          -- To_Document_Text --
          ----------------------
@@ -494,6 +569,18 @@ package body Prettier_Ada.Documents.Json is
                return
                  Wrap_Command (new Command_Type'(To_Command_Trim (Json)), Id);
 
+            elsif Command_Text = "alignmentTable" then
+               return
+                 Wrap_Command
+                   (new Command_Type'(To_Command_Alignment_Table (Json)), Id);
+
+            elsif Command_Text = "alignmentTableSeparator" then
+               return
+                 Wrap_Command
+                   (new Command_Type'
+                          (To_Command_Alignment_Table_Separator (Json)),
+                    Id);
+
             else
                --  TODO: Raise a better exception
                raise Program_Error;
@@ -779,6 +866,87 @@ package body Prettier_Ada.Documents.Json is
             return (Kind => Command_Trim);
          end To_Command_Trim;
 
+         --------------------------------
+         -- To_Command_Alignment_Table --
+         --------------------------------
+
+         function To_Command_Alignment_Table
+           (Json : GNATCOLL.JSON.JSON_Value)
+            return Command_Type
+         is
+            function To_Document_Table
+              (Json_Table : GNATCOLL.JSON.JSON_Value)
+               return Document_Table;
+            --  TODO: Add description
+            --  TODO: Add Pre and Post contracts
+
+            -----------------------
+            -- To_Document_Table --
+            -----------------------
+
+            function To_Document_Table
+              (Json_Table : GNATCOLL.JSON.JSON_Value)
+               return Document_Table
+            is
+               Table : Document_Table;
+
+               Rows       : constant JSON_Array := Get (Json_Table);
+               Total_Rows : constant Natural    := GNATCOLL.JSON.Length (Rows);
+
+            begin
+               for Row_Index in 1 .. Total_Rows loop
+                  declare
+                     Current_Row   : constant JSON_Array :=
+                       Get (Get (Rows, Row_Index));
+                     Total_Columns : constant Natural    :=
+                       GNATCOLL.JSON.Length (Current_Row);
+
+                     Row : Document_Vector;
+
+                  begin
+                     for Column_Index in 1 .. Total_Columns loop
+                        Row.Append
+                          (To_Document_Type (Get (Current_Row, Column_Index)));
+                     end loop;
+
+                     Table.Append (Row);
+                  end;
+               end loop;
+
+               return Table;
+            end To_Document_Table;
+
+         begin
+            return
+              Command_Type'
+                (Kind                       => Command_Alignment_Table,
+                 Alignment_Table_Elements   =>
+                   To_Document_Table (Get (Json, "elements")),
+                 Alignment_Table_Separators =>
+                   To_Document_Table (Get (Json, "separators")),
+                 Alignment_Table_Must_Break => Get (Json, "mustBreak"));
+         end To_Command_Alignment_Table;
+
+         --------------------------------
+         -- To_Command_Alignment_Table --
+         --------------------------------
+
+         function To_Command_Alignment_Table_Separator
+           (Json : GNATCOLL.JSON.JSON_Value)
+            return Command_Type
+         is
+            Text          : constant VSS.Strings.Virtual_String :=
+              VSS.Strings.Conversions.To_Virtual_String
+                (UTF8_String'(Get (Json, "text")));
+            Display_Width : constant VSS.Strings.Display_Cell_Count :=
+              VSS.Strings.Utilities.Display_Width (Text);
+         begin
+            return
+              Command_Type'
+                (Kind           => Command_Alignment_Table_Separator,
+                 Alignment_Table_Separator_Text => (Text, Display_Width));
+         end To_Command_Alignment_Table_Separator;
+
       begin
          case Kind (Json) is
             when JSON_Boolean_Type

src/prettier_ada.ads

@@ -1,5 +1,5 @@
 --
---  Copyright (C) 2023, AdaCore
+--  Copyright (C) 2023-2024, AdaCore
 --  SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 --
 
@@ -9,7 +9,7 @@ with GNATCOLL.Traces;
 
 package Prettier_Ada is
 
-   Gnatfmt_Trace : GNATCOLL.Traces.Trace_Handle :=
+   Prettier_Ada_Trace : GNATCOLL.Traces.Trace_Handle :=
      GNATCOLL.Traces.Create ("PRETTIER_ADA", GNATCOLL.Traces.Off);
 
    Version    : constant String := "debug";

testsuite/test_programs/src/builders_tester.adb

@@ -22,6 +22,13 @@ procedure Builders_Tester is
    procedure Test_Align;
    --  Builds a Document_Type using the Align builder
 
+   procedure Test_Alignment_Table;
+   --  Builds multiple Document_Type objects using the Alignment_Table builder
+
+   procedure Test_Alignment_Table_Separator;
+   --  Builds multiple Document_Type objects using the
+   --  Alignment_Table_Separator builder
+
    procedure Test_Break_Parent;
    --  Builds a Document_Type using the Break_Parent builder
 
@@ -134,6 +141,136 @@ procedure Builders_Tester is
       New_Line;
    end Test_Align;
 
+   --------------------------
+   -- Test_Alignment_Table --
+   --------------------------
+
+   procedure Test_Alignment_Table
+   is
+      function "+" (Source : String) return Document_Type
+      is (Alignment_Table_Separator (To_Unbounded_String (Source)));
+      --  Converts Source into a Table_Separator command
+
+      function Build_Table return Document_Type;
+      --  Creates a compex testing table
+
+      ------------------
+      --  Build_Table --
+      ------------------
+
+      function Build_Table return Document_Type
+      is
+         Group_1 : constant Symbol_Type := New_Symbol;
+         Group_2 : constant Symbol_Type := New_Symbol;
+         Group_3 : constant Symbol_Type := New_Symbol;
+         Group_4 : constant Symbol_Type := New_Symbol;
+
+         Table : constant Document_Type :=
+           Alignment_Table
+             ([[Hard_Line_Without_Break_Parent,
+                -- This line break tests that trailing spaces before a table
+                -- are removed
+                "A ",
+                +":",
+                Group (Indent (List ([Line, "B "])), Group_1),
+                +":=",
+                If_Break
+                  (Indent (Indent (Group ([Line, "C", ";"]))),
+                   Indent (Group ([Line, "C", ";"])),
+                   (Group_Id => Group_1))],
+               ["AA ",
+                +":",
+                Group (Indent (List ([Line, "BB "])), Group_2),
+                +":=",
+                If_Break
+                  (Indent (Indent (Group ([Line, "CC", ";"]))),
+                   Indent (Group ([Line, "CC", ";"])),
+                   (Group_Id => Group_2))],
+               ["AAA ",
+                +":",
+                Group (Indent (List ([Line, "BBBBBBBBB;"])), Group_3)],
+                --   BBBBBBBBB tests that it does not affect other separators
+               ["AAAA ",
+                +":",
+                Group (Indent (List ([Line, "BBBB "])), Group_4),
+                +":=",
+                If_Break
+                  (Indent (Indent (Group ([Line, "CCCC", ";"]))),
+                   Indent (Group ([Line, "CCCC", ";"])),
+                   (Group_Id => Group_4))]]);
+
+         Table_Wrapper : constant Document_Type :=
+           Group
+             (["record",
+               Indent
+                 (List
+                    ([Hard_Line_Without_Break_Parent,
+                      Table])),
+               Hard_Line_Without_Break_Parent,
+               "end record"]);
+
+      begin
+         return Table_Wrapper;
+      end Build_Table;
+
+      Alignment_Table_1 : constant Document_Type := Build_Table;
+      Alignment_Table_2 : constant Document_Type := Build_Table;
+
+   begin
+      Put_Line ("=== Alignment_Table ===");
+
+      --  Test table alignment without line breaks
+
+      Put_Line ("> Alignment_Table_1 Document JSON:");
+      Put_Line (Serialize (Alignment_Table_1));
+      Put_Line ("> Alignment_Table_1 Document Formatted:");
+      Put_Line (Format (Alignment_Table_1));
+
+      --  Test table alignment with all line breaks
+
+      Put_Line ("> Alignment_Table_2 Document JSON:");
+      Put_Line (Serialize (Alignment_Table_2));
+      Put_Line ("> Alignment_Table_2 Document Formatted:");
+      Put_Line
+         (Format
+            (Alignment_Table_2,
+             (Width       => 1,
+              Indentation =>
+                (Kind   => Spaces,
+                 Width  => 2,
+                 Offset => (Spaces => 0, Tabs => 0)),
+              End_Of_Line => LF)));
+      New_Line;
+   end Test_Alignment_Table;
+
+   ------------------------------------
+   -- Test_Alignment_Table_Separator --
+   ------------------------------------
+
+   procedure Test_Alignment_Table_Separator
+   is
+      Document : constant Document_Type :=
+        List
+          (["A",
+            " ",
+            Alignment_Table_Separator (To_Unbounded_String (":")),
+            " ",
+            "B",
+            " ",
+            Alignment_Table_Separator (To_Unbounded_String (":=")),
+            " ",
+            "C",
+            ";"]);
+
+   begin
+      Put_Line ("=== Alignment_Table_Separator ===");
+      Put_Line ("> Alignment_Table_Separator Document JSON:");
+      Put_Line (Serialize (Document));
+      Put_Line ("> Alignment_Table_Separator Document Formatted:");
+      Put_Line (Format (Document));
+      New_Line;
+   end Test_Alignment_Table_Separator;
+
    ------------------------
    --  Test_Break_Parent --
    ------------------------
@@ -594,6 +731,8 @@ begin
 
    --  Run all the test procedures
    Test_Align;
+   Test_Alignment_Table;
+   Test_Alignment_Table_Separator;
    Test_Break_Parent;
    Test_Cursor;
    Test_Fill;