diff --git a/alire.toml b/alire.toml index 45a821c..0a56cf3 100644 --- a/alire.toml +++ b/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" } diff --git a/config/aaa_config.ads b/config/aaa_config.ads index 401243a..7839a11 100644 --- a/config/aaa_config.ads +++ b/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; diff --git a/config/aaa_config.gpr b/config/aaa_config.gpr index 4829245..285c3d4 100644 --- a/config/aaa_config.gpr +++ b/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; diff --git a/config/aaa_config.h b/config/aaa_config.h index bf1815c..f67ab97 100644 --- a/config/aaa_config.h +++ b/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 diff --git a/src/aaa-filesystem.adb b/src/aaa-filesystem.adb index 257ff55..b08eec5 100644 --- a/src/aaa-filesystem.adb +++ b/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; diff --git a/src/aaa-processes.adb b/src/aaa-processes.adb index 50505f6..dd011ef 100644 --- a/src/aaa-processes.adb +++ b/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; diff --git a/src/aaa-table_io.adb b/src/aaa-table_io.adb index 6acf707..3cbc74c 100644 --- a/src/aaa-table_io.adb +++ b/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; diff --git a/src/aaa-table_io.ads b/src/aaa-table_io.ads index fe31f7e..e7eb2c0 100644 --- a/src/aaa-table_io.ads +++ b/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;