Build profiles and switches system

src/alire/alire-crate_configuration.ads

@@ -7,6 +7,9 @@ private with Ada.Strings.Unbounded;
 private with Ada.Containers.Hashed_Maps;
 private with Ada.Strings.Unbounded.Hash;
 private with Ada.Containers.Indefinite_Holders;
+private with Ada.Containers.Indefinite_Ordered_Maps;
+
+private with Alire.Utils.Switches;
 
 package Alire.Crate_Configuration is
 
@@ -21,6 +24,8 @@ package Alire.Crate_Configuration is
 private
 
    use Alire.Properties.Configurations;
+   use type Alire.Utils.Switches.Profile_Kind;
+   use type Alire.Utils.Switches.Switch_List;
 
    package Config_Type_Definition_Holder
    is new Ada.Containers.Indefinite_Holders (Config_Type_Definition);
@@ -37,18 +42,37 @@ private
       Hash            => Ada.Strings.Unbounded.Hash,
       Equivalent_Keys => Ada.Strings.Unbounded."=");
 
+   package Profile_Maps
+   is new Ada.Containers.Indefinite_Ordered_Maps
+     (Crate_Name, Alire.Utils.Switches.Profile_Kind);
+
+   package Switches_Maps
+   is new Ada.Containers.Indefinite_Ordered_Maps
+     (Crate_Name, Alire.Utils.Switches.Switch_List);
+
    type Global_Config is tagged limited record
       Map : Config_Maps.Map;
+
+      Profile_Map  : Profile_Maps.Map;
+      Switches_Map : Switches_Maps.Map;
    end record;
 
    procedure Use_Default_Values (Conf : in out Global_Config);
    --  Use default value for unset variable, raise Checked_Error if a variable
    --  has no default value.
 
+   procedure Add_Definition (This     : in out Global_Config;
+                             Crate    : Crate_Name;
+                             Type_Def : Config_Type_Definition);
+
    procedure Load_Definitions (This  : in out Global_Config;
                                Root  : in out Roots.Root;
                                Crate : Crate_Name);
 
+   procedure Set_Value (This  : in out Global_Config;
+                        Crate : Crate_Name;
+                        Val   : Assignment);
+
    procedure Load_Settings (This  : in out Global_Config;
                             Root  : in out Roots.Root;
                             Crate : Crate_Name);
@@ -58,11 +82,11 @@ private
                                   Filepath : Absolute_Path;
                                   Version  : String);
 
