Better Comparable requisites

index/alire-index-alire.ads

@@ -83,7 +83,8 @@ package Alire.Index.Alire is
                             Website ("http://www.www.www"),
                             --  Unconditional properties
 
-                          Available_When => -- Impossible mix
+                          Available_When     => -- Impossible mix
+                            OS = GNU_Linux or OS /= GNU_Linux or
                             (System_Is (Windows) and System_Is (GNU_Linux)) or
                             (Compiler_Is (GNAT_Unknown) and not Compiler_Is (GNAT_Unknown)));
 

src/alire-index.ads

@@ -231,6 +231,8 @@ package Alire.Index is
    --  REQUISITES  --
    ------------------
    
+   use all type Requisites.Tree;
+   
    package Plat_Reqs renames Requisites.Platform;
 
    function Compiler_Is_Native                           return Release_Requisites renames Plat_Reqs.Compiler_Is_Native;
@@ -240,6 +242,9 @@ package Alire.Index is
 
    function Distribution_Is (V : Platforms.Distributions) return Release_Requisites renames Plat_Reqs.Distribution_Is;
 
+   function OS return Requisites.Platform.Systs.Comparable renames Requisites.Platform.Systs.New_Comparable;
+   use all type Requisites.Platform.Systs.Comparable;
+   
    function System_Is (V : Platforms.Operating_Systems) return Release_Requisites renames Plat_Reqs.System_Is;
    
    function Version_is (V : Platforms.Versions) return Release_Requisites renames Plat_Reqs.Version_Is;   

src/alire-properties.ads

@@ -41,7 +41,7 @@ package Alire.Properties with Preelaborate is
       with function Image (V : Value) return String is <>;
    package Values is
 
-      type Property (<>) is new Properties.Property with private;
+      type Property is new Properties.Property with private;
 
       function New_Property (V : Value) return Property;
 

src/alire-requisites-comparables.ads

@@ -0,0 +1,88 @@
+generic
+   --  Encapsulated basic type
+   type Value is private;
+   with function "<" (L, R : Value) return Boolean;
+   with function Image (V : Value) return String is <>;
+
+   --  Encapsulating property
+   type Property is new Properties.Property with private;
+   with function Element (P : Property) return Value;
+
+   Name : String; -- used for image "Name (operation) Mixed_Case (Image (Value))"
+package Alire.Requisites.Comparables with Preelaborate is
+
+   package Value_Requisites is new For_Property (Property);
+
+   type Comparable (<>) is new Value_Requisites.Requisite with private;
+
+   overriding function Is_Satisfied (R : Comparable; P : Property) return Boolean;
+   overriding function Image        (R : Comparable) return String;
+
+   not overriding function New_Comparable return Comparable;
+   --  This is the root function that can be renamed to a sensible name to appear in expressions
+
+   function "=" (L : Comparable; R : Value) return Tree;
+   function "=" (L : Value; R : Comparable) return Tree;
+
+   function "/=" (L : Comparable; R : Value) return Tree;
+   function "/=" (L : Value; R : Comparable) return Tree;
+
+   function "<" (L : Comparable; R : Value) return Tree;
+   function "<" (L : Value; R : Comparable) return Tree;
+
+   function "<=" (L : Comparable; R : Value) return Tree;
+   function "<=" (L : Value; R : Comparable) return Tree;
+
+   function ">" (L : Comparable; R : Value) return Tree;
+   function ">" (L : Value; R : Comparable) return Tree;
+
+   function ">=" (L : Comparable; R : Value) return Tree;
+   function ">=" (L : Value; R : Comparable) return Tree;
+
+private
+
+   type Kinds is (Base, Equality, Ordering);
+
+   type Comparable (Kind : Kinds) is new Value_Requisites.Requisite with record
+      Value : Comparables.Value;
+   end record;
+
+   not overriding function New_Comparable return Comparable is (Kind => Base, Value => <>);
+
+   overriding function Is_Satisfied (R : Comparable; P : Property) return Boolean is
+     (case R.Kind is
+         when Base     => raise Constraint_Error with "Is_Satisfied: Requisite without operation",
+         when Equality => R.Value = Element (P),
+         when Ordering => R.Value < Element (P));
+
+   overriding function Image (R : Comparable) return String is
+     (case R.Kind is
+         when Base     => raise Constraint_Error with "Image: Requisite without operation",
+         when Equality => Name & " = " & Image (R.Value),
+         when Ordering => Name & " < " & Image (R.Value));
+
+   use all type Tree;
+
+   function "/=" (L : Comparable; R : Value) return Tree is (not (L = R));
+   function "/=" (L : Value; R : Comparable) return Tree is (not (L = R));
+
+   function "<=" (L : Comparable; R : Value) return Tree is (L < R or L = R);
+   function "<=" (L : Value; R : Comparable) return Tree is (L < R or L = R);
+
+   function ">" (L : Comparable; R : Value) return Tree is (not (L <= R));
+   function ">" (L : Value; R : Comparable) return Tree is (not (L <= R));
+
+   function ">=" (L : Comparable; R : Value) return Tree is (not (L < R));
+   function ">=" (L : Value; R : Comparable) return Tree is (not (L < R));
+
+   function "=" (L : Comparable; R : Value) return Tree is
+     (Trees.Leaf (Comparable'(Kind => Equality, Value => R)));
+
+   function "=" (L : Value; R : Comparable) return Tree is (R = L);
+
+   function "<" (L : Comparable; R : Value) return Tree is
+      (Trees.Leaf (Comparable'(Kind => Ordering, Value => R)));
+
+   function "<" (L : Value; R : Comparable) return Tree is (R >= L);
+
+end Alire.Requisites.Comparables;

src/alire-requisites-platform.ads

@@ -1,6 +1,8 @@
 with Alire.Platforms;
 with Alire.Properties.Platform;
 
+with Alire.Requisites.Comparables;
+
 package Alire.Requisites.Platform with Preelaborate is
 
    package Plat renames Properties.Platform;
@@ -8,6 +10,12 @@ package Alire.Requisites.Platform with Preelaborate is
    use all type Platforms.Compilers;
    use all type Tree;
 
+   package Systs is new Comparables
+     (Platforms.Operating_Systems, Platforms."<", Platforms.Operating_Systems'Image,
+      Properties.Platform.Operating_Systems.Property,
+      Properties.Platform.Operating_Systems.Element,
+      "OS");
+
    package Compilers is new Requisites.For_Value_Property (Plat.Compilers, "Compiler");
    function Compiler_Is (V : Platforms.Compilers) return Tree renames Compilers.New_Equality;