From 11ed38a5a76a83881df50c20bc0122384be4f9e0 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Fri, 29 Jan 2021 10:36:57 +0100 Subject: [PATCH] Separate non-preelaborable parts of Config (#670) * Separate non-preelaborable parts of Config These parts are now in Alire.Config.Edit * Fixes for Windows-specific sources --- src/alire/alire-config-edit.adb | 327 +++++++++++++++- src/alire/alire-config-edit.ads | 130 +++++++ src/alire/alire-config.adb | 357 +----------------- src/alire/alire-config.ads | 144 ++----- src/alire/alire-features-index.adb | 10 +- src/alire/alire-publish.adb | 4 +- src/alire/alire-selftest.adb | 2 +- .../alire-utils-user_input-query_config.adb | 2 +- src/alr/alr-commands-config.adb | 12 +- src/alr/alr-commands-index.adb | 10 +- src/alr/alr-commands.adb | 8 +- src/alr/alr-paths.ads | 4 +- src/alr/alr-utils-auto_gpr_with.adb | 2 +- src/alr/os_windows/alr-platforms-windows.adb | 5 +- 14 files changed, 509 insertions(+), 508 deletions(-) diff --git a/src/alire/alire-config-edit.adb b/src/alire/alire-config-edit.adb index 6cd4e5ef..2d0b458f 100644 --- a/src/alire/alire-config-edit.adb +++ b/src/alire/alire-config-edit.adb @@ -1,12 +1,18 @@ with Ada.Text_IO; with Ada.Directories; -with TOML; use TOML; +with Alire.Environment; +with Alire.Platform; -with Alire; +with GNAT.Regexp; + +with TOML.File_IO; package body Alire.Config.Edit is + use Ada.Strings.Unbounded; + use TOML; + procedure Write_Config_File (Table : TOML_Value; Path : Absolute_Path) with Pre => Table.Kind = TOML_Table; @@ -130,7 +136,8 @@ package body Alire.Config.Edit is if not Valid_Builtin (Key, To_Add) then Raise_Checked_Error ("Invalid value '" & Value & "' for builtin configuration. " & - Image (Kind_Of_Builtin (Key)) & " expected."); + Image (Kind_Of_Builtin (Key)) & + " expected."); end if; if Table.Is_Null then @@ -164,4 +171,318 @@ package body Alire.Config.Edit is Set (Filepath (Global), Key, Value); end Set_Globally; + -------------- + -- Filepath -- + -------------- + + function Filepath (Lvl : Level) return Absolute_Path is + begin + case Lvl is + when Global => + return Alire.Config.Edit.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.toml"; + 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"); + elsif not Valid_Builtin (Key, Ent.Value) then + Trace.Error ("Invalid value for builtin 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; + + ----------- + -- Image -- + ----------- + + function Image (Kind : Builtin_Kind) return String + is (case Kind is + when Cfg_Int => "Integer", + when Cfg_Float => "Float", + when Cfg_Bool => "Boolean", + when Cfg_String => "String", + when Cfg_Absolute_Path => "Absolute path", + when Cfg_Email => "Email address", + when Cfg_GitHub_Login => "GitHub login"); + + ---------------- + -- Is_Builtin -- + ---------------- + + function Is_Builtin (Key : Config_Key) return Boolean + is (for some Cfg of Builtins => To_String (Cfg.Key) = Key); + + --------------------- + -- Kind_Of_Builtin -- + --------------------- + + function Kind_Of_Builtin (Key : Config_Key) return Builtin_Kind is + begin + for Ent of Builtins loop + if To_String (Ent.Key) = Key then + return Ent.Kind; + end if; + end loop; + + Raise_Checked_Error ("Kind is only valid for builtin config key"); + end Kind_Of_Builtin; + + ---------- + -- 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; + + ----------------- + -- Load_Config -- + ----------------- + + procedure Load_Config is + begin + Config_Map.Clear; + + for Lvl in Level loop + + if Lvl /= Local or else Directories.Detect_Root_Path /= "" 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; + + -- Set variables elsewhere + + Platform.Disable_Distribution_Detection := + Get (Keys.Distribution_Disable_Detection, False); + if Platform.Disable_Distribution_Detection then + Trace.Debug ("Distribution detection disabled by configuration"); + end if; + + 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; + + ---------- + -- Path -- + ---------- + + function Path return String is + begin + if Config_Path /= null then -- Case with switch (TODO) + return Config_Path.all; + else + return OS_Lib.Getenv (Environment.Config, + Platform.Default_Config_Folder); + end if; + end Path; + + -------------- + -- Set_Path -- + -------------- + + procedure Set_Path (Path : String) is + begin + if Config_Path /= null then + raise Constraint_Error with "Custom path already set"; + else + Config_Path := new String'(Path); + end if; + end Set_Path; + + ------------------- + -- Valid_Builtin -- + ------------------- + + function Valid_Builtin (Key : Config_Key; Value : TOML_Value) + return Boolean + is + begin + for Ent of Builtins loop + if To_String (Ent.Key) = Key then + case Ent.Kind is + when Cfg_Int => + return Value.Kind = TOML_Integer; + when Cfg_Float => + return Value.Kind = TOML_Float; + when Cfg_Bool => + return Value.Kind = TOML_Boolean; + when Cfg_String => + return Value.Kind = TOML_String; + when Cfg_Absolute_Path => + return Value.Kind = TOML_String + and then Check_Absolute_Path (Value.As_String); + when Cfg_Email => + return Value.Kind = TOML_String + and then Utils.Could_Be_An_Email (Value.As_String, + With_Name => False); + when Cfg_GitHub_Login => + return Value.Kind = TOML_String + and then Utils.Is_Valid_GitHub_Username (Value.As_String); + end case; + end if; + end loop; + + -- Not a builtin + return True; + end Valid_Builtin; + + ------------------- + -- Builtins_Info -- + ------------------- + + function Builtins_Info return Alire.Utils.String_Vector is + use Alire.Utils; + Results : Alire.Utils.String_Vector; + begin + for Ent of Builtins loop + Results.Append (String'("- " & To_String (Ent.Key) & + " [" & Image (Ent.Kind) & "]")); + Results.Append (To_String (Ent.Help)); + Results.Append (""); + end loop; + return Results; + end Builtins_Info; + + ------------------------ + -- Print_Builtins_Doc -- + ------------------------ + + procedure Print_Builtins_Doc is + use Ada.Text_IO; + begin + for Ent of Builtins loop + Put (" - **`" & To_String (Ent.Key) & "`** "); + Put_Line ("[" & Image (Ent.Kind) & "]:"); + Put_Line (" " & To_String (Ent.Help)); + New_Line; + end loop; + end Print_Builtins_Doc; + +begin + Load_Config; + end Alire.Config.Edit; diff --git a/src/alire/alire-config-edit.ads b/src/alire/alire-config-edit.ads index 7af246f0..7a46e91f 100644 --- a/src/alire/alire-config-edit.ads +++ b/src/alire/alire-config-edit.ads @@ -1,3 +1,5 @@ +with Alire.Directories; + package Alire.Config.Edit is procedure Unset (Path : Absolute_Path; Key : Config_Key); @@ -10,4 +12,132 @@ package Alire.Config.Edit is procedure Set_Globally (Key : Config_Key; Value : String); + -- To ease the pain with circularities in old GNAT versions, we have also + -- here all non-preelaborable things related to config loading. This + -- way, querying stays preelaborable. + + function Path return String; + -- 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 + -- * Default per-platform path (see alire-platforms-*) + + procedure Set_Path (Path : String); + -- Override global config folder path + + function Indexes_Directory return Absolute_Path is (Path / "indexes"); + + function Filepath (Lvl : Level) return Absolute_Path + with Pre => Lvl /= Local or else Directories.Detect_Root_Path /= ""; + -- Return path of the configuration file coresponding to the given + -- configuration level. + + 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. + + function Builtins_Info return Alire.Utils.String_Vector; + -- Return a String_Vector with the documentation of builtin configuration + -- options in text format. + + procedure Print_Builtins_Doc; + -- Print a Markdown documentation for the built-in configuration options + +private + + procedure Import (Table : TOML.TOML_Value; + Lvl : Level; + Source : String; + Prefix : String := ""); + -- Import TOML Table in the Config_Map global variable + + procedure Load_Config; + -- Clear an reload all configuration. Also set some values elsewhere used + -- to break circularities. Bottom line, this procedure must leave the + -- program-wide configuration ready. + + 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. + + type Builtin_Kind is (Cfg_Int, Cfg_Float, Cfg_Bool, + Cfg_String, Cfg_Absolute_Path, + Cfg_Email, Cfg_GitHub_Login); + + type Builtin_Entry is record + Key : Ada.Strings.Unbounded.Unbounded_String; + Kind : Builtin_Kind; + Help : Ada.Strings.Unbounded.Unbounded_String; + end record; + + function Image (Kind : Builtin_Kind) return String; + + function Is_Builtin (Key : Config_Key) return Boolean; + + function Kind_Of_Builtin (Key : Config_Key) return Builtin_Kind + with Pre => Is_Builtin (Key); + + function Valid_Builtin (Key : Config_Key; Value : TOML.TOML_Value) + return Boolean; + + -------------- + -- Builtins -- + -------------- + + Builtins : constant array (Natural range <>) of Builtin_Entry := + ( + (+Keys.User_Name, + Cfg_String, + +("User full name. Used for the authors and " & + "maintainers field of a new crate.")), + (+Keys.User_Email, + Cfg_Email, + +("User email address. Used for the authors and" & + " maintainers field of a new crate.")), + (+Keys.User_Github_Login, + Cfg_GitHub_Login, + +("User GitHub login/username. Used to for the maintainers-logins " & + "field of a new crate.")), + + (+Keys.Editor_Cmd, + Cfg_String, + +("Editor command and arguments for editing crate code (alr edit)." & + " The executables and arguments are separated by a single space" & + " character. The token ${GPR_FILE} is replaced by" & + " a path to the project file to open.")), + + (+"msys2.do_not_install", + Cfg_Bool, + +("If true, Alire will not try to automatically" & + " install msys2 system package manager. (Windows only)")), + + (+"msys2.install_dir", + Cfg_Absolute_Path, + +("Directory where Alire will detect and/or install" & + " msys2 system package manager. (Windows only)")), + + (+"auto-gpr-with", + Cfg_Bool, + +("If true, Alire will automatically add/edit a list of 'with' " & + "statements in the root GPR project file based on the " & + "dependencies of the crate.")), + + (+Keys.Update_Manually, + Cfg_Bool, + +("If true, Alire will not attempt to update dependencies even after " + & "the manifest is manually edited, or when no valid solution has " + & "been ever computed. All updates have to be manually requested " + & "through `alr update`")), + + (+Keys.Distribution_Disable_Detection, + Cfg_Bool, + +("If true, Alire will report an unknown distribution and will not" + & " attempt to use the system package manager.")) + + ); + end Alire.Config.Edit; diff --git a/src/alire/alire-config.adb b/src/alire/alire-config.adb index 5e961289..c9aa381b 100644 --- a/src/alire/alire-config.adb +++ b/src/alire/alire-config.adb @@ -1,50 +1,16 @@ -with Ada.Containers.Hashed_Maps; -with Ada.Strings.Unbounded.Hash; -with Ada.Text_IO; - -with GNAT.Regexp; - -with Alire.Environment; -with Alire.Platform; - -with TOML.File_IO; +with TOML; use TOML; 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 No_Config_Value return Config_Value + is (Source => UStrings.Null_Unbounded_String, + Value => TOML.No_TOML_Value, + Lvl => Global); 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 -- ----------- @@ -81,33 +47,6 @@ package body Alire.Config is end case; end Image; - ---------- - -- Path -- - ---------- - - function Path return String is - begin - if Config_Path /= null then -- Case with switch (TODO) - return Config_Path.all; - else - return OS_Lib.Getenv (Environment.Config, - Platform.Default_Config_Folder); - end if; - end Path; - - -------------- - -- Set_Path -- - -------------- - - procedure Set_Path (Path : String) is - begin - if Config_Path /= null then - raise Constraint_Error with "Custom path already set"; - else - Config_Path := new String'(Path); - end if; - end Set_Path; - ------------- -- Defined -- ------------- @@ -235,185 +174,6 @@ package body Alire.Config is 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.toml"; - 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"); - elsif not Valid_Builtin (Key, Ent.Value) then - Trace.Error ("Invalid value for builtin 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 - Config_Map.Clear; - - for Lvl in Level loop - - if Lvl /= Local or else Directories.Detect_Root_Path /= "" 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; - - -- Set variables elsewhere - - Platform.Disable_Distribution_Detection := - Get (Keys.Distribution_Disable_Detection, False); - if Platform.Disable_Distribution_Detection then - Trace.Debug ("Distribution detection disabled by configuration"); - end if; - - 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; - ------------------- -- To_TOML_Value -- ------------------- @@ -437,111 +197,4 @@ package body Alire.Config is end if; end To_TOML_Value; - ----------- - -- Image -- - ----------- - - function Image (Kind : Builtin_Kind) return String - is (case Kind is - when Cfg_Int => "Integer", - when Cfg_Float => "Float", - when Cfg_Bool => "Boolean", - when Cfg_String => "String", - when Cfg_Absolute_Path => "Absolute path", - when Cfg_Email => "Email address", - when Cfg_GitHub_Login => "GitHub login"); - - --------------------- - -- Kind_Of_Builtin -- - --------------------- - - function Kind_Of_Builtin (Key : Config_Key) return Builtin_Kind is - begin - for Ent of Builtins loop - if To_String (Ent.Key) = Key then - return Ent.Kind; - end if; - end loop; - - Raise_Checked_Error ("Kind is only valid for builtin config key"); - end Kind_Of_Builtin; - - ------------------- - -- Builtins_Info -- - ------------------- - - function Builtins_Info return Alire.Utils.String_Vector is - use Alire.Utils; - Results : Alire.Utils.String_Vector; - begin - for Ent of Builtins loop - Results.Append (String'("- " & To_String (Ent.Key) & - " [" & Image (Ent.Kind) & "]")); - Results.Append (To_String (Ent.Help)); - Results.Append (""); - end loop; - return Results; - end Builtins_Info; - - ------------------------ - -- Print_Builtins_Doc -- - ------------------------ - - procedure Print_Builtins_Doc is - use Ada.Text_IO; - begin - for Ent of Builtins loop - Put (" - **`" & To_String (Ent.Key) & "`** "); - Put_Line ("[" & Image (Ent.Kind) & "]:"); - Put_Line (" " & To_String (Ent.Help)); - New_Line; - end loop; - end Print_Builtins_Doc; - - ---------------- - -- Is_Builtin -- - ---------------- - - function Is_Builtin (Key : Config_Key) return Boolean - is (for some Cfg of Builtins => To_String (Cfg.Key) = Key); - - ------------------- - -- Valid_Builtin -- - ------------------- - - function Valid_Builtin (Key : Config_Key; Value : TOML_Value) - return Boolean - is - begin - for Ent of Builtins loop - if To_String (Ent.Key) = Key then - case Ent.Kind is - when Cfg_Int => - return Value.Kind = TOML_Integer; - when Cfg_Float => - return Value.Kind = TOML_Float; - when Cfg_Bool => - return Value.Kind = TOML_Boolean; - when Cfg_String => - return Value.Kind = TOML_String; - when Cfg_Absolute_Path => - return Value.Kind = TOML_String - and then Check_Absolute_Path (Value.As_String); - when Cfg_Email => - return Value.Kind = TOML_String - and then Utils.Could_Be_An_Email (Value.As_String, - With_Name => False); - when Cfg_GitHub_Login => - return Value.Kind = TOML_String - and then Utils.Is_Valid_GitHub_Username (Value.As_String); - end case; - end if; - end loop; - - -- Not a builtin - return True; - end Valid_Builtin; - -begin - Load_Config; end Alire.Config; diff --git a/src/alire/alire-config.ads b/src/alire/alire-config.ads index 415e8a3f..f96e1e80 100644 --- a/src/alire/alire-config.ads +++ b/src/alire/alire-config.ads @@ -1,10 +1,12 @@ -with Alire.Directories; with Alire.OS_Lib; use Alire.OS_Lib.Operators; with Alire.Utils; with TOML; -package Alire.Config is +private with Ada.Containers.Hashed_Maps; +private with Ada.Strings.Unbounded.Hash; + +package Alire.Config with Preelaborate is function Is_Valid_Config_Key (Key : String) return Boolean is ((for all C of Key => C in '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' | @@ -60,20 +62,8 @@ package Alire.Config is -- 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 Directories.Detect_Root_Path /= ""; - -- 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. @@ -81,35 +71,10 @@ package Alire.Config is -- from command-line but set by someone else that has done the parsing. -- Right now the only client is alr. - ----------- - -- Paths -- - ----------- - - function Path return String; - -- 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 - -- * Default per-platform path (see alire-platforms-*) - - -- Detection happens during elaboration. - - procedure Set_Path (Path : String); - -- Override global config folder path - - function Indexes_Directory return Absolute_Path is (Path / "indexes"); - --------------- -- Built-ins -- --------------- - function Builtins_Info return Alire.Utils.String_Vector; - -- Return a String_Vector with the documentation of builtin configuration - -- options in text format. - - procedure Print_Builtins_Doc; - -- Print a Markdown documentation for the built-in configuration options - package Keys is -- A few predefined keys that are used in several places. This list is @@ -134,15 +99,6 @@ package Alire.Config is private - procedure Load_Config; - -- Clear an reload all configuration. Also set some values elsewhere used - -- to break circularities. Bottom line, this procedure must leave the - -- program-wide configuration ready. - - 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; @@ -161,83 +117,25 @@ private -- Use the TOML parser to convert the string Str. If Str is not a valid -- TOML value, No_TOML_Value is returned. - -------------- - -- Builtins -- - -------------- + type Config_Value is record + Source : Ada.Strings.Unbounded.Unbounded_String; + Value : TOML.TOML_Value; + Lvl : Level; + end record; - type Builtin_Kind is (Cfg_Int, Cfg_Float, Cfg_Bool, - Cfg_String, Cfg_Absolute_Path, - Cfg_Email, Cfg_GitHub_Login); + function No_Config_Value return Config_Value; - type Builtin_Entry is record - Key : Ada.Strings.Unbounded.Unbounded_String; - Kind : Builtin_Kind; - Help : Ada.Strings.Unbounded.Unbounded_String; - end record; + package Config_Maps is new Ada.Containers.Hashed_Maps + (Key_Type => Ada.Strings.Unbounded.Unbounded_String, + Element_Type => Config_Value, + Hash => Ada.Strings.Unbounded.Hash, + Equivalent_Keys => Ada.Strings.Unbounded."="); + + Config_Map : Config_Maps.Map; + + function Image (Val : TOML.TOML_Value) return String; - function Is_Builtin (Key : Config_Key) return Boolean; - - function Valid_Builtin (Key : Config_Key; Value : TOML.TOML_Value) - return Boolean; - - function Image (Kind : Builtin_Kind) return String; - - function Kind_Of_Builtin (Key : Config_Key) return Builtin_Kind - with Pre => Is_Builtin (Key); - - function "+" (Source : String) return Ada.Strings.Unbounded.Unbounded_String - renames Ada.Strings.Unbounded.To_Unbounded_String; - - Builtins : constant array (Natural range <>) of Builtin_Entry := - ( - (+Keys.User_Name, - Cfg_String, - +("User full name. Used for the authors and " & - "maintainers field of a new crate.")), - (+Keys.User_Email, - Cfg_Email, - +("User email address. Used for the authors and" & - " maintainers field of a new crate.")), - (+Keys.User_Github_Login, - Cfg_GitHub_Login, - +("User GitHub login/username. Used to for the maintainers-logins " & - "field of a new crate.")), - - (+Keys.Editor_Cmd, - Cfg_String, - +("Editor command and arguments for editing crate code (alr edit)." & - " The executables and arguments are separated by a single space" & - " character. The token ${GPR_FILE} is replaced by" & - " a path to the project file to open.")), - - (+"msys2.do_not_install", - Cfg_Bool, - +("If true, Alire will not try to automatically" & - " install msys2 system package manager. (Windows only)")), - - (+"msys2.install_dir", - Cfg_Absolute_Path, - +("Directory where Alire will detect and/or install" & - " msys2 system package manager. (Windows only)")), - - (+"auto-gpr-with", - Cfg_Bool, - +("If true, Alire will automatically add/edit a list of 'with' " & - "statements in the root GPR project file based on the " & - "dependencies of the crate.")), - - (+Keys.Update_Manually, - Cfg_Bool, - +("If true, Alire will not attempt to update dependencies even after " - & "the manifest is manually edited, or when no valid solution has " - & "been ever computed. All updates have to be manually requested " - & "through `alr update`")), - - (+Keys.Distribution_Disable_Detection, - Cfg_Bool, - +("If true, Alire will report an unknown distribution and will not" - & " attempt to use the system package manager.")) - - ); + type String_Access is access String; + Config_Path : String_Access; end Alire.Config; diff --git a/src/alire/alire-features-index.adb b/src/alire/alire-features-index.adb index f815a0d2..e9a8ba7b 100644 --- a/src/alire/alire-features-index.adb +++ b/src/alire/alire-features-index.adb @@ -1,6 +1,6 @@ with Ada.Directories; -with Alire.Config; +with Alire.Config.Edit; with Alire.Directories; with Alire.Errors; with Alire.Index; @@ -151,7 +151,7 @@ package body Alire.Features.Index is Result : Outcome with Warnings => Off; -- Spurious warning to be silenced in Debian stable/Ubuntu LTS GNATs. Indexes : constant Sets.Set := - Find_All (Config.Indexes_Directory, Result); + Find_All (Config.Edit.Indexes_Directory, Result); use Sets; begin Trace.Debug ("Resetting community index..."); @@ -164,7 +164,7 @@ package body Alire.Features.Index is return Add (Origin => Alire.Index.Community_Repo & "@" & Alire.Index.Community_Branch, Name => Alire.Index.Community_Name, - Under => Config.Indexes_Directory, + Under => Config.Edit.Indexes_Directory, Before => (if Has_Element (Next (I)) then Indexes (Next (I)).Name else "")); @@ -177,7 +177,7 @@ package body Alire.Features.Index is return Add (Origin => Alire.Index.Community_Repo & "@" & Alire.Index.Community_Branch, Name => Alire.Index.Community_Name, - Under => Config.Indexes_Directory); + Under => Config.Edit.Indexes_Directory); exception when E : Checked_Error => return Outcome_From_Exception (E); @@ -221,7 +221,7 @@ package body Alire.Features.Index is declare Outcome : constant Alire.Outcome := Features.Index.Load_All - (From => Alire.Config.Indexes_Directory); + (From => Alire.Config.Edit.Indexes_Directory); begin if not Outcome.Success then Raise_Checked_Error (Message (Outcome)); diff --git a/src/alire/alire-publish.adb b/src/alire/alire-publish.adb index 74d2f0bc..efe86b6e 100644 --- a/src/alire/alire-publish.adb +++ b/src/alire/alire-publish.adb @@ -1,7 +1,7 @@ with Ada.Directories; with Ada.Text_IO; -with Alire.Config; +with Alire.Config.Edit; with Alire.Crates; with Alire.Directories; with Alire.Errors; @@ -496,7 +496,7 @@ package body Alire.Publish is -- Check not duplicated - Features.Index.Setup_And_Load (From => Config.Indexes_Directory); + Features.Index.Setup_And_Load (From => Config.Edit.Indexes_Directory); if Index.Exists (Release.Name, Release.Version) then Raise_Checked_Error ("Target release " & Release.Milestone.TTY_Image diff --git a/src/alire/alire-selftest.adb b/src/alire/alire-selftest.adb index 61230c0e..6c4984ab 100644 --- a/src/alire/alire-selftest.adb +++ b/src/alire/alire-selftest.adb @@ -13,7 +13,7 @@ package body Alire.Selftest is Key : constant String := "test_key"; Val : constant String := "nominal"; begin - Config.Edit.Set (Config.Filepath (Config.Global), Key, Val); + Config.Edit.Set (Config.Edit.Filepath (Config.Global), Key, Val); pragma Assert (Config.Defined (Key)); pragma Assert (Config.Get (Key, "snafu") = Val); end Check_Config_Changes; diff --git a/src/alire/alire-utils-user_input-query_config.adb b/src/alire/alire-utils-user_input-query_config.adb index c3a72e5d..fae16736 100644 --- a/src/alire/alire-utils-user_input-query_config.adb +++ b/src/alire/alire-utils-user_input-query_config.adb @@ -22,7 +22,7 @@ package body Alire.Utils.User_Input.Query_Config is Query_String (Question, Default, Validation); begin if Result /= Default then - Edit.Set (Filepath (Global), Config_Key, Result); + Edit.Set (Config.Edit.Filepath (Global), Config_Key, Result); end if; return Result; diff --git a/src/alr/alr-commands-config.adb b/src/alr/alr-commands-config.adb index a47a43a3..73d8cad1 100644 --- a/src/alr/alr-commands-config.adb +++ b/src/alr/alr-commands-config.adb @@ -37,7 +37,7 @@ package body Alr.Commands.Config is end if; if Cmd.Builtins_Doc then - Alire.Config.Print_Builtins_Doc; + Alire.Config.Edit.Print_Builtins_Doc; return; end if; @@ -50,11 +50,11 @@ package body Alr.Commands.Config is if Cmd.List then case Num_Arguments is when 0 => - Trace.Always (Alire.Config.List + Trace.Always (Alire.Config.Edit.List (Filter => "*", Show_Origin => Cmd.Show_Origin)); when 1 => - Trace.Always (Alire.Config.List + Trace.Always (Alire.Config.Edit.List (Filter => Argument (1), Show_Origin => Cmd.Show_Origin)); when others => @@ -93,7 +93,7 @@ package body Alr.Commands.Config is Key & "'"); end if; - Alire.Config.Edit.Set (Alire.Config.Filepath (Lvl), Key, Val); + Alire.Config.Edit.Set (Alire.Config.Edit.Filepath (Lvl), Key, Val); end; elsif Cmd.Unset then @@ -109,7 +109,7 @@ package body Alr.Commands.Config is Key & "'"); end if; - Alire.Config.Edit.Unset (Alire.Config.Filepath (Lvl), Key); + Alire.Config.Edit.Unset (Alire.Config.Edit.Filepath (Lvl), Key); end; end if; end Execute; @@ -145,7 +145,7 @@ package body Alr.Commands.Config is .New_Line .Append ("Built-in configuration options:") .New_Line - .Append (Alire.Config.Builtins_Info)); + .Append (Alire.Config.Edit.Builtins_Info)); -------------------- -- Setup_Switches -- diff --git a/src/alr/alr-commands-index.adb b/src/alr/alr-commands-index.adb index 278ad226..bc1dd76a 100644 --- a/src/alr/alr-commands-index.adb +++ b/src/alr/alr-commands-index.adb @@ -1,6 +1,6 @@ with AAA.Table_IO; -with Alire.Config; +with Alire.Config.Edit; with Alire.Features.Index; with Alire.Index_On_Disk; with Alire.TOML_Expressions; @@ -29,7 +29,7 @@ package body Alr.Commands.Index is Alire.Features.Index.Add (Origin => Cmd.Add.all, Name => Cmd.Name.all, - Under => Alire.Config.Indexes_Directory, + Under => Alire.Config.Edit.Indexes_Directory, Before => Before); begin Trace.Debug ("Index before ID = " & Before); @@ -47,7 +47,7 @@ package body Alr.Commands.Index is Result : Alire.Outcome; Indexes : constant Alire.Features.Index.Index_On_Disk_Set := Alire.Features.Index.Find_All - (Alire.Config.Indexes_Directory, Result); + (Alire.Config.Edit.Indexes_Directory, Result); Found : Boolean := False; begin if not Result.Success then @@ -138,7 +138,7 @@ package body Alr.Commands.Index is Result : Alire.Outcome; Indexes : constant Alire.Features.Index.Index_On_Disk_Set := Alire.Features.Index.Find_All - (Alire.Config.Indexes_Directory, Result); + (Alire.Config.Edit.Indexes_Directory, Result); Table : AAA.Table_IO.Table; Count : Natural := 0; @@ -276,7 +276,7 @@ package body Alr.Commands.Index is procedure Update_All is Result : constant Alire.Outcome := Alire.Features.Index.Update_All - (Alire.Config.Indexes_Directory); + (Alire.Config.Edit.Indexes_Directory); begin if not Result.Success then Reportaise_Command_Failed (Alire.Message (Result)); diff --git a/src/alr/alr-commands.adb b/src/alr/alr-commands.adb index edf96d08..48af2dee 100644 --- a/src/alr/alr-commands.adb +++ b/src/alr/alr-commands.adb @@ -8,7 +8,7 @@ with Ada.Text_IO; use Ada.Text_IO; with Alire_Early_Elaboration; with Alire; -with Alire.Config; +with Alire.Config.Edit; with Alire.Errors; with Alire.Features.Index; with Alire.Lockfiles; @@ -242,7 +242,7 @@ package body Alr.Commands is procedure Create_Alire_Folders is use GNATCOLL.VFS; begin - Make_Dir (Create (+Alire.Config.Path)); + Make_Dir (Create (+Alire.Config.Edit.Path)); end Create_Alire_Folders; ------------------- @@ -407,7 +407,7 @@ package body Alr.Commands is procedure Requires_Full_Index (Force_Reload : Boolean := False) is begin Alire.Features.Index.Setup_And_Load - (From => Alire.Config.Indexes_Directory, + (From => Alire.Config.Edit.Indexes_Directory, Force => Force_Reload); end Requires_Full_Index; @@ -726,7 +726,7 @@ package body Alr.Commands is if Command_Line_Config_Path /= null and then Command_Line_Config_Path.all /= "" then - Alire.Config.Set_Path (Command_Line_Config_Path.all); + Alire.Config.Edit.Set_Path (Command_Line_Config_Path.all); end if; exception diff --git a/src/alr/alr-paths.ads b/src/alr/alr-paths.ads index 5ea553fb..a354616d 100644 --- a/src/alr/alr-paths.ads +++ b/src/alr/alr-paths.ads @@ -1,7 +1,7 @@ with Ada.Directories; with Alire; -with Alire.Config; +with Alire.Config.Edit; with Alire.Environment; with Alr.Defaults; @@ -85,7 +85,7 @@ private -- Or because they can be set after elaboration (e.g. via config switches) function Alr_Config_Folder return String - is (Alire.Config.Path); + is (Alire.Config.Edit.Path); function Alr_Source_Folder return String is (OS_Lib.Getenv (Alire.Environment.Source, Alr_Config_Folder / "alire")); diff --git a/src/alr/alr-utils-auto_gpr_with.adb b/src/alr/alr-utils-auto_gpr_with.adb index b8e3eee6..6a09ffd7 100644 --- a/src/alr/alr-utils-auto_gpr_with.adb +++ b/src/alr/alr-utils-auto_gpr_with.adb @@ -48,7 +48,7 @@ package body Alr.Utils.Auto_GPR_With is Valid => (Yes | No => True, others => False), Default => No) = Yes then - Edit.Set (Alire.Config.Filepath (Global), "auto-gpr-with", + Edit.Set (Alire.Config.Edit.Filepath (Global), "auto-gpr-with", (if Result then "true" else "false")); end if; diff --git a/src/alr/os_windows/alr-platforms-windows.adb b/src/alr/os_windows/alr-platforms-windows.adb index 168d82a7..0088c830 100644 --- a/src/alr/os_windows/alr-platforms-windows.adb +++ b/src/alr/os_windows/alr-platforms-windows.adb @@ -10,7 +10,6 @@ with Alire.OS_Lib.Subprocess; with Alire.OS_Lib.Download; with Alire.Utils; with Alire.Utils.User_Input; -with Alire.Config; with Alire.Config.Edit; with Alr.OS_Lib; use Alr.OS_Lib; @@ -87,7 +86,7 @@ package body Alr.Platforms.Windows is Default => No) = Yes then -- Save user choice in the global config - Cfg.Edit.Set (Path => Cfg.Filepath (Cfg.Global), + Cfg.Edit.Set (Path => Cfg.Edit.Filepath (Cfg.Global), Key => "msys2.do_not_install", Value => "true"); end if; @@ -146,7 +145,7 @@ package body Alr.Platforms.Windows is if not Cfg.Defined ("msys2.install_dir") then -- Save msys2 install dir in the global config - Cfg.Edit.Set (Path => Cfg.Filepath (Cfg.Global), + Cfg.Edit.Set (Path => Cfg.Edit.Filepath (Cfg.Global), Key => "msys2.install_dir", Value => Install_Dir); end if; -- 2.39.5