-   procedure Generate_GPR_Config (This     : Global_Config;
-                                  Crate    : Crate_Name;
-                                  Filepath : Absolute_Path;
-                                  Withs    : AAA.Strings.Set;
-                                  Version  : String);
+   procedure Generate_GPR_Config (This        : Global_Config;
+                                  Crate       : Crate_Name;
+                                  Filepath    : Absolute_Path;
+                                  Withs       : AAA.Strings.Set;
+                                  Version     : String);
 
    procedure Generate_C_Config (This     : Global_Config;
                                 Crate    : Crate_Name;

src/alire/alire-properties-build_profile.adb

@@ -0,0 +1,168 @@
+with Alire.TOML_Keys;
+
+with Alire.Utils.Switches; use Alire.Utils.Switches;
+
+package body Alire.Properties.Build_Profile is
+
+   -----------
+   -- Image --
+   -----------
+
+   overriding
+   function Image (This : Variable) return String
+   is ("Build Profile: ");
+
+   ---------
+   -- Key --
+   ---------
+
+   overriding
+   function Key (This : Variable) return String is
+      pragma Unreferenced (This);
+   begin
+      return TOML_Keys.Build_Profile;
+   end Key;
+
+   ---------------
+   -- From_TOML --
+   ---------------
+
+   function From_TOML (From : TOML_Adapters.Key_Queue)
+                       return Conditional.Properties
+   is
+      use type Conditional.Properties;
+      use TOML;
+      Env : TOML_Value;
+
+      Var : Variable;
+   begin
+      if From.Unwrap.Kind /= TOML_Table then
+         From.Checked_Error
+           ("Build: table with assignments expected, but got: "
+            & From.Unwrap.Kind'Img);
+      end if;
+
+      if From.Pop_Single_Table (Env, TOML_Table) /= TOML_Keys.Build_Profile
+      then
+         raise Program_Error;
+         --  Can't happen, unless the dispatch to us itself was erroneous
+      end if;
+
+      Var.T := Env.Clone;
+
+      --  Check that the data is valid
+      for Crate of Env.Keys loop
+         declare
+            Crate_Str : constant String := +Crate;
+            Profile : constant TOML_Value := Env.Get (Crate);
+         begin
+
+            if Profile.Kind /= TOML_String then
+               From.Checked_Error ("Should be string");
+            end if;
+
+            declare
+               Profile_Str : constant String := Profile.As_String;
+            begin
+
+               if Crate_Str = "*" then
+
+                  if Var.Wildcard_Found then
+                     From.Checked_Error
+                       ("Multiple definition of wildcard (""*"")" &
+                          " build profile");
+                  else
+                     Var.Wildcard_Found := True;
+                  end if;
+
+               elsif not Is_Valid_Name (Crate_Str) then
+                  From.Checked_Error
+                    ("Invalid crate name for build profile (" &
+                       Error_In_Name (Crate_Str) & ")");
+               else
+
+                  declare
+                     Unused : Profile_Kind;
+                  begin
+                     Unused := Profile_Kind'Value (Profile_Str);
+                  exception
+                     when Constraint_Error =>
+                        From.Checked_Error
+                          ("Invalid build profile name: '" & Profile_Str
+                           & "' for '" & Crate_Str & "'");
+                  end;
+               end if;
+            end;
+
+            Env.Unset (+Crate);
+         end;
+      end loop;
+
+      return Props : Conditional.Properties do
+         Props := Props and Var;
+      end return;
+   end From_TOML;
+
+   -------------
+   -- To_TOML --
+   -------------
+
+   overriding
+   function To_TOML (This : Variable) return TOML.TOML_Value is
+   begin
+      return This.T.Clone;
+   end To_TOML;
+
+   -------------
+   -- To_YAML --
+   -------------
+
+   overriding
+   function To_YAML (This : Variable) return String
+   is ("Build profile: []");
+
+   ---------------
+   -- Selection --
+   ---------------
+
+   function Selection (This : Variable) return Profile_Selection_Maps.Map
+   is
+   begin
+      return Result : Profile_Selection_Maps.Map do
+         for Crate of This.T.Keys loop
+            if (+Crate) /= "*" then
+               declare
+                  Val : constant TOML.TOML_Value := This.T.Get (Crate);
+               begin
+                  Result.Insert (+(+Crate),
+                                 Profile_Kind'Value (Val.As_String));
+               end;
+            end if;
+         end loop;
+      end return;
+   end Selection;
+
+   ------------------
+   -- Has_Wildcard --
+   ------------------
+
+   function Has_Wildcard (This : Variable) return Boolean is
+   begin
+      return This.Wildcard_Found;
+   end Has_Wildcard;
+
+   --------------
+   -- Wildcard --
+   --------------
+
+   function Wildcard (This : Variable) return Profile_Kind is
+   begin
+      for Crate of This.T.Keys loop
+         if (+Crate) = "*" then
+            return Profile_Kind'Value (This.T.Get (Crate).As_String);
+         end if;
+      end loop;
+      raise Program_Error;
+   end Wildcard;
+
+end Alire.Properties.Build_Profile;

src/alire/alire-properties-build_profile.ads

@@ -0,0 +1,51 @@
+with Ada.Containers.Indefinite_Ordered_Maps;
+
+with Alire.Conditional;
+with Alire.TOML_Adapters;
+with Alire.Utils.Switches;
+
+private with TOML;
+
+package Alire.Properties.Build_Profile with Preelaborate is
+
+   use type Utils.Switches.Profile_Kind;
+
+   package Profile_Selection_Maps
+   is new Ada.Containers.Indefinite_Ordered_Maps
+     (Crate_Name,
+      Utils.Switches.Profile_Kind);
+
+   type Variable is new Property with private;
+
+   function Selection (This : Variable) return Profile_Selection_Maps.Map;
+
+   function Has_Wildcard (This : Variable) return Boolean;
+
+   function Wildcard (This : Variable) return Utils.Switches.Profile_Kind
+     with Pre => This.Has_Wildcard;
+
+   --  Inherited operations
+
+   overriding
+   function Image (This : Variable) return String;
+
+   overriding
+   function Key (This : Variable) return String;
+
+   function From_TOML (From : TOML_Adapters.Key_Queue)
+                       return Conditional.Properties;
+
+   overriding
+   function To_TOML (This : Variable) return TOML.TOML_Value;
+
+   overriding
+   function To_YAML (This : Variable) return String;
+
+private
+
+   type Variable is new Property with record
+      Wildcard_Found : Boolean := False;
+      T : TOML.TOML_Value;
+   end record;
+
+end Alire.Properties.Build_Profile;