Preparations for Release code generation (basic)

src/alire-conditional_trees.adb

@@ -2,6 +2,15 @@ with GNAT.IO;
 
 package body Alire.Conditional_Trees is
 
+--     function To_Code (C : Conjunctions) return String is
+--       (case C is
+--           when Anded => "and",
+--           when Ored  => "or");
+
+   ----------------------------
+   -- All_But_First_Children --
+   ----------------------------
+
    function All_But_First_Children (This : Tree) return Tree is
       Children : Vectors.Vector := This.As_Vector;
    begin
@@ -374,6 +383,29 @@ package body Alire.Conditional_Trees is
       end case;
    end Print;
 
+   -------------
+   -- To_Code --
+   -------------
+
+--     function To_Code (This : Tree) return Utils.String_Vector is
+--     begin
+--        case This.Kind is
+--           when Value =>
+--              return To_Code (This.Value);
+--           when Vector =>
+--              return V : Utils.String_Vector do
+--                 for I in This.Iterate loop
+--                    V.Append (This (I).To_Code);
+--                    if Has_Element (Next (I)) then
+--                       V.Append (Conj_To_Code (This (I).Conjunction));
+--                    end if;
+--                 end loop;
+--              end return;
+--           when Condition =>
+--              raise Program_Error with "Unimplemented";
+--        end case;
+--     end To_Code;
+
    -----------------
    --  ITERATORS  --
    -----------------

src/alire-conditional_trees.ads

@@ -172,7 +172,9 @@ private
    end record;
 
    overriding function Image (V : Value_Inner) return String is
-      (Image (V.Value.Constant_Reference));
+     (Image (V.Value.Constant_Reference));
+
+--     overriding function To_Code (This : Tree) return Utils.String_Vector;
 
    type Vector_Inner is new Inner_Node with record
       Conjunction : Conjunctions;

src/alire-interfaces.ads

@@ -0,0 +1,14 @@
+with Alire.Utils;
+
+package Alire.Interfaces with Preelaborate is
+
+   type Codifiable is limited interface;
+   
+   function To_Code (This : Codifiable) return Utils.String_Vector is abstract;
+   
+   
+   type Imaginable is limited interface;
+      
+   function Image (This : Imaginable) return String is abstract;
+
+end Alire.Interfaces;

src/alire-origins.ads

@@ -1,4 +1,6 @@
+with Alire.Interfaces;
 with Alire.Platforms;
+with Alire.Utils;
 
 private with Ada.Strings.Unbounded;
 
@@ -31,7 +33,7 @@ package Alire.Origins with Preelaborate is
                   Native      -- Native platform package
                  );
 
-   type Origin is tagged private;
+   type Origin is new Interfaces.Codifiable with private;
 
    function Kind (This : Origin) return Kinds;
 
@@ -71,6 +73,8 @@ package Alire.Origins with Preelaborate is
 
    function Image (This : Origin) return String;
 
+   overriding function To_Code (This : Origin) return Utils.String_Vector;
+
 private
 
    use Ada.Strings.Unbounded;
@@ -86,7 +90,7 @@ private
    function Unavailable return Package_Names is (Name => Null_Unbounded_String);
    function Packaged_As (Name : String) return Package_Names is (Name => +Name);
 
-   type Origin is tagged record -- Can't use tagged with variant plus default constraint
+   type Origin is new Interfaces.Codifiable with record
       Kind   : Kinds;
 
       Commit : Unbounded_String;
@@ -144,5 +148,10 @@ private
          when Native     => "native package from platform software manager",
          when Filesystem => "path " & S (This.Path));
 
+   overriding function To_Code (This : Origin) return Utils.String_Vector is
+     (if This.Kind = Filesystem
+      then Utils.To_Vector (Path (This))
+      else raise Program_Error with "Unimplemented");
+
 
 end Alire.Origins;

src/alire-releases.adb

@@ -157,6 +157,28 @@ package body Alire.Releases is
       Priv_Props   => Private_Properties,
       Available    => Available);
 
+   -------------------------
+   -- New_Working_Release --
+   -------------------------
+
+   function New_Working_Release
+     (Project      : Alire.Project;
+      Origin       : Origins.Origin := Origins.New_Filesystem (".");
+      Dependencies : Conditional.Dependencies := Conditional.For_Dependencies.Empty;
+      Properties   : Conditional.Properties   := Conditional.For_Properties.Empty)
+      return         Release is
+     (Prj_Len      => Project'Length,
+      Notes_Len    => 0,
+      Project      => Project,
+      Alias        => +"",
+      Version      => +"0.0.0",
+      Origin       => Origin,
+      Notes        => "",
+      Dependencies => Dependencies,
+      Properties   => Properties,
+      Priv_Props   => Conditional.For_Properties.Empty,
+      Available    => Requisites.Booleans.Always_True);
+
    ----------------------------
    -- On_Platform_Properties --
    ----------------------------

src/alire-releases.ads

@@ -3,6 +3,7 @@ with Ada.Tags;
 with Alire.Actions;
 with Alire.Conditional;
 with Alire.Dependencies;
+--  with Alire.Interfaces;
 with Alire.Milestones;
 with Alire.Origins;
 with Alire.Projects;
@@ -20,7 +21,9 @@ package Alire.Releases with Preelaborate is
    
 --     subtype Dependency_Vector is Dependencies.Vectors.Vector;
 
-   type Release (<>) is new Versions.Versioned with private;
+   type Release (<>) is 
+     new Versions.Versioned
+   with private;
 
    function "<" (L, R : Release) return Boolean;
 
@@ -32,6 +35,14 @@ package Alire.Releases with Preelaborate is
                          Properties         : Conditional.Properties;
                          Private_Properties : Conditional.Properties;
                          Available          : Alire.Requisites.Tree) return Release;
+   
+   function New_Working_Release 
+     (Project      : Alire.Project;
+      Origin       : Origins.Origin := Origins.New_Filesystem (".");
+      Dependencies : Conditional.Dependencies := Conditional.For_Dependencies.Empty;
+      Properties   : Conditional.Properties   := Conditional.For_Properties.Empty)
+      return         Release;
+   --  For working project releases that may have incomplete information
 
    function Extending (Base               : Release;
                        Dependencies       : Conditional.Dependencies := Conditional.For_Dependencies.Empty;
@@ -88,11 +99,16 @@ package Alire.Releases with Preelaborate is
    function Version (R : Release) return Semantic_Versioning.Version;
    
    function Depends (R : Release) return Conditional.Dependencies;
+   function Dependencies (R : Release) return Conditional.Dependencies
+     renames Depends;
    
    function Depends (R : Release;
                      P : Properties.Vector)
                      return Conditional.Dependencies;
    --  Not really conditional anymore, but still a potential tree
+   function Dependencies (R : Release;
+                          P : Properties.Vector)
+                          return Conditional.Dependencies renames Depends;
    
    function Origin  (R : Release) return Origins.Origin;
    function Available (R : Release) return Requisites.Tree;
@@ -141,12 +157,14 @@ package Alire.Releases with Preelaborate is
    procedure Print (R : Release; Private_Too : Boolean := False);
    -- Dump info to console   
 
+--     overriding function To_Code (R : Release) return Utils.String_Vector;
+   
    --  Search helpers
 
    function Property_Contains (R : Release; Str : String) return Boolean;
    --  True if some property contains the given string
    
-   function Satisfies (R : Release; Dep : Dependencies.Dependency) return Boolean;
+   function Satisfies (R : Release; Dep : Alire.Dependencies.Dependency) return Boolean;
    --  Ascertain if this release is a valid candidate for Dep
    
 private
@@ -168,7 +186,9 @@ private
    function Describe is new Alire.Properties.Labeled.Cond_New_Label (Alire.Properties.Labeled.Description);
 
    type Release (Prj_Len, 
-                 Notes_Len : Natural) is new Versions.Versioned with record 
+                 Notes_Len : Natural) is 
+     new Versions.Versioned
+   with record 
       Project      : Alire.Project (1 .. Prj_Len);
       Alias        : Ustring; -- I finally gave up on constraints
       Version      : Semantic_Versioning.Version;
@@ -237,7 +257,7 @@ private
    function On_Platform_Actions (R : Release; P : Properties.Vector) return Properties.Vector is
      (R.On_Platform_Properties (P, Actions.Action'Tag));
    
-   function Satisfies (R : Release; Dep : Dependencies.Dependency) return Boolean is
+   function Satisfies (R : Release; Dep : Alire.Dependencies.Dependency) return Boolean is
      (R.Project = Dep.Project and then
       Satisfies (R.Version, Dep.Versions));
 

src/alire-utils.adb

@@ -44,6 +44,21 @@ package body Alire.Utils is
       return Flatten (1, V);
    end Flatten;
 
+   ------------
+   -- Indent --
+   ------------
+
+   function Indent (V      : String_Vector;
+                    Spaces : String := "   ")
+                    return   String_Vector is
+   begin
+      return R : String_Vector do
+         for Line of V loop
+            R.Append (String'(Spaces & Line));
+         end loop;
+      end return;
+   end Indent;
+
    -------------
    -- Replace --
    -------------
@@ -137,6 +152,17 @@ package body Alire.Utils is
       end return;
    end To_Mixed_Case;
 
+   ---------------
+   -- To_Vector --
+   ---------------
+
+   function To_Vector (S : String) return String_Vector is
+   begin
+      return V : String_Vector do
+         V.Append (S);
+      end return;
+   end To_Vector;
+
    --------------------
    -- Image_One_Line --
    --------------------

src/alire-utils.ads

@@ -3,6 +3,8 @@ with Ada.Containers.Indefinite_Vectors;
 
 package Alire.Utils with Preelaborate is
 
+   function Quote (S : String) return String;
+
    function To_Lower_Case (S : String) return String;
    function To_Mixed_Case (S : String) return String;
 
@@ -54,12 +56,22 @@ package Alire.Utils with Preelaborate is
 
    Empty_Vector : constant String_Vector;
 
+   procedure Append_Vector (V : in out String_Vector; V2 : String_Vector)
+     renames Append;
+
    function Count (V : String_Vector) return Natural;
    --  FSM do I hate the Containers.Count_Type...
 
    function Flatten (V : String_Vector; Separator : String := " ") return String;
    --  Concatenate all elements
 
+   function Indent (V      : String_Vector;
+                    Spaces : String := "   ")
+                    return   String_Vector;
+
+   not overriding
+   function To_Vector (S : String) return String_Vector;
+
    procedure Write (V         : String_Vector;
                     Filename  : Platform_Independent_Path;
                     Separator : String := ASCII.LF & "");
@@ -79,6 +91,9 @@ private
 
    function Count (V : String_Vector) return Natural is (Natural (String_Vectors.Vector (V).Length));
 
+   function Quote (S : String) return String is
+      ("""" & S & """");
+
    type XXX_XXX is limited null record;
    function XXX_XXX_XXX return XXX_XXX is (null record);