From d92c3748330d2b36b029ec5db6b3b2d40c1a7014 Mon Sep 17 00:00:00 2001 From: Jano at Zelda Date: Mon, 12 Feb 2018 18:02:03 +0100 Subject: [PATCH] Towards trees --- index/alire-index-example_dependencies.ads | 8 +++-- src/alire-index.adb | 14 +++++++-- src/alire-index.ads | 30 +++++++++++++++---- src/alire-properties.ads | 11 +++++-- src/alire-requisites-platform.ads | 29 ++++++++++++++++++ src/alire-requisites.adb | 18 ++++++++++++ src/alire-requisites.ads | 34 ++++++++++++---------- 7 files changed, 116 insertions(+), 28 deletions(-) create mode 100644 src/alire-requisites.adb diff --git a/index/alire-index-example_dependencies.ads b/index/alire-index-example_dependencies.ads index 0ac22ae1..366d405c 100644 --- a/index/alire-index-example_dependencies.ads +++ b/index/alire-index-example_dependencies.ads @@ -1,6 +1,4 @@ with Alire.Repositories.Local; -with Alire.Requisites; -with Alire.Properties.Platform; package Alire.Index.Example_Dependencies is @@ -10,6 +8,10 @@ package Alire.Index.Example_Dependencies is Repositories.Local.Repo, Repositories.Local.Local_Id, Properties => Default_Properties and Available_On (GNU_Linux), - Requisites => No_Requisites and (No_Requisites or No_Requisites)); + Requisites => Available_On (GNU_Linux) or not Available_On (GNU_Linux) +-- No_Requisites and +-- (Available_On (GNU_Linux) or not Available_On (GNU_Linux))); + -- Compiles_With (GNAT_GPL_2017))); + ); end Alire.Index.Example_Dependencies; diff --git a/src/alire-index.adb b/src/alire-index.adb index 58b8f4d9..1cfc7944 100644 --- a/src/alire-index.adb +++ b/src/alire-index.adb @@ -8,17 +8,25 @@ package body Alire.Index is Version : Semantic_Versioning.Version; Hosting : Repositories.Repository'Class; Id : Repositories.Release_Id; - Depends_On : Dependencies := Nothing; - Native : Boolean := False) return Release + Depends_On : Dependencies := Depends.Nothing; + Properties : Alire.Properties.Vector := Alire.Properties.Vectors.Empty_Vector; + Requisites : Alire.Requisites.Tree := Alire.Requisites.No_Requisites; + Native : Boolean := False) return Release is begin + if not Requisites.Is_Empty then + Alire.Requisites.Trees.Print_Skeleton (Requisites); + end if; + return Rel : constant Alire.Releases.Release := Alire.Releases.New_Release (Project, Version, Hosting, Id, Depends_On, - Native => Native) + Properties => Properties, + Requisites => Requisites, + Native => Native) do if Releases.Contains (Rel) then Log ("Attempt to register duplicate versions: " & Rel.Milestone_Image, Warning); diff --git a/src/alire-index.ads b/src/alire-index.ads index d75ce919..b6f8e551 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -6,6 +6,7 @@ with Alire.Properties.Platform; with Alire.Releases; with Alire.Repositories.Git; with Alire.Requisites; +with Alire.Requisites.Platform; with Semantic_Versioning; @@ -31,7 +32,7 @@ package Alire.Index is Hosting : Repositories.Repository'Class; Id : Repositories.Release_Id; Depends_On : Dependencies := Depends.Nothing; - Properties : Alire.Properties.Vector := Alire.Properties.Property_Vectors.Empty_Vector; + Properties : Alire.Properties.Vector := Alire.Properties.Vectors.Empty_Vector; Requisites : Alire.Requisites.Tree := Alire.Requisites.No_Requisites; Native : Boolean := False) return Release; @@ -39,6 +40,8 @@ package Alire.Index is Version : Semantic_Versioning.Version; Hosting : URL; Commit : Repositories.Git.Commit_ID; + Properties : Alire.Properties.Vector := Alire.Properties.Vectors.Empty_Vector; + Requisites : Alire.Requisites.Tree := Alire.Requisites.No_Requisites; Depends_On : Dependencies := Depends.Nothing) return Release; -- Shortcuts to give dependencies: @@ -65,26 +68,32 @@ package Alire.Index is function Except (P : Project_Name; V : Version) return Dependencies; -- Shortcuts for properties/requisites: + use all type Platform.Compilers; use all type Platform.Operating_Systems; use all type Properties.Property'Class; -- for "and" operator + use all type Requisites.Requisite'Class; use all type Requisites.Tree; -- for logical operators - Default_Properties : constant Properties.Vector := Properties.Property_Vectors.Empty_Vector; + Default_Properties : constant Properties.Vector := Properties.Vectors.Empty_Vector; No_Requisites : constant Requisites.Tree := Requisites.No_Requisites; function Verifies (P : Properties.Property'Class) return Properties.Vector; function "+" (P : Properties.Property'Class) return Properties.Vector renames Verifies; - function Require (R : Requisites.Requisite'Class) return Requisites.Tree; - function "+" (R : Requisites.Requisite'Class) return Requisites.Tree renames Require; + function Requires (R : Requisites.Requisite'Class) return Requisites.Tree; + function "+" (R : Requisites.Requisite'Class) return Requisites.Tree renames Requires; -- Specific shortcuts: + function Available_On (V : Alire.Platform.Operating_Systems) return Properties.Property'Class renames Properties.Platform.Available_On; function Compiles_With (C : Alire.Platform.Compilers) return Properties.Property'Class renames Properties.Platform.Compiles_With; + + function Available_On (V : Alire.Platform.Operating_Systems) return Requisites.Requisite'Class + renames Requisites.Platform.Available_On; private @@ -92,13 +101,17 @@ private Version : Semantic_Versioning.Version; Hosting : URL; Commit : Repositories.Git.Commit_ID; + Properties : Alire.Properties.Vector := Alire.Properties.Vectors.Empty_Vector; + Requisites : Alire.Requisites.Tree := Alire.Requisites.No_Requisites; Depends_On : Dependencies := Depends.Nothing) return Release is (Register (Project, Version, Repositories.Git.New_Repository (String (Hosting)), Repositories.Release_Id (Commit), Depends_On, - Native => False)); + Properties => Properties, + Requisites => Requisites, + Native => False)); use Depends; use Semantic_Versioning; @@ -145,5 +158,12 @@ private function Except (P : Project_Name; V : Version) return Dependencies is (Depends_On (P, Except (V))); + + + function Verifies (P : Properties.Property'Class) return Properties.Vector is + (Properties.Vectors.To_Vector (P, 1)); + + function Requires (R : Requisites.Requisite'Class) return Requisites.Tree is + (Requisites.Trees.Leaf (R)); end Alire.Index; diff --git a/src/alire-properties.ads b/src/alire-properties.ads index 2f4bee9b..8649f6e0 100644 --- a/src/alire-properties.ads +++ b/src/alire-properties.ads @@ -11,9 +11,9 @@ package Alire.Properties with Preelaborate is type Property is interface; - package Property_Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Property'Class); + package Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Property'Class); - subtype Vector is Property_Vectors.Vector; + subtype Vector is Vectors.Vector; function "and" (L, R : Property'Class) return Vector; function "and" (L : Vector; R : Property'Class) return Vector; @@ -41,5 +41,12 @@ package Alire.Properties with Preelaborate is end Values; +private + + use all type Vector; + + function "and" (L, R : Property'Class) return Vector is (L & R); + + function "and" (L : Vector; R : Property'Class) return Vector is (L & R); end Alire.Properties; diff --git a/src/alire-requisites-platform.ads b/src/alire-requisites-platform.ads index c4808159..469e3667 100644 --- a/src/alire-requisites-platform.ads +++ b/src/alire-requisites-platform.ads @@ -1,5 +1,34 @@ +with Alire.Platform; +with Alire.Properties.Platform; + package Alire.Requisites.Platform with Preelaborate is + function Available_On (V : Alire.Platform.Operating_Systems) return Requisites.Requisite'Class; +private + + -- Preparation for OS requisites mimicking OS properties + + use all type Alire.Platform.Operating_Systems; + + package Props renames Alire.Properties.Platform; + + package Operating_Systems is new Typed_Requisites (Props.Operating_Systems.Property'Class); + + type OS_Requisite is new Operating_Systems.Requisite with record + Value : Alire.Platform.Operating_Systems; + end record; + + overriding function Is_Satisfied (R : OS_Requisite; + P : Props.Operating_Systems.Property'Class) return Boolean is + (R.Value = P.Element); + + + ------------------ + -- Available_On -- + ------------------ + + function Available_On (V : Alire.Platform.Operating_Systems) return Requisites.Requisite'Class is + (OS_Requisite'(Value => V)); end Alire.Requisites.Platform; diff --git a/src/alire-requisites.adb b/src/alire-requisites.adb new file mode 100644 index 00000000..d271ae8e --- /dev/null +++ b/src/alire-requisites.adb @@ -0,0 +1,18 @@ +package body Alire.Requisites is + + --------------- + -- Satisfies -- + --------------- + + function Satisfies (R : Requisite'Class; P : Properties.Vector) return Boolean is + begin + for Prop of P loop + if R.Satisfies (P) then + return True; + end if; + end loop; + + return False; + end Satisfies; + +end Alire.Requisites; diff --git a/src/alire-requisites.ads b/src/alire-requisites.ads index 4abce556..d36cde8a 100644 --- a/src/alire-requisites.ads +++ b/src/alire-requisites.ads @@ -6,7 +6,7 @@ package Alire.Requisites with Preelaborate is use Properties; - type Requisite is tagged null record; + type Requisite is abstract tagged null record; -- A Requisite verifies against some internally stored data that a property is satisfied. -- Here we provide the basic storage of values but the actual checking function must be overridden -- for particular checks. @@ -18,13 +18,17 @@ package Alire.Requisites with Preelaborate is -- Here we tie a class of properties and requisites (e.g., versions and version sets) that make sense. -- A release has a list of properties, and a tree of requisites to be applied to potential dependencies. + function Satisfies (R : Requisite; P : Property'Class) return Boolean is abstract; + -- This function is used later in the generic implementation to automatically downcast, + -- so requisite implementations do not need to deal with this MI-mess + generic - type Compatible_Property is new Property with private; - package Property_Checker is + type Compatible_Property (<>) is new Property with private; + package Typed_Requisites is - type Requisite is Abstract - new Requisites.Requisite with null record; + type Requisite is abstract new Requisites.Requisite with null record; + not overriding function Is_Satisfied (R : Requisite; P : Compatible_Property) return Boolean is abstract; -- This is the important function to override by Requisite implementations @@ -34,25 +38,25 @@ package Alire.Requisites with Preelaborate is (P in Compatible_Property); -- Convenience for the evaluator to determine which properties might satisfy a requisite - function Cast (R : Requisite; P : Property'Class) return Compatible_Property'Class is - (Compatible_Property'Class (P)) - with Pre => R.Is_Applicable (P); - -- Convenience cast that can be done inside the package, but not outside, so it must be available here! + overriding + function Satisfies (R : Requisite; P : Property'Class) return Boolean is + (Requisite'Class (R).Is_Satisfied (Compatible_Property (P))) + with Pre => R.Is_Applicable (P); - end Property_Checker; + end Typed_Requisites; -- Trees of requisites to be matched against a list of properties in a release function Satisfies (R : Requisite'Class; P : Properties.Vector) return Boolean; -- True if any of the properties in the vector satisfies the requisite - package Requisite_Trees is new Condtrees (Properties.Vector, - Requisite'Class, - Satisfies); + package Trees is new Condtrees (Properties.Vector, + Requisite'Class, + Satisfies); - subtype Tree is Requisite_Trees.Tree; + subtype Tree is Trees.Tree; - function No_Requisites return Requisite_Trees.Tree is (Requisite_Trees.Empty_Tree); + function No_Requisites return Trees.Tree is (Trees.Empty_Tree); -- Function instead of constant to keep Preelaborate end Alire.Requisites;