From 9a930c2c69f9d83d9daf751b27ce546678f41ea6 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Sat, 3 Mar 2018 18:27:10 +0100 Subject: [PATCH] Better native origins --- index/alire-index-libgnutls.ads | 7 +- src/alire-index.ads | 12 +++- src/alire-origins.ads | 113 ++++++++++++++++++++++---------- src/alire-releases.adb | 22 ++++++- src/alire-releases.ads | 7 +- src/table_io.adb | 59 +++++++++++++++++ src/table_io.ads | 31 +++++++++ 7 files changed, 206 insertions(+), 45 deletions(-) create mode 100644 src/table_io.adb create mode 100644 src/table_io.ads diff --git a/index/alire-index-libgnutls.ads b/index/alire-index-libgnutls.ads index d901e8a1..d6ea34d7 100644 --- a/index/alire-index-libgnutls.ads +++ b/index/alire-index-libgnutls.ads @@ -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; diff --git a/src/alire-index.ads b/src/alire-index.ads index f702bfb1..6380495e 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -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; diff --git a/src/alire-origins.ads b/src/alire-origins.ads index e418efac..f3e0c120 100644 --- a/src/alire-origins.ads +++ b/src/alire-origins.ads @@ -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; diff --git a/src/alire-releases.adb b/src/alire-releases.adb index d5de6b28..ba724dad 100644 --- a/src/alire-releases.adb +++ b/src/alire-releases.adb @@ -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 diff --git a/src/alire-releases.ads b/src/alire-releases.ads index 479619af..9419ffbb 100644 --- a/src/alire-releases.ads +++ b/src/alire-releases.ads @@ -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 diff --git a/src/table_io.adb b/src/table_io.adb new file mode 100644 index 00000000..a51e1716 --- /dev/null +++ b/src/table_io.adb @@ -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; diff --git a/src/table_io.ads b/src/table_io.ads new file mode 100644 index 00000000..211006b2 --- /dev/null +++ b/src/table_io.ads @@ -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;