feat: misc improvements

alire.toml

@@ -22,7 +22,9 @@ tags = ["miscellanea", "utility"]
 website = "https://github.com/mosteo/aaa"
 
 [[depends-on]]
-umwi = "~0.1.0"
+ansiada = "^1.1.0"
+lml     = "~0.1.0"
+umwi    = "~0.1.0"
 
 # [[pins]]
 # umwi = { url="https://github.com/mosteo/umwi", branch="main" }

config/aaa_config.ads

@@ -15,6 +15,6 @@ package Aaa_Config is
    Alire_Host_Distro : constant String := "ubuntu";
 
    type Build_Profile_Kind is (release, validation, development);
-   Build_Profile : constant Build_Profile_Kind := validation;
+   Build_Profile : constant Build_Profile_Kind := development;
 
 end Aaa_Config;

config/aaa_config.gpr

@@ -1,4 +1,6 @@
 --  Configuration for aaa generated by Alire
+with "ansiada.gpr";
+with "lml.gpr";
 with "umwi.gpr";
 abstract project Aaa_Config is
    Crate_Version := "0.3.0-dev";
@@ -12,17 +14,13 @@ abstract project Aaa_Config is
    Ada_Compiler_Switches := External_As_List ("ADAFLAGS", " ");
    Ada_Compiler_Switches := Ada_Compiler_Switches &
           (
-            "-O3" -- Optimize for performance
-           ,"-gnatn" -- Enable inlining
+            "-Og" -- Optimize for debug
            ,"-ffunction-sections" -- Separate ELF section for each function
            ,"-fdata-sections" -- Separate ELF section for each variable
            ,"-g" -- Generate debug info
-           ,"-gnato" -- Enable numeric overflow checking
            ,"-gnatwa" -- Enable all warnings
            ,"-gnatw.X" -- Disable warnings for No_Exception_Propagation
            ,"-gnatVa" -- All validity checks
-           ,"-gnatwe" -- Warnings as errors
-           ,"-gnata" -- Enable assertions and contracts
            ,"-gnaty3" -- Specify indentation level of 3
            ,"-gnatya" -- Check attribute casing
            ,"-gnatyA" -- Use of array index numbers in array attributes
@@ -50,6 +48,6 @@ abstract project Aaa_Config is
           );
 
    type Build_Profile_Kind is ("release", "validation", "development");
-   Build_Profile : Build_Profile_Kind := "validation";
+   Build_Profile : Build_Profile_Kind := "development";
 
 end Aaa_Config;

config/aaa_config.h

@@ -15,6 +15,6 @@
 #define BUILD_PROFILE_VALIDATION 2
 #define BUILD_PROFILE_DEVELOPMENT 3
 
-#define BUILD_PROFILE  2
+#define BUILD_PROFILE  3
 
 #endif

src/aaa-filesystem.adb

@@ -1,4 +1,5 @@
 with AAA.Debug;
+with AAA.Processes;
 with AAA.Strings;
 
 with Ada.Numerics.Discrete_Random;
@@ -51,19 +52,18 @@ package body AAA.Filesystem is
    procedure Ensure_Deletable (Path : String) is
       use Ada.Directories;
       use GNAT;
-      OK   : Boolean := False;
-      Args : OS_Lib.Argument_List_Access;
+      Args   : Strings.Vector;
+      Result : Processes.Result;
    begin
       if Exists (Path) and then
         Kind (Path) = Directory and then
         OS_Lib.Directory_Separator = '\'
       then
-         Args := OS_Lib.Argument_String_To_List ("-R /D /S " & Path & "\*");
+         Args := Strings.Split ("-R /D /S", ' ').Append (Path & "\*");
 
-         OS_Lib.Spawn ("attrib", Args.all, OK);
-         OS_Lib.Free (Args);
+         Result := Processes.Run (Strings.To_Vector ("attrib").Append (Args));
 
-         if not OK then
+         if Result.Exit_Code /= 0 then
             raise Program_Error with "failed to change attributes of " & Path;
          end if;
       end if;

src/aaa-processes.adb

@@ -79,11 +79,27 @@ package body AAA.Processes is
       --            & Command & " " & Arguments.Flatten
       --            & " > " & Name.all);
 
