alire/alire-index-community
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Towards trees

Browse Source
This commit is contained in:
Jano at Zelda
2018-02-12 18:02:03 +01:00
parent b202121f66
commit d92c374833
7 changed files with 116 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files
index/alire-index-example_dependencies.ads
+5 -3
View File
@@ -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;
src/alire-index.adb
+11 -3
View File
@@ -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);
src/alire-index.ads
+25 -5
View File
@@ -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;
src/alire-properties.ads
+9 -2
View File
@@ -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;
src/alire-requisites-platform.ads
+29
View File
@@ -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;
src/alire-requisites.adb
+18
View File
@@ -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;
src/alire-requisites.ads
+19 -15
View File
@@ -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;