From fc92bfcc53d67761917653757237300fe8068564 Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Fri, 5 Jun 2020 18:57:32 +0200 Subject: [PATCH] Add support for persistent configuration options (#424) * Add support for persistent configuration options The configuration options are either global or local (local overriding the global definitions) and are stored in TOML format. This patch also introduces a command to handle configuration options from the command line. * Fix circular elaboration of Alire.Config By moving the Not_Interactive global in the User_Input package. --- src/alire/alire-config-edit.adb | 170 +++++++++++ src/alire/alire-config-edit.ads | 7 + src/alire/alire-config.adb | 370 ++++++++++++++++++++++++ src/alire/alire-config.ads | 102 ++++++- src/alire/alire-utils-user_input.adb | 5 +- src/alire/alire-utils-user_input.ads | 10 + src/alr/alr-commands-config.adb | 188 ++++++++++++ src/alr/alr-commands-config.ads | 39 +++ src/alr/alr-commands-test.adb | 4 +- src/alr/alr-commands.adb | 5 +- src/alr/alr-commands.ads | 1 + testsuite/tests/config/basics/test.py | 105 +++++++ testsuite/tests/config/basics/test.yaml | 3 + 13 files changed, 993 insertions(+), 16 deletions(-) create mode 100644 src/alire/alire-config-edit.adb create mode 100644 src/alire/alire-config-edit.ads create mode 100644 src/alr/alr-commands-config.adb create mode 100644 src/alr/alr-commands-config.ads create mode 100644 testsuite/tests/config/basics/test.py create mode 100644 testsuite/tests/config/basics/test.yaml diff --git a/src/alire/alire-config-edit.adb b/src/alire/alire-config-edit.adb new file mode 100644 index 00000000..10bcf256 --- /dev/null +++ b/src/alire/alire-config-edit.adb @@ -0,0 +1,170 @@ +with Ada.Text_IO; + +with TOML; use TOML; + +with Alire; + +package body Alire.Config.Edit is + + procedure Write_Config_File (Table : TOML_Value; Path : Absolute_Path) + with Pre => Table.Kind = TOML_Table; + + procedure Remove_From_Table (Table : TOML_Value; Key : Config_Key) + with Pre => Table.Kind = TOML_Table; + + procedure Add_In_Table (Table : TOML_Value; + Key : Config_Key; + Val : TOML_Value) + with Pre => Table.Kind = TOML_Table; + + function To_TOML_Value (Str : String) return TOML_Value; + -- Use the TOML parser to convert the string Str. If Str is not a valid + -- TOML value, No_TOML_Value is returned. + + ----------------------- + -- Write_Config_File -- + ----------------------- + + procedure Write_Config_File (Table : TOML_Value; Path : Absolute_Path) is + use Ada.Text_IO; + + File : File_Type; + begin + Create (File, Out_File, Path); + Trace.Debug ("Write config: '" & TOML.Dump_As_String (Table) & "'"); + Put (File, TOML.Dump_As_String (Table)); + Close (File); + end Write_Config_File; + + ----------------------- + -- Remove_From_Table -- + ----------------------- + + procedure Remove_From_Table (Table : TOML_Value; Key : Config_Key) is + Id : constant String := Utils.Split (Key, '.', Raises => False); + Leaf : constant Boolean := Id = Key; + begin + if not Table.Has (Id) then + -- The key doesn't exist + return; + end if; + + if Leaf then + Table.Unset (Id); + else + declare + Sub : constant TOML_Value := Table.Get (Id); + begin + if Sub.Kind = TOML_Table then + Remove_From_Table (Sub, Utils.Split (Key, '.', Utils.Tail)); + else + raise Program_Error; + end if; + end; + end if; + end Remove_From_Table; + + ------------------ + -- Add_In_Table -- + ------------------ + + procedure Add_In_Table (Table : TOML_Value; + Key : Config_Key; + Val : TOML_Value) + is + Id : constant String := Utils.Split (Key, '.', Raises => False); + Leaf : constant Boolean := Id = Key; + begin + if Leaf then + Table.Set (Id, Val); + return; + end if; + + if not Table.Has (Id) then + -- The subkey doesn't exist, create a table for it + Table.Set (Id, Create_Table); + end if; + + declare + Sub : constant TOML_Value := Table.Get (Id); + begin + if Sub.Kind = TOML_Table then + Add_In_Table (Sub, Utils.Split (Key, '.', Utils.Tail), Val); + else + Raise_Checked_Error ("Configuration key already defined"); + end if; + end; + end Add_In_Table; + + ------------------- + -- To_TOML_Value -- + ------------------- + + function To_TOML_Value (Str : String) return TOML_Value is + Result : constant TOML.Read_Result := TOML.Load_String ("key=" & Str); + begin + if not Result.Success + or else + Result.Value.Kind /= TOML_Table + or else + not Result.Value.Has ("key") + then + + -- Conversion failed + + if Str (Str'First) /= '"' then + -- Try again with double quotes to interpret the value as a TOML + -- string. + return To_TOML_Value ('"' & Str & '"'); + else + + -- Invalid TOML value + return No_TOML_Value; + end if; + else + return Result.Value.Get ("key"); + end if; + end To_TOML_Value; + + ----------- + -- Unset -- + ----------- + + procedure Unset (Path : Absolute_Path; Key : Config_Key) is + Table : constant TOML_Value := Load_Config_File (Path); + begin + + if Table.Is_Null then + -- The configuration file doesn't exist or is not valid + return; + end if; + + Remove_From_Table (Table, Key); + Write_Config_File (Table, Path); + end Unset; + + --------- + -- Set -- + --------- + + procedure Set (Path : Absolute_Path; Key : Config_Key; Value : String) is + Table : TOML_Value := Load_Config_File (Path); + + To_Add : constant TOML_Value := To_TOML_Value (Value); + begin + if To_Add.Is_Null then + Raise_Checked_Error ("Invalid configuration value: '" & Value & "'"); + end if; + + if Table.Is_Null then + -- The configuration file doesn't exist or is not valid. Create an + -- empty table. + Table := TOML.Create_Table; + end if; + + Add_In_Table (Table, Key, To_Add); + + Write_Config_File (Table, Path); + end Set; + +end Alire.Config.Edit; diff --git a/src/alire/alire-config-edit.ads b/src/alire/alire-config-edit.ads new file mode 100644 index 00000000..b0eaa0b8 --- /dev/null +++ b/src/alire/alire-config-edit.ads @@ -0,0 +1,7 @@ +package Alire.Config.Edit is + + procedure Unset (Path : Absolute_Path; Key : Config_Key); + + procedure Set (Path : Absolute_Path; Key : Config_Key; Value : String); + +end Alire.Config.Edit; diff --git a/src/alire/alire-config.adb b/src/alire/alire-config.adb index 0131b81a..779869af 100644 --- a/src/alire/alire-config.adb +++ b/src/alire/alire-config.adb @@ -1,11 +1,87 @@ +with Ada.Containers.Hashed_Maps; +with Ada.Strings.Unbounded; +with Ada.Strings.Unbounded.Hash; + +with GNAT.Regexp; + with Alire.Environment; with Alire.Platform; +with Alire.Directories; + +with TOML.File_IO; package body Alire.Config is + use Ada.Strings.Unbounded; + use TOML; + + type Config_Value is record + Source : Unbounded_String; + Value : TOML.TOML_Value; + Lvl : Level; + end record; + + No_Config_Value : constant Config_Value := (Source => Null_Unbounded_String, + Value => No_TOML_Value, + Lvl => Global); + + package Config_Maps is new Ada.Containers.Hashed_Maps + (Key_Type => Unbounded_String, + Element_Type => Config_Value, + Hash => Hash, + Equivalent_Keys => "="); + + Config_Map : Config_Maps.Map; + + procedure Import (Table : TOML.TOML_Value; + Lvl : Level; + Source : String; + Prefix : String := ""); + -- Import TOML Table in the Config_Map global variable + + function Get (Key : Config_Key) return Config_Value; + + function Image (Val : TOML_Value) return String; + type String_Access is access String; Config_Path : String_Access; + ----------- + -- Image -- + ----------- + + function Image (F : TOML.Any_Float) return String is + begin + case F.Kind is + when Regular => + return Utils.Trim (F.Value'Image); + when NaN | Infinity => + return (if F.Positive then "" else "-") & + (if F.Kind = NaN then "nan" else "inf"); + end case; + end Image; + + ----------- + -- Image -- + ----------- + + function Image (Val : TOML_Value) return String is + begin + case Val.Kind is + when TOML_Boolean => + return (if Val.As_Boolean then "true" else "false"); + when TOML_Integer => + return Utils.Trim (Val.As_Integer'Img); + when TOML_Float => + return Image (Val.As_Float); + when TOML_String => + return Val.As_String; + when others => + -- This should have been filtered during import + raise Program_Error; + end case; + end Image; + ---------- -- Path -- ---------- @@ -33,4 +109,298 @@ package body Alire.Config is end if; end Set_Path; + ------------- + -- Defined -- + ------------- + + function Defined (Key : Config_Key) return Boolean is + begin + return Config_Map.Contains (To_Unbounded_String (Key)); + end Defined; + + ------------------- + -- Get_As_String -- + ------------------- + + function Get_As_String (Key : Config_Key) return String is + begin + if Defined (Key) then + return Image (Get (Key).Value); + else + return ""; + end if; + end Get_As_String; + + --------- + -- Get -- + --------- + + function Get (Key : Config_Key) return Config_Value is + + begin + if Defined (Key) then + return Config_Map.Element (To_Unbounded_String (Key)); + else + return No_Config_Value; + end if; + end Get; + + -------------------------- + -- Get_With_Default_Gen -- + -------------------------- + + function Get_With_Default_Gen (Key : Config_Key; + Default : Return_Type) + return Return_Type + is + Val : constant Config_Value := Get (Key); + begin + if Val.Value.Is_Null then + Trace.Detail ("Using default value for configuration '" & Key & + "': '" & Image (Default) & "'"); + return Default; + + elsif Val.Value.Kind /= Expected_TOML_Kind then + Trace.Error ("Invalid type ('" & Val.Value.Kind'Img & + "') for configuration '" & Key & "'"); + Trace.Error ("in '" & To_String (Val.Source) & "'"); + Trace.Error (Type_Name & " expected"); + Trace.Error ("Using default: '" & Image (Default) & "'"); + return Default; + + else + return TOML_As_Return_Type (Val.Value); + end if; + end Get_With_Default_Gen; + + --------- + -- Get -- + --------- + + function Get (Key : Config_Key; + Default : Boolean) + return Boolean + is + function Get_With_Default_Bool is new Get_With_Default_Gen + (Boolean, TOML_Boolean, "Boolean", TOML.As_Boolean, Boolean'Image); + + begin + return Get_With_Default_Bool (Key, Default); + end Get; + + --------- + -- Get -- + --------- + + function Get (Key : Config_Key; + Default : String) + return String + is + function Id (Str : String) return String + is (Str); + + function Get_With_Default_Str is new Get_With_Default_Gen + (String, TOML_String, "String", TOML.As_String, Id); + + begin + return Get_With_Default_Str (Key, Default); + end Get; + + --------- + -- Get -- + --------- + + function Get (Key : Config_Key; + Default : TOML.Any_Integer) + return TOML.Any_Integer + is + function Get_With_Default_Int is new Get_With_Default_Gen + (TOML.Any_Integer, TOML_Integer, "Integer", TOML.As_Integer, + Any_Integer'Image); + + begin + return Get_With_Default_Int (Key, Default); + end Get; + + --------- + -- Get -- + --------- + + function Get (Key : Config_Key; + Default : TOML.Any_Float) + return TOML.Any_Float + is + function Get_With_Default_Int is new Get_With_Default_Gen + (TOML.Any_Float, TOML_Float, "Float", TOML.As_Float, Image); + begin + return Get_With_Default_Int (Key, Default); + end Get; + + ---------- + -- List -- + ---------- + + function List (Filter : String := ".*"; + Show_Origin : Boolean := False) + return String + is + use GNAT.Regexp; + + Re : constant Regexp := Compile (Filter, Glob => True); + + Result : Unbounded_String; + begin + for C in Config_Map.Iterate loop + declare + Val : constant Config_Value := Config_Map (C); + Key : constant String := To_String (Config_Maps.Key (C)); + begin + if Match (Key, Re) then + if Show_Origin then + Append (Result, Val.Source & " (" & Val.Lvl'Img & "): "); + end if; + + Append (Result, Key & "="); + Append (Result, Image (Val.Value)); + Append (Result, ASCII.LF); + end if; + end; + end loop; + return To_String (Result); + end List; + + -------------- + -- Filepath -- + -------------- + + function Filepath (Lvl : Level) return Absolute_Path is + begin + case Lvl is + when Global => + return Alire.Config.Path / "config.toml"; + when Local => + declare + Candidate : constant String := + Directories.Detect_Root_Path; + begin + if Candidate /= "" then + -- This file cannot have a .toml extension or the root + -- detection will not work. + return Candidate / "alire" / "config"; + else + Raise_Checked_Error + ("Can only be used in an Alire directory"); + end if; + end; + end case; + end Filepath; + + ------------ + -- Import -- + ------------ + + procedure Import (Table : TOML_Value; + Lvl : Level; + Source : String; + Prefix : String := "") + is + begin + for Ent of Iterate_On_Table (Table) loop + declare + Key : constant String := + (if Prefix = "" then "" else Prefix & ".") & + To_String (Ent.Key); + + begin + if not Is_Valid_Config_Key (Key) then + Trace.Error ("Invalid configuration key '" & Key & "' in " & + "'" & Source & "'"); + elsif Ent.Value.Kind = TOML_Table then + + -- Recursive call on the table + Import (Ent.Value, Lvl, Source, Key); + else + + Trace.Debug ("Load config key: '" & Key & "' = '" & + Ent.Value.Kind'Img & "'"); + + if Ent.Value.Kind not in TOML_String | TOML_Float | + TOML_Integer | TOML_Boolean + then + Trace.Error ("Invalid type '" & Ent.Value.Kind'Img & + "' for key '" & Key & + "' in configuration file '" & + Source & "'"); + Trace.Error ("'" & Key & "' is ignored"); + else + -- Insert the config value, potentially replacing a previous + -- definition. + Config_Map.Include (To_Unbounded_String (Key), + (Source => To_Unbounded_String (Source), + Value => Ent.Value, + Lvl => Lvl)); + end if; + end if; + end; + end loop; + end Import; + + ----------------- + -- Load_Config -- + ----------------- + + procedure Load_Config is + + begin + for Lvl in Level loop + + if Lvl /= Local or else Root.Current.Is_Valid then + + declare + Config : constant TOML_Value := + Load_Config_File (Filepath (Lvl)); + begin + if not Config.Is_Null then + Import (Config, Lvl, Source => Filepath (Lvl)); + end if; + end; + end if; + end loop; + end Load_Config; + + ---------------------- + -- Load_Config_File -- + ---------------------- + + function Load_Config_File (Path : Absolute_Path) return TOML_Value is + begin + + if GNAT.OS_Lib.Is_Read_Accessible_File (Path) then + declare + Config : constant TOML.Read_Result := + TOML.File_IO.Load_File (Path); + begin + if Config.Success then + if Config.Value.Kind /= TOML.TOML_Table then + Trace.Error ("Bad config file '" & Path & + "': TOML table expected."); + else + return Config.Value; + end if; + else + Trace.Detail ("error while loading '" & Path & "':"); + Trace.Detail + (Ada.Strings.Unbounded.To_String (Config.Message)); + end if; + end; + else + Trace.Detail ("Config file is not readable or doesn't exist: '" & + Path & "'"); + end if; + + return No_TOML_Value; + end Load_Config_File; + +begin + Load_Config; end Alire.Config; diff --git a/src/alire/alire-config.ads b/src/alire/alire-config.ads index 99d3438b..d8fac1f7 100644 --- a/src/alire/alire-config.ads +++ b/src/alire/alire-config.ads @@ -1,7 +1,79 @@ with Alire.OS_Lib; use Alire.OS_Lib.Operators; +with Alire.Utils; +with Alire.Root; + +with TOML; package Alire.Config is + function Is_Valid_Config_Key (Key : String) return Boolean + is ((for all C of Key => C in '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' | + '-' | '.' | '_') + and then Key (Key'First) not in '-' | '.' | '_' + and then Key (Key'Last) not in '-' | '.' | '_' + and then not Utils.Contains (Key, "..")); + -- Rule that define a valid configuration key. Dots are used to separate + -- levels of configuration groups. + -- eg: + -- user.login + -- user.email + + subtype Config_Key is String + with Dynamic_Predicate => Is_Valid_Config_Key (Config_Key); + + function Defined (Key : Config_Key) return Boolean; + -- Return True if a value is defined for the given key + + function Get_As_String (Key : Config_Key) return String; + -- Return a string representation of the value for the given configuration + -- Key. If the key is not defined, an empty string is returned. + + function Get (Key : Config_Key; + Default : Boolean) + return Boolean; + -- Return the Boolean value for the given configuration Key. If the key is + -- not defined, the Default value is returned. If the key is defined but + -- not as a Boolean, an error message is displayed and the Default value + -- is returned. + + function Get (Key : Config_Key; + Default : String) + return String; + -- Return the String value for the given configuration Key. If the key is + -- not defined, the Default value is returned. If the key is defined but + -- not as a String, an error message is displayed and the Default value + -- is returned. + + function Get (Key : Config_Key; + Default : TOML.Any_Integer) + return TOML.Any_Integer; + -- Return the Integer value for the given configuration Key. If the key is + -- not defined, the Default value is returned. If the key is defined but + -- not as an Integer, an error message is displayed and the Default value + -- is returned. + + function Get (Key : Config_Key; + Default : TOML.Any_Float) + return TOML.Any_Float; + -- Return the Float value for the given configuration Key. If the key is + -- not defined, the Default value is returned. If the key is defined but + -- not as an Float, an error message is displayed and the Default value + -- is returned. + + function List (Filter : String := ".*"; + Show_Origin : Boolean := False) + return String; + -- Return a String that contains a list of configuration key/value as seen + -- by Alire. When Show_Origin is true, the configuration file where each + -- key was loaded is also listed. + + type Level is (Global, Local); + + function Filepath (Lvl : Level) return Absolute_Path + with Pre => Lvl /= Local or else Alire.Root.Current.Is_Valid; + -- Return path of the configuration file coresponding to the given + -- configuration level. + -- TODO: refactor this globals package into a type that can be -- passed around. @@ -14,7 +86,7 @@ package Alire.Config is ----------- function Path return String; - -- The in-use config path. + -- The in-use global config folder path. -- In order of decreasing precedence: -- * A manually set path with Set_Path (below) -- * An ALR_CONFIG env given folder @@ -23,18 +95,28 @@ package Alire.Config is -- Detection happens during elaboration. procedure Set_Path (Path : String); - -- Override + -- Override global config folder path function Indexes_Directory return Absolute_Path is (Path / "indexes"); - ------------------- - -- Interactivity -- - ------------------- +private + + function Load_Config_File (Path : Absolute_Path) return TOML.TOML_Value; + -- Load a TOML config file and return No_TOML_Value if the file is invalid + -- or doesn't exist. + + generic + type Return_Type (<>) is private; + Expected_TOML_Kind : TOML.Any_Value_Kind; + Type_Name : String; + + with function TOML_As_Return_Type (Value : TOML.TOML_Value) + return Return_Type; + + with function Image (V : Return_Type) return String; - Not_Interactive : aliased Boolean := False; - -- When not Interactive, instead of asking the user something, use default. - -- Currently only used before the first call to `sudo apt` to ask for - -- confirmation. - -- TODO: remove global eventually + function Get_With_Default_Gen (Key : Config_Key; + Default : Return_Type) + return Return_Type; end Alire.Config; diff --git a/src/alire/alire-utils-user_input.adb b/src/alire/alire-utils-user_input.adb index 3fe3381a..47c693e8 100644 --- a/src/alire/alire-utils-user_input.adb +++ b/src/alire/alire-utils-user_input.adb @@ -3,7 +3,6 @@ with Ada.Characters.Handling; with Interfaces.C_Streams; -with Alire.Config; with Alire.Utils.TTY; package body Alire.Utils.User_Input is @@ -83,7 +82,7 @@ package body Alire.Utils.User_Input is loop TIO.Put_Line (Question); - if Alire.Config.Not_Interactive or else not Is_TTY then + if Not_Interactive or else not Is_TTY then return Use_Default; end if; @@ -139,7 +138,7 @@ package body Alire.Utils.User_Input is Foo : String := "bar"; Bar : Integer; begin - if Config.Not_Interactive then + if Not_Interactive then Trace.Detail ("Non-interactive session, continuing"); else Flush_TTY; diff --git a/src/alire/alire-utils-user_input.ads b/src/alire/alire-utils-user_input.ads index 9fa96e65..3ed324eb 100644 --- a/src/alire/alire-utils-user_input.ads +++ b/src/alire/alire-utils-user_input.ads @@ -1,5 +1,15 @@ package Alire.Utils.User_Input is + ------------------- + -- Interactivity -- + ------------------- + + Not_Interactive : aliased Boolean := False; + -- When not Interactive, instead of asking the user something, use default. + -- Currently only used before the first call to `sudo apt` to ask for + -- confirmation. + -- TODO: remove global eventually + type Answer_Kind is (Yes, No, Always); type Answer_Set is array (Answer_Kind) of Boolean; diff --git a/src/alr/alr-commands-config.adb b/src/alr/alr-commands-config.adb new file mode 100644 index 00000000..7a3cb388 --- /dev/null +++ b/src/alr/alr-commands-config.adb @@ -0,0 +1,188 @@ +with Alire.Config.Edit; +with Alire.Root; + +package body Alr.Commands.Config is + + ------------- + -- Execute -- + ------------- + + overriding procedure Execute (Cmd : in out Command) is + Enabled : Natural := 0; + + Lvl : constant Alire.Config.Level := (if Cmd.Global + then Alire.Config.Global + else Alire.Config.Local); + begin + -- Check no multi-action + Enabled := Enabled + (if Cmd.List then 1 else 0); + Enabled := Enabled + (if Cmd.Get then 1 else 0); + Enabled := Enabled + (if Cmd.Set then 1 else 0); + Enabled := Enabled + (if Cmd.Unset then 1 else 0); + + if Enabled > 1 then + Reportaise_Wrong_Arguments ("Specify at most one subcommand"); + end if; + + if Enabled = 0 then + -- The default command is --list + Cmd.List := True; + end if; + + if Cmd.Show_Origin and then not Cmd.List then + Reportaise_Wrong_Arguments + ("--show-origin only valid with --list"); + end if; + + if not Cmd.Global and then not Alire.Root.Current.Is_Valid then + Reportaise_Command_Failed + ("Not in an Alire project directory." & + " Use --global to edit the global configuration."); + end if; + + if Cmd.List then + case Num_Arguments is + when 0 => + Trace.Always (Alire.Config.List + (Filter => "*", + Show_Origin => Cmd.Show_Origin)); + when 1 => + Trace.Always (Alire.Config.List + (Filter => Argument (1), + Show_Origin => Cmd.Show_Origin)); + when others => + Reportaise_Wrong_Arguments + ("List expects at most one argument"); + end case; + + elsif Cmd.Get then + if Num_Arguments /= 1 then + Reportaise_Wrong_Arguments ("Unset expects one argument"); + end if; + + if not Alire.Config.Is_Valid_Config_Key (Argument (1)) then + Reportaise_Wrong_Arguments ("Invalid configration key '" & + Argument (1) & "'"); + end if; + + if Alire.Config.Defined (Argument (1)) then + Trace.Always (Alire.Config.Get_As_String (Argument (1))); + else + Reportaise_Command_Failed ("Configuration key '" & Argument (1) & + "' is not defined"); + end if; + elsif Cmd.Set then + if Num_Arguments /= 2 then + Reportaise_Wrong_Arguments ("Set expects two arguments"); + end if; + + declare + Key : constant String := Argument (1); + Val : constant String := Argument (2); + begin + + if not Alire.Config.Is_Valid_Config_Key (Key) then + Reportaise_Wrong_Arguments ("Invalid configration key '" & + Key & "'"); + end if; + + Alire.Config.Edit.Set (Alire.Config.Filepath (Lvl), Key, Val); + end; + + elsif Cmd.Unset then + if Num_Arguments /= 1 then + Reportaise_Wrong_Arguments ("Unset expects one argument"); + end if; + + declare + Key : constant String := Argument (1); + begin + if not Alire.Config.Is_Valid_Config_Key (Key) then + Reportaise_Wrong_Arguments ("Invalid configration key '" & + Key & "'"); + end if; + + Alire.Config.Edit.Unset (Alire.Config.Filepath (Lvl), Key); + end; + end if; + + end Execute; + + ---------------------- + -- Long_Description -- + ---------------------- + + overriding + function Long_Description (Cmd : Command) + return Alire.Utils.String_Vector is + (Alire.Utils.Empty_Vector + .Append ("Provides a command line interface to the Alire configuration" & + " option files.") + .New_Line + .Append ("Option names (keys) can use lowercase and uppercase" & + " alphanumeric characters") + .Append ("from the latin alphabet. Underscores and dashes can also be" & + " used except as") + .Append ("first or last character. Dot '.' is used to specify" & + " sub-categories, e.g.") + .Append ("'user.name' or 'user.email'.") + .New_Line + + .Append ("Option values can be integers, float, boolean (true or" & + " false) or strings. The") + .Append ("type detection is automatic, e.g. 10 is integer, 10.1 is" & + " float, true is") + .Append ("boolean. You can force a value to be set a string by using" & + " double-quotes, e.g.") + .Append ("""10.1"" or ""true"".") + ); + + -------------------- + -- Setup_Switches -- + -------------------- + + overriding + procedure Setup_Switches + (Cmd : in out Command; + Config : in out GNAT.Command_Line.Command_Line_Configuration) is + begin + GNAT.Command_Line.Define_Switch + (Config => Config, + Output => Cmd.List'Access, + Long_Switch => "--list", + Help => "List configuration options"); + + GNAT.Command_Line.Define_Switch + (Config => Config, + Output => Cmd.Show_Origin'Access, + Long_Switch => "--show-origin", + Help => "Show origin of configuration values in --list"); + + GNAT.Command_Line.Define_Switch + (Config => Config, + Output => Cmd.Get'Access, + Long_Switch => "--get", + Help => "Print value of a configuration option"); + + GNAT.Command_Line.Define_Switch + (Config => Config, + Output => Cmd.Set'Access, + Long_Switch => "--set", + Help => "Set a configuration option"); + + GNAT.Command_Line.Define_Switch + (Config => Config, + Output => Cmd.Unset'Access, + Long_Switch => "--unset", + Help => "Unset a configuration option"); + + GNAT.Command_Line.Define_Switch + (Config => Config, + Output => Cmd.Global'Access, + Long_Switch => "--global", + Help => "Set and Unset global configuration instead" & + " of the local one"); + + end Setup_Switches; + +end Alr.Commands.Config; diff --git a/src/alr/alr-commands-config.ads b/src/alr/alr-commands-config.ads new file mode 100644 index 00000000..c34dae53 --- /dev/null +++ b/src/alr/alr-commands-config.ads @@ -0,0 +1,39 @@ +package Alr.Commands.Config is + + type Command is new Commands.Command with private; + + overriding + procedure Execute (Cmd : in out Command); + + overriding + function Long_Description (Cmd : Command) + return Alire.Utils.String_Vector; + + overriding + procedure Setup_Switches + (Cmd : in out Command; + Config : in out GNAT.Command_Line.Command_Line_Configuration); + + overriding + function Short_Description (Cmd : Command) return String + is ("List, Get, Set or Unset configuration options"); + + overriding + function Usage_Custom_Parameters (Cmd : Command) return String is + ("[--list] [--show-origin] [key_glob] |" & + " --get |" & + " --set |" & + " --unset "); + +private + + type Command is new Commands.Command with record + Show_Origin : aliased Boolean := False; + List : aliased Boolean := False; + Get : aliased Boolean := False; + Set : aliased Boolean := False; + Unset : aliased Boolean := False; + Global : aliased Boolean := False; + end record; + +end Alr.Commands.Config; diff --git a/src/alr/alr-commands-test.adb b/src/alr/alr-commands-test.adb index 10358a5d..2c1c6981 100644 --- a/src/alr/alr-commands-test.adb +++ b/src/alr/alr-commands-test.adb @@ -2,7 +2,6 @@ with Ada.Calendar; with Ada.Directories; with Ada.Exceptions; -with Alire.Config; with Alire.Containers; with Alire.Crates.With_Releases; with Alire.Defaults; @@ -14,6 +13,7 @@ with Alire.Properties.Actions.Executor; with Alire.Solutions; with Alire.Solver; with Alire.Utils; +with Alire.Utils.User_Input; with Alr.Files; with Alr.Paths; @@ -494,7 +494,7 @@ package body Alr.Commands.Test is (Ada.Directories.Current_Directory, Not_Empty'Access); end if; - Alire.Config.Not_Interactive := True; + Alire.Utils.User_Input.Not_Interactive := True; -- Start testing if Test_All then diff --git a/src/alr/alr-commands.adb b/src/alr/alr-commands.adb index 81fe122a..8b2a47a0 100644 --- a/src/alr/alr-commands.adb +++ b/src/alr/alr-commands.adb @@ -18,9 +18,11 @@ with Alire.Roots.Check_Valid; with Alire.Solutions; with Alire.Utils.Tables; with Alire.Utils.TTY; +with Alire.Utils.User_Input; with Alr.Commands.Build; with Alr.Commands.Clean; +with Alr.Commands.Config; with Alr.Commands.Dev; with Alr.Commands.Get; with Alr.Commands.Help; @@ -56,6 +58,7 @@ package body Alr.Commands is Dispatch_Table : constant array (Cmd_Names) of Command_Access := (Cmd_Build => new Build.Command, Cmd_Clean => new Clean.Command, + Cmd_Config => new Config.Command, Cmd_Dev => new Dev.Command, Cmd_Get => new Get.Command, Cmd_Help => new Help.Command, @@ -183,7 +186,7 @@ package body Alr.Commands is "Display general or command-specific help"); Define_Switch (Config, - Alire.Config.Not_Interactive'Access, + Alire.Utils.User_Input.Not_Interactive'Access, "-n", "--non-interactive", "Assume default answers for all user prompts"); diff --git a/src/alr/alr-commands.ads b/src/alr/alr-commands.ads index f6072ecd..c464388d 100644 --- a/src/alr/alr-commands.ads +++ b/src/alr/alr-commands.ads @@ -107,6 +107,7 @@ package Alr.Commands is type Cmd_Names is (Cmd_Build, Cmd_Clean, + Cmd_Config, Cmd_Dev, Cmd_Get, Cmd_Help, diff --git a/testsuite/tests/config/basics/test.py b/testsuite/tests/config/basics/test.py new file mode 100644 index 00000000..bb2ed303 --- /dev/null +++ b/testsuite/tests/config/basics/test.py @@ -0,0 +1,105 @@ +""" +Check basic features of the alr config command +""" + +import os + +from glob import glob + +from drivers.alr import run_alr + +def invalid_key(*args): + print("Running: alr config %s" % " ".join([item for item in args])) + + p = run_alr('config', *args, complain_on_error=False, quiet=False) + + assert p.status != 0, "command should fail" + + assert "Invalid configration key" in p.out, \ + "Missing error message in: '%s" % p.out + +def check_value(key, expected_value, local=True): + if local: + get = run_alr('config', '--get', key) + else: + get = run_alr('config', '--global', '--get', key) + assert get.out == expected_value + "\n", "Got '%s'" % get.out + +def set_get_unset(key, value, image=None): + + if image is None: + image = value + + # The key should not be defined + get1 = run_alr('config', '--global', '--get', key, complain_on_error=False) + assert get1.status != 0, 'Should not be defined' + + # Define it + run_alr('config', '--global', '--set', key, value) + + # Check that it is defined + check_value(key, image, local=False) + + # Unset it + run_alr('config', '--global', '--unset', key) + + # Check that is it not defined anymore + get3 = run_alr('config', '--global', '--get', key, complain_on_error=False) + assert get3.status != 0, 'Should not be defined' + +####################### +# invalid config keys # +####################### +invalid_key('--get', '--global', '.test') +invalid_key('--get', '--global', '_test.') +invalid_key('--get', '--global', '_test') +invalid_key('--get', '--global', 'test_') +invalid_key('--get', '--global', 'test..test') +invalid_key('--get', '--global', '@') +invalid_key('--get', '--global', '%') +invalid_key('--get', '--global', '&') +invalid_key('--get', '--global', '#') +invalid_key('--get', '--global', '^') + +############################### +# Global Set, Get, Unset, Get # +############################### +set_get_unset('test.explicit.string', '"str"', image='str') +set_get_unset('test.implicit.string', 'str') +set_get_unset('test.int', '42') +set_get_unset('test.bool', 'true') +set_get_unset('test.float', '0.2', image='2.00000000000000E-01') + +################ +# Local config # +################ + +# Check that local operations (default) fail if not in a crate context +p = run_alr('config', '--set', 'test.local', '42', complain_on_error=False) +assert p.status != 0, 'Should fail' + +# Get a create to have local context +run_alr('get', 'hello') +os.chdir(glob('hello*')[0]) + +# Local operation should now work +run_alr('config', '--set', 'test.local', '42') + +# Set a local and check its value +run_alr('config', '--set', 'test.override', '"is_local"') +check_value('test.override', 'is_local') + +# Set a global and check that the local value is still returned +run_alr('config', '--set', '--global', 'test.override', '"is_global"') +check_value('test.override', 'is_local') + +# Leave the crate context (local keys are not available anymore) +os.chdir('..') + +# Check that we now see the global value +check_value('test.override', 'is_global', local=False) + +# Remove the global key +run_alr('config', '--unset', '--global', 'test.override') + +print('SUCCESS') diff --git a/testsuite/tests/config/basics/test.yaml b/testsuite/tests/config/basics/test.yaml new file mode 100644 index 00000000..872fc127 --- /dev/null +++ b/testsuite/tests/config/basics/test.yaml @@ -0,0 +1,3 @@ +driver: python-script +indexes: + basic_index: {} -- 2.39.5