Better native origins
This commit is contained in:
Alejandro R. Mosteo
@@ -7,10 +7,7 @@ package Alire.Index.LibGNUTLS is
|
||||
Register (Name,
|
||||
V ("3.5.8"),
|
||||
Desc,
|
||||
Native ("libgnutls28-dev"),
|
||||
Available_When =>
|
||||
Version_Is (Debian_Buster) or
|
||||
Version_Is (Ubuntu_Xenial) or
|
||||
Version_Is (Ubuntu_Artful));
|
||||
Native ((Debian | Ubuntu => Packaged_As ("libgnutls28-dev"),
|
||||
others => Unavailable)));
|
||||
|
||||
end Alire.Index.LibGNUTLS;
|
||||
|
||||
+9
-3
@@ -63,11 +63,18 @@ package Alire.Index is
|
||||
-- INDEXING SUPPORT --
|
||||
------------------------
|
||||
|
||||
-- Shortcuts for common origins:
|
||||
-- Shortcuts for origins:
|
||||
|
||||
function Native (Pack : String ) return Origins.Origin renames Origins.New_Native;
|
||||
function Git (URL : Alire.URL; Commit : Origins.Git_Commit) return Origins.Origin renames Origins.New_Git;
|
||||
function Hg (URL : Alire.URL; Commit : Origins.Hg_Commit) return Origins.Origin renames Origins.New_Hg;
|
||||
|
||||
use all type Platforms.Distributions;
|
||||
|
||||
function Packaged_As (S : String) return Origins.Package_Names renames Origins.Packaged_As;
|
||||
|
||||
Unavailable : constant Origins.Package_Names := Origins.Unavailable;
|
||||
|
||||
function Native (Distros : Origins.Native_Packages) return Origins.Origin renames Origins.New_Native;
|
||||
|
||||
-- Shortcuts to give dependencies:
|
||||
|
||||
@@ -131,7 +138,6 @@ package Alire.Index is
|
||||
use all type GPR.Value_Vector;
|
||||
use all type Licensing.Licenses;
|
||||
use all type Platforms.Compilers;
|
||||
use all type Platforms.Distributions;
|
||||
use all type Platforms.Operating_Systems;
|
||||
use all type Platforms.Versions;
|
||||
use all type Platforms.Word_Sizes;
|
||||
|
||||
+80
-33
@@ -1,3 +1,5 @@
|
||||
with Alire.Platforms;
|
||||
|
||||
private with Ada.Strings.Unbounded;
|
||||
|
||||
package Alire.Origins with Preelaborate is
|
||||
@@ -7,6 +9,22 @@ package Alire.Origins with Preelaborate is
|
||||
|
||||
-- The actual capabilities for check-outs or fetches are in alr proper
|
||||
|
||||
--------------------------------------------
|
||||
-- supporting types for native packages --
|
||||
--------------------------------------------
|
||||
-- These are used to represent native packages in a comfortable way in the index
|
||||
|
||||
type Package_Names is tagged private;
|
||||
|
||||
function Image (This : Package_Names) return String;
|
||||
|
||||
function Unavailable return Package_Names;
|
||||
|
||||
function Packaged_As (Name : String) return Package_Names;
|
||||
|
||||
type Native_Packages is array (Platforms.Distributions) of Package_Names;
|
||||
-- The name of a package in every distro for a given version
|
||||
|
||||
type Kinds is (Filesystem, -- Not really an origin, but a working copy of a project
|
||||
Git, -- Remote git repo
|
||||
Hg, -- Remote hg repo
|
||||
@@ -17,11 +35,20 @@ package Alire.Origins with Preelaborate is
|
||||
|
||||
function Kind (This : Origin) return Kinds;
|
||||
|
||||
function URL (This : Origin) return Alire.URL;
|
||||
-------------------
|
||||
-- member data --
|
||||
-------------------
|
||||
|
||||
function Id (This : Origin) return String;
|
||||
function Commit (This : Origin) return String with Pre => This.Kind in Git | Hg;
|
||||
function URL (This : Origin) return Alire.URL with Pre => This.Kind in Git | Hg;
|
||||
|
||||
function Path (This : Origin) return String with Pre => This.Kind = Filesystem;
|
||||
|
||||
function Is_Native (This : Origin) return Boolean is (This.Kind = Native);
|
||||
function Package_Name (This : Origin;
|
||||
Distribution : Platforms.Distributions)
|
||||
return String;
|
||||
function All_Native_Names (This : Origin) return Native_Packages;
|
||||
|
||||
-- Helper types
|
||||
|
||||
@@ -32,70 +59,90 @@ package Alire.Origins with Preelaborate is
|
||||
|
||||
function New_Filesystem (Path : String) return Origin;
|
||||
|
||||
function New_Git (URL : Alire.URL;
|
||||
Id : Git_Commit)
|
||||
function New_Git (URL : Alire.URL;
|
||||
Commit : Git_Commit)
|
||||
return Origin;
|
||||
|
||||
function New_Hg (URL : Alire.URL;
|
||||
Id : Hg_Commit)
|
||||
function New_Hg (URL : Alire.URL;
|
||||
Commit : Hg_Commit)
|
||||
return Origin;
|
||||
|
||||
function New_Native (Package_Name : String) return Origin;
|
||||
|
||||
function Native_Package (This : Origin) return String
|
||||
with Pre => This.Kind = Native;
|
||||
function New_Native (Packages : Native_Packages) return Origin;
|
||||
|
||||
function Image (This : Origin) return String;
|
||||
|
||||
private
|
||||
|
||||
use Ada.Strings.Unbounded;
|
||||
function "+" (S : String) return Unbounded_String renames To_Unbounded_String;
|
||||
function "+" (U : Unbounded_String) return String renames To_String;
|
||||
|
||||
type Origin is tagged record
|
||||
Kind : Kinds;
|
||||
URL : Unbounded_String;
|
||||
Id : Unbounded_String;
|
||||
type Package_Names is tagged record
|
||||
Name : Unbounded_String;
|
||||
end record;
|
||||
|
||||
function Image (This : Package_Names) return String is (+This.Name);
|
||||
|
||||
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
|
||||
Kind : Kinds;
|
||||
|
||||
Commit : Unbounded_String;
|
||||
URL : Unbounded_String;
|
||||
|
||||
Packages : Native_Packages;
|
||||
|
||||
Path : Unbounded_String;
|
||||
end record;
|
||||
|
||||
function New_Filesystem (Path : String) return Origin is
|
||||
(Filesystem,
|
||||
Id => Null_Unbounded_String,
|
||||
URL => To_Unbounded_String (Path));
|
||||
Path => +Path,
|
||||
others => <>);
|
||||
|
||||
function New_Git (URL : Alire.URL;
|
||||
Id : Git_Commit)
|
||||
function New_Git (URL : Alire.URL;
|
||||
Commit : Git_Commit)
|
||||
return Origin is
|
||||
(Git,
|
||||
URL => To_Unbounded_String (URL),
|
||||
Id => To_Unbounded_String (Id));
|
||||
URL => +URL,
|
||||
Commit => +Commit,
|
||||
others => <>);
|
||||
|
||||
function New_Hg (URL : Alire.URL;
|
||||
Id : Hg_Commit)
|
||||
function New_Hg (URL : Alire.URL;
|
||||
Commit : Hg_Commit)
|
||||
return Origin is
|
||||
(Hg,
|
||||
URL => To_Unbounded_String (URL),
|
||||
Id => To_Unbounded_String (Id));
|
||||
URL => +URL,
|
||||
Commit => +Commit,
|
||||
others => <>);
|
||||
|
||||
function New_Native (Package_Name : String) return Origin is
|
||||
function New_Native (Packages : Native_Packages) return Origin is
|
||||
(Native,
|
||||
Id => To_Unbounded_String (Package_Name),
|
||||
URL => Null_Unbounded_String);
|
||||
Packages => Packages,
|
||||
others => <>);
|
||||
|
||||
function Kind (This : Origin) return Kinds is (This.Kind);
|
||||
|
||||
function URL (This : Origin) return Alire.URL is (Alire.URL (To_String (This.URL)));
|
||||
function URL (This : Origin) return Alire.URL is (Alire.URL (+This.URL));
|
||||
function Commit (This : Origin) return String is (+This.Commit);
|
||||
|
||||
function Id (This : Origin) return String is (To_String (This.Id));
|
||||
function Path (This : Origin) return String is (+This.Path);
|
||||
|
||||
function Native_Package (This : Origin) return String renames Id;
|
||||
function Package_Name (This : Origin;
|
||||
Distribution : Platforms.Distributions)
|
||||
return String is (+This.Packages (Distribution).Name);
|
||||
|
||||
function All_Native_Names (This : Origin) return Native_Packages is (This.Packages);
|
||||
|
||||
function S (Str : Unbounded_String) return String is (To_String (Str));
|
||||
|
||||
function Image (This : Origin) return String is
|
||||
(case This.Kind is
|
||||
when Git | Hg => "commit " & S (This.Id) & " from " & S (This.URL),
|
||||
when Native => "package " & S (This.Id) & " from platform software manager",
|
||||
when Filesystem => "path " & S (This.Id));
|
||||
when Git | Hg => "commit " & S (This.Commit) & " from " & S (This.URL),
|
||||
when Native => "native package from platform software manager",
|
||||
when Filesystem => "path " & S (This.Path));
|
||||
|
||||
|
||||
end Alire.Origins;
|
||||
|
||||
+21
-1
@@ -1,7 +1,10 @@
|
||||
with Alire.Conditional_Values;
|
||||
with Alire.Platforms;
|
||||
|
||||
with GNAT.IO; -- To keep preelaborable
|
||||
|
||||
with Table_IO;
|
||||
|
||||
package body Alire.Releases is
|
||||
|
||||
use all type Properties.Labeled.Labels;
|
||||
@@ -137,7 +140,24 @@ package body Alire.Releases is
|
||||
Put_Line (R.Milestone.Image & ": " & R.Description);
|
||||
|
||||
-- ORIGIN
|
||||
Put_Line ("Origin: " & R.Origin.Image);
|
||||
if R.Origin.Is_Native then
|
||||
Put_Line ("Origin (native package):");
|
||||
declare
|
||||
Table : Table_IO.Table;
|
||||
begin
|
||||
for Dist in Platforms.Distributions loop
|
||||
if R.Origin.Package_Name (Dist) /= Origins.Unavailable.Image then
|
||||
Table.New_Row;
|
||||
Table.Append (" ");
|
||||
Table.Append (Utils.To_Mixed_Case (Dist'Img) & ":");
|
||||
Table.Append (R.Origin.Package_Name (Dist));
|
||||
end if;
|
||||
end loop;
|
||||
Table.Print;
|
||||
end;
|
||||
else
|
||||
Put_Line ("Origin: " & R.Origin.Image);
|
||||
end if;
|
||||
|
||||
-- AVAILABILITY
|
||||
if not R.Available.Is_Empty then
|
||||
|
||||
@@ -28,7 +28,7 @@ package Alire.Releases with Preelaborate is
|
||||
|
||||
function Whenever (R : Release; P : Properties.Vector) return Release;
|
||||
-- Materialize conditions in a Release once the whatever properties are known
|
||||
-- At present only platform properties
|
||||
-- At present dependencies and properties
|
||||
|
||||
function Project (R : Release) return Project_Name;
|
||||
function Description (R : Release) return Project_Description;
|
||||
@@ -153,8 +153,9 @@ private
|
||||
function Image (R : Release) return Path_String is
|
||||
(R.Name & "_" &
|
||||
Image (R.Version) & "_" &
|
||||
(if R.Origin.Id'Length <= 8 then R.Origin.Id
|
||||
else R.Origin.Id (R.Origin.Id'First .. R.Origin.Id'First + 7)));
|
||||
(if R.Origin.Commit'Length <= 8
|
||||
then R.Origin.Commit
|
||||
else R.Origin.Commit (R.Origin.Commit'First .. R.Origin.Commit'First + 7)));
|
||||
|
||||
-- Dependency helpers
|
||||
|
||||
|
||||
@@ -0,0 +1,59 @@
|
||||
with Ada.Containers;
|
||||
with GNAT.IO;
|
||||
|
||||
package body Table_IO is
|
||||
|
||||
use all type Ada.Containers.Count_Type;
|
||||
|
||||
------------
|
||||
-- Append --
|
||||
------------
|
||||
|
||||
procedure Append (T : in out Table; Cell : String) is
|
||||
begin
|
||||
if T.Rows.Is_Empty then
|
||||
T.New_Row;
|
||||
end if;
|
||||
|
||||
if Natural (T.Max_Widths.Length) < T.Next_Column then
|
||||
T.Max_Widths.Append (Cell'Length);
|
||||
else
|
||||
T.Max_Widths (T.Next_Column) :=
|
||||
Natural'Max (Cell'Length, T.Max_Widths (T.Next_Column));
|
||||
end if;
|
||||
|
||||
T.Rows (Natural (T.Rows.Length)).Append (Cell);
|
||||
T.Next_Column := T.Next_Column + 1;
|
||||
end Append;
|
||||
|
||||
-------------
|
||||
-- New_Row --
|
||||
-------------
|
||||
|
||||
procedure New_Row (T : in out Table) is
|
||||
begin
|
||||
T.Next_Column := 1;
|
||||
T.Rows.Append (String_Vectors.Empty_Vector);
|
||||
end New_Row;
|
||||
|
||||
-----------
|
||||
-- Print --
|
||||
-----------
|
||||
|
||||
procedure Print (T : Table; Separator : String := " ") is
|
||||
use Gnat.IO;
|
||||
begin
|
||||
for Row of T.Rows loop
|
||||
for I in 1 .. Natural (Row.Length) loop
|
||||
Put (Row (I));
|
||||
Put (String'(1 .. T.Max_Widths (I) - String'(Row (I))'Length => ' '));
|
||||
if I < Natural (Row.Length) then
|
||||
Put (Separator);
|
||||
else
|
||||
New_Line;
|
||||
end if;
|
||||
end loop;
|
||||
end loop;
|
||||
end Print;
|
||||
|
||||
end Table_IO;
|
||||
@@ -0,0 +1,31 @@
|
||||
with Ada.Containers.Indefinite_Vectors;
|
||||
with Ada.Containers.Vectors;
|
||||
|
||||
package Table_IO with Preelaborate is
|
||||
|
||||
type Table is tagged private;
|
||||
|
||||
procedure Append (T : in out Table; Cell : String);
|
||||
|
||||
procedure New_Row (T : in out Table);
|
||||
|
||||
procedure Print (T : Table; Separator : String := " ");
|
||||
|
||||
private
|
||||
|
||||
package Natural_Vectors is new Ada.Containers.Vectors (Positive, Natural);
|
||||
|
||||
package String_Vectors is new Ada.Containers.Indefinite_Vectors (Positive,
|
||||
String);
|
||||
subtype Row is String_Vectors.Vector;
|
||||
use all type Row;
|
||||
|
||||
package Row_Vectors is new Ada.Containers.Vectors (Positive, Row);
|
||||
|
||||
type Table is tagged record
|
||||
Next_Column : Positive := 1;
|
||||
Rows : Row_Vectors.Vector;
|
||||
Max_Widths : Natural_Vectors.Vector;
|
||||
end record;
|
||||
|
||||
end Table_IO;
|
||||
Reference in New Issue
Block a user