-      Spawn (Program_Name           => Command,
-             Args                   => Arg_List,
-             Output_File_Descriptor => File,
-             Return_Code            => Exit_Code,
-             Err_To_Out             => Err_To_Out);
+      declare
+         Full_Path_Ptr : GNAT.OS_Lib.String_Access
+           := GNAT.OS_Lib.Locate_Exec_On_Path (Command);
+         Full_Path     : constant String :=
+                           (if Full_Path_Ptr /= null
+                            then Full_Path_Ptr.all
+                            else "");
+      begin
+         if Full_Path = "" then
+            raise Constraint_Error with
+              "Executable not found: " & Command;
+         else
+            GNAT.OS_Lib.Free (Full_Path_Ptr);
+         end if;
+
+         Spawn (Program_Name           => Full_Path,
+                Args                   => Arg_List,
+                Output_File_Descriptor => File,
+                Return_Code            => Exit_Code,
+                Err_To_Out             => Err_To_Out);
+      end;
 
       Close (File); -- Can't raise
       Read_Output;

src/aaa-table_io.adb

@@ -1,11 +1,16 @@
 with AAA.ANSI;
+with AAA.Strings;
 
 with Ada.Containers;
 with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
 with Ada.Strings.Wide_Wide_Unbounded;
 
+with AnsiAda;
+
 with GNAT.IO;
 
+with LML.Output.Factory;
+
 with Umwi;
 
 package body AAA.Table_IO is
@@ -22,6 +27,12 @@ package body AAA.Table_IO is
 
    procedure Append (T : in out Table; Cell : String) is
    begin
+      if T.Section = Headers and then not T.Is_Header then
+         raise Constraint_Error with
+           "Adding data before completing headers (missing New_Row?)";
+      end if;
+      T.Is_Header := False;
+
       declare
          Cell : constant Wide_Wide_String :=
                   UTF.Wide_Wide_Strings.Decode (Append.Cell);
@@ -53,12 +64,46 @@ package body AAA.Table_IO is
       return Reference'(Table => T'Access);
    end Append;
 
+   ------------
+   -- Header --
+   ------------
+
+   procedure Header (T : in out Table; Cell : String) is
+   begin
+      if T.Rows.Length > 1 then
+         raise Program_Error with "Headers must be added before any data rows";
+      end if;
+
+      T.Section := Headers;
+      T.Is_Header := True;
+
+      T.Headers.Append (UTF.Wide_Wide_Strings.Decode (Cell));
+      T.Append (Cell);
+   end Header;
+
+   ------------
+   -- Header --
+   ------------
+
+   function Header (T    : aliased in out Table;
+                    Cell : String)
+                    return Reference
+   is
+   begin
+      T.Header (Cell);
+      return Reference'(Table => T'Access);
+   end Header;
+
    -------------
    -- New_Row --
    -------------
 
    procedure New_Row (T : in out Table) is
    begin
+      if not T.Rows.Is_Empty then
+         T.Section := Data;
+      end if;
+
       T.Next_Column := 1;
       T.Rows.Append (String_Vectors.Empty_Vector);
    end New_Row;
@@ -135,6 +180,11 @@ package body AAA.Table_IO is
       Wide_Separator : constant Wide_Wide_String :=
                          UTF.Wide_Wide_Strings.Decode (Separator);
    begin
+      if T.Section = Headers then
+         raise Constraint_Error
+           with "Headers section not yet complete (missing New_Row?)";
+      end if;
+
       for Row of T.Rows loop
          declare
             Line : Unbounded_Wide_Wide_String;
@@ -169,4 +219,77 @@ package body AAA.Table_IO is
       end loop;
    end Print;
 
+   -----------
+   -- Print --
+   -----------
+
+   procedure Print (T        : Table;
+                    Format   : LML.Formats;
+                    Put_Line : access procedure (Line : String) := null)
+   is
+      use AAA.Strings;
+      Builder : LML.Output.Builder'Class := LML.Output.Factory.Get (Format);
+   begin
+
+      if T.Section = Headers then
+         raise Constraint_Error
+           with "Headers section not yet complete (missing New_Row?)";
+      end if;
+
+      --  Ada_TOML requires an anonymous top-level table, and as a consequence
+      --  the nested array must have a name. We could alternatively use a
+      --  map with indexes as keys, but as those would have to be strings in
+      --  the TOML case at least, we would lose the original ordering unless
+      --  padding were added, which would in turn difficult data extraction.
+
+      if Format in LML.TOML then
+         Builder.Begin_Map;
+         Builder.Insert ("data");
+      end if;
+
+      Builder.Begin_Vec;
+
+      for Row in 2 .. Natural (T.Rows.Length) loop
+
+         --  Skip last empty line, which is naturally filtered out in the
+         --  non-structured alternative. Here we are creating the empty
+         --  record too soon (in between loops).
+
+         if Row < Natural (T.Rows.Length)
+           or else Natural (T.Rows (Row).Length) > 0
+         then
+
+            Builder.Begin_Map;
+
+            for Col in 1 .. Integer (T.Rows (Row).Length) loop
+               if Col > Integer (T.Headers.Length) then
+                  raise Constraint_Error with
+                    "Missing header for column" & Col'Image;
+               end if;
+
+               Builder.Insert
+                 (LML.Decode
+                    (Trim (AnsiAda.Scrub (LML.Encode (T.Headers (Col))))));
+               Builder.Append
+                 (LML.Scalars.New_Text
+                    (LML.Decode
+                         (Trim
+                              (AnsiAda.Scrub
+                                 (LML.Encode (T.Rows (Row) (Col)))))));
+            end loop;
+
+            Builder.End_Map;
+
+         end if;
+      end loop;
+
+      Builder.End_Vec;
+
+      if Format in LML.TOML then
+         Builder.End_Map;
+      end if;
+
+      Put_Line (LML.Encode (Builder.To_Text));
+   end Print;
+
 end AAA.Table_IO;

src/aaa-table_io.ads

@@ -3,7 +3,9 @@ with Ada.Containers.Vectors;
 
 with Ada.Strings;
 
-package AAA.Table_IO with Preelaborate is
+with LML;
+
+package AAA.Table_IO is
 
    --  A type to format tables according to the max length of fields. The table
    --  is ANSI-aware, so it will work properly for text with embedded ANSI
@@ -16,13 +18,21 @@ package AAA.Table_IO with Preelaborate is
 
    type Table is tagged private;
 
-   type Reference (Table : access Table_IO.Table) is limited null record
+   type Reference (Table : access Table_IO.Table'Class) is limited null record
      with Implicit_Dereference => Table;
 
    procedure Append (T : in out Table; Cell : String);
 
    function Append (T : aliased in out Table; Cell : String) return Reference;
 
+   procedure Header (T : in out Table; Cell : String);
+   --  Headers are printed as given, but are keep internally for the structured
+   --  output as field names. There should be as many headers as columns.
+
+   function Header (T    : aliased in out Table;
+                    Cell : String)
+                    return Reference;
+
    procedure New_Row (T : in out Table);
 
    type Alignments is array (Positive range <>) of Ada.Strings.Alignment;
@@ -34,6 +44,10 @@ package AAA.Table_IO with Preelaborate is
    --  Will print the table using GNAT.IO, unless Put_Line is supplied
    --  FIXME:  Align is currently ignored
 
+   procedure Print (T        : Table;
+                    Format   : LML.Formats;
+                    Put_Line : access procedure (Line : String) := null);
+
 private
 
    package Natural_Vectors is new Ada.Containers.Vectors (Positive, Natural);
@@ -46,10 +60,16 @@ private
 
    package Row_Vectors is new Ada.Containers.Vectors (Positive, Row);
 
+   type Sections is (Nothing, Headers, Data);
+
    type Table is tagged record
       Next_Column : Positive := 1;
+      Headers     : Row;
       Rows        : Row_Vectors.Vector;
       Max_Widths  : Natural_Vectors.Vector;
+      Section     : Sections := Nothing;
+      Is_Header   : Boolean  := False;
+      --  Internal state to discriminate in Append when a header is being added
    end record;
 
 end AAA.Table_IO;