diff --git a/src/alire-conditional_trees.adb b/src/alire-conditional_trees.adb index 2d1722ec..d4f7308d 100644 --- a/src/alire-conditional_trees.adb +++ b/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 -- ----------------- diff --git a/src/alire-conditional_trees.ads b/src/alire-conditional_trees.ads index 837c08af..9aec0fa6 100644 --- a/src/alire-conditional_trees.ads +++ b/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; diff --git a/src/alire-interfaces.ads b/src/alire-interfaces.ads new file mode 100644 index 00000000..0eab8c3d --- /dev/null +++ b/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; diff --git a/src/alire-origins.ads b/src/alire-origins.ads index f3e0c120..3d56bf1a 100644 --- a/src/alire-origins.ads +++ b/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; diff --git a/src/alire-releases.adb b/src/alire-releases.adb index 08ae5449..e4ef3ada 100644 --- a/src/alire-releases.adb +++ b/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 -- ---------------------------- diff --git a/src/alire-releases.ads b/src/alire-releases.ads index e4c4325f..2507d678 100644 --- a/src/alire-releases.ads +++ b/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)); diff --git a/src/alire-utils.adb b/src/alire-utils.adb index 7b9a28c7..27f4daf4 100644 --- a/src/alire-utils.adb +++ b/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 -- -------------------- diff --git a/src/alire-utils.ads b/src/alire-utils.ads index 87b63aef..06bba4cd 100644 --- a/src/alire-utils.ads +++ b/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);