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

Separated origins and checkout

Browse Source
This commit is contained in:
Alejandro R. Mosteo
2018-02-19 23:38:57 +01:00
parent 77c8a99171
commit 271d4aedfd
15 changed files with 110 additions and 233 deletions
Download Patch File Download Diff File Expand all files Collapse all files
index/alire-index-example_dependencies.ads
+5 -6
View File
@@ -1,4 +1,4 @@
with Alire.Repositories.Local;
with Alire.Origins;
package Alire.Index.Example_Dependencies is
@@ -6,10 +6,9 @@ package Alire.Index.Example_Dependencies is
Register ("example_dependencies",
V ("1.0.0"),
"Release with assorted advanced dependency conditions",
Repositories.Local.Repo,
Repositories.Local.Local_Id,
Available_When => -- Note that it's impossible
(System_Is (Windows) and System_Is (GNU_Linux)) and
Compiler_Is_At_Least (GNAT_Any));
Origins.New_Filesystem ("/fake"),
Available_When => -- Impossible mix
(System_Is (Windows) and System_Is (GNU_Linux)) or
(Compiler_Is_At_Least (GNAT_Any) and not Compiler_Is_At_Least (GNAT_Any)));
end Alire.Index.Example_Dependencies;
src/alire-index.adb
+2 -4
View File
@@ -12,8 +12,7 @@ package body Alire.Index is
function Register (Project : Project_Name;
Version : Semantic_Versioning.Version;
Description : Project_Description;
Hosting : Repositories.Repository'Class;
Id : Repositories.Release_Id;
Origin : Origins.Origin;
Depends_On : Dependencies := No_Dependencies;
Properties : Alire.Properties.Vector := No_Properties;
Requisites : Alire.Requisites.Tree := No_Requisites;
@@ -25,8 +24,7 @@ package body Alire.Index is
Alire.Releases.New_Release (Project,
Description,
Version,
Hosting,
Id,
Origin,
Depends_On,
Properties => Properties,
Requisites => Requisites,
src/alire-index.ads
+5 -7
View File
@@ -4,9 +4,9 @@ with Alire.Containers;
with Alire.Compilers;
with Alire.Dependencies.Vectors;
with Alire.Operating_Systems;
with Alire.Origins;
with Alire.Properties;
with Alire.Releases;
with Alire.Repositories.Git;
with Alire.Requisites;
with Alire.Requisites.Platform;
with Alire.Root_Project;
@@ -29,8 +29,7 @@ package Alire.Index is
Project : Project_Name;
Version : Semantic_Versioning.Version;
Description : Project_Description;
Hosting : Repositories.Repository'Class;
Id : Repositories.Release_Id;
Origin : Origins.Origin;
-- Optional
Depends_On : Dependencies := No_Dependencies;
Properties : Alire.Properties.Vector := No_Properties;
@@ -45,7 +44,7 @@ package Alire.Index is
Version : Semantic_Versioning.Version;
Description : Project_Description;
Hosting : URL;
Commit : Repositories.Git.Commit_ID;
Commit : Origins.Git_Commit;
-- Optional
Properties : Alire.Properties.Vector := No_Properties;
Requisites : Alire.Requisites.Tree := No_Requisites;
@@ -121,15 +120,14 @@ private
Version : Semantic_Versioning.Version;
Description : Project_Description;
Hosting : URL;
Commit : Repositories.Git.Commit_ID;
Commit : Origins.Git_Commit;
Properties : Alire.Properties.Vector := No_Properties;
Requisites : Alire.Requisites.Tree := No_Requisites;
Depends_On : Dependencies := No_Dependencies) return Release
is (Register (Project,
Version,
Description,
Repositories.Git.New_Repository (String (Hosting)),
Repositories.Release_Id (Commit),
Origins.New_Git (Hosting, Commit),
Depends_On,
Properties => Properties,
Requisites => Requisites,
src/alire-origins.ads
+59 -10
View File
@@ -1,21 +1,70 @@
package Alire.Origins is
private with Ada.Strings.Unbounded;
package Alire.Origins with Preelaborate is
-- Minimal information about origins of sources.
-- We use the term origins to avoid mixing 'alire sources' with 'project sources' or other 'sources'.
-- The actual capabilities for check-outs or fetches are in alr proper
type Kinds is (Apt, Git, Hg, HTTP, RPM);
-- Only Apt-installed and Git remotes supported, for now
type Kinds is (Filesystem, -- Not really an origin, but a working copy of a project
Git, -- Remote git repo
Local_Apt -- Native platform package
);
type Origin (Kind : Kinds) is tagged private;
type Origin is tagged private;
function New_Origin (Kind : Kinds;
URL : Alire.URL; -- A locator for the resource/server/entity containing the sources
ID : String) -- A unique identifier within the server (commit id, zipfile, package name...)
return Origin;
-- This should be general enough for all foreseeable sources.
function Kind (This : Origin) return Kinds;
function URL (This : Origin) return String;
function URL (This : Origin) return Alire.URL;
function Id (This : Origin) return String;
-- Helper types
subtype Git_Commit is String (1 .. 40);
-- Constructors
function New_Filesystem (URL_As_Path : String) return Origin;
function New_Git (URL : Alire.URL;
Id : Git_Commit)
return Origin;
function New_Local_Apt (Id_As_Package_Name : String) return Origin;
private
use Ada.Strings.Unbounded;
type Origin is tagged record
Kind : Kinds;
URL : Unbounded_String;
Id : Unbounded_String;
end record;
function New_Filesystem (URL_As_Path : String) return Origin is
(Filesystem,
Null_Unbounded_String,
To_Unbounded_String (URL_As_Path));
function New_Git (URL : Alire.URL;
Id : Git_Commit)
return Origin is
(Git,
To_Unbounded_String (URL),
To_Unbounded_String (Id));
function New_Local_Apt (Id_As_Package_Name : String) return Origin is
(Filesystem,
To_Unbounded_String (Id_As_Package_Name),
Null_Unbounded_String);
function Kind (This : Origin) return Kinds is (This.Kind);
function URL (This : Origin) return Alire.URL is (Alire.URL (To_String (This.URL)));
function Id (This : Origin) return String is (To_String (This.Id));
end Alire.Origins;
src/alire-os_lib.adb
+8 -4
View File
@@ -226,10 +226,14 @@ package body Alire.OS_Lib is
Current : constant String := Ada.Directories.Current_Directory;
begin
return Guard : Folder_Guard (Current'Length) do
Guard.Original := Current;
Log ("Entering folder: " & Path, Debug);
Ada.Directories.Set_Directory (Path);
Guard.Initialized := True;
if Path /= Current then
Guard.Original := Current;
Log ("Entering folder: " & Path, Debug);
Ada.Directories.Set_Directory (Path);
Guard.Initialized := True;
else
Guard.Initialized := False;
end if;
end return;
end Enter_Folder;
src/alire-releases.adb
-20
View File
@@ -1,20 +0,0 @@
with GNAT.OS_Lib;
package body Alire.Releases is
--------------
-- Checkout --
--------------
procedure Checkout (R : Release; Parent_Folder : String) is
use GNAT.OS_Lib;
Folder : constant String := Parent_Folder & Directory_Separator & R.Unique_Folder;
begin
if Is_Directory (Folder) then
raise File_Error with "Destination of checkout already exists.";
else
R.Repository.Constant_Reference.Checkout (R.Id, Folder);
end if;
end Checkout;
end Alire.Releases;
src/alire-releases.ads
+24 -27
View File
@@ -1,6 +1,7 @@
with Alire.Dependencies.Vectors;
with Alire.Origins;
with Alire.Properties;
with Alire.Repositories;
with Alire.Requisites;
with Semantic_Versioning;
@@ -14,8 +15,7 @@ package Alire.Releases with Preelaborate is
function New_Release (Name : Project_Name;
Description : Project_Description;
Version : Semantic_Versioning.Version;
Repository : Repositories.Repository'Class;
Id : Repositories.Release_Id;
Origin : Origins.Origin;
Depends_On : Dependencies;
Properties : Alire.Properties.Vector;
Requisites : Alire.Requisites.Tree;
@@ -27,7 +27,8 @@ package Alire.Releases with Preelaborate is
function Description (R : Release) return Project_Description;
function Version (R : Release) return Semantic_Versioning.Version;
function Depends (R : Release) return Dependencies;
function Repo_Image (R : Release) return String;
function Origin (R : Release) return Origins.Origin;
-- function Origin_Image (R : Release) return String;
function Image (R : Release) return String;
-- Unique string built as name-version-id
@@ -39,18 +40,13 @@ package Alire.Releases with Preelaborate is
function Is_Native (R : Release) return Boolean;
-- not alr packaged but from the platform
procedure Checkout (R : Release; Parent_Folder : String);
-- Appends its unique folder to Parent_Folder
-- May raise File_Error
private
type Release (Name_Len, Descr_Len, Id_Len : Natural) is tagged record
type Release (Name_Len, Descr_Len : Natural) is tagged record
Name : Project_Name (1 .. Name_Len);
Description: Project_Description (1 .. Descr_Len);
Version : Semantic_Versioning.Version;
Repository : Repositories.Repository_H;
Id : Repositories.Release_Id (1 .. Id_Len);
Version : Semantic_Versioning.Version;
Origin : Origins.Origin;
Depends_On : Dependencies;
Props : Properties.Vector;
Reqs : Requisites.Tree;
@@ -60,49 +56,50 @@ private
function New_Release (Name : Project_Name;
Description : Project_Description;
Version : Semantic_Versioning.Version;
Repository : Repositories.Repository'Class;
Id : Repositories.Release_Id;
Origin : Origins.Origin;
Depends_On : Dependencies;
Properties : Alire.Properties.Vector;
Requisites : Alire.Requisites.Tree;
Native : Boolean) return Release is
(Name'Length, Description'Length, Id'Length,
(Name'Length, Description'Length,
Name,
Description,
Version,
Repositories.To_Holder (Repository),
Id,
Origin,
Depends_On,
Properties,
Requisites,
Native);
use all type Semantic_Versioning.Version;
use Semantic_Versioning;
function "<" (L, R : Release) return Boolean is
(L.Project < R.Project or else
(L.Project = R.Project and then L.Version < R.Version) or else
(L.Project = R.Project and then
L.Version = R.Version and then
L.Repository.Element.Image < R.Repository.Element.Image));
(L.Project = R.Project and then
L.Version < R.Version) or else
(L.Project = R.Project and then
L.Version = R.Version and then
Build (L.Version) < Build (R.Version)));
function Project (R : Release) return Project_Name is (R.Name);
function Description (R : Release) return Project_Description is (R.Description);
function Version (R : Release) return Semantic_Versioning.Version is (R.Version);
function Depends (R : Release) return Dependencies is (R.Depends_On);
function Origin (R : Release) return Origins.Origin is (R.Origin);
function Is_Native (R : Release) return Boolean is (R.Native);
-- FIXME: this should be OS-sanitized to be a valid path
function Image (R : Release) return String is
(R.Project & "_" &
Semantic_Versioning.Image (R.Version) & "_" &
(if R.Id'Length <= 8 then R.Id else R.Id (R.Id'First .. R.Id'First + 7)));
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)));
function Milestone_Image (R : Release) return String is
(R.Project & "=" & Semantic_Versioning.Image (R.Version));
(R.Project & "=" & Image (R.Version));
function Repo_Image (R : Release) return String is
(R.Repository.Element.Image);
-- function Repo_Image (R : Release) return String is
-- (R.Repository.Element.Image);
end Alire.Releases;
src/alire-repositories-apt.adb
-19
View File
@@ -1,19 +0,0 @@
with Alire.OS_Lib;
package body Alire.Repositories.Apt is
--------------
-- Checkout --
--------------
overriding procedure Checkout (R : Repository; Id : Release_Id; Folder : String) is
pragma Unreferenced (R, Folder);
begin
Trace.Always ("sudo needed to install platform package " & Id);
OS_Lib.Spawn_Bypass ("sudo", "apt-get install -q -q -y " & Id);
exception
when others =>
Trace.Error ("Installation of native package " & Id & " failed");
end Checkout;
end Alire.Repositories.Apt;
src/alire-repositories-apt.ads
-19
View File
@@ -1,19 +0,0 @@
package Alire.Repositories.Apt is
type Repository (<>) is new Repositories.Repository with private;
Repo : constant Repository;
overriding function Image (Repo : Repository) return String;
overriding procedure Checkout (R : Repository; Id : Release_Id; Folder : String);
private
type Repository is new Repositories.Repository with null record;
Repo : constant Repository := (Repositories.Repository with null record);
function Image (Repo : Repository) return String is ("aptlocal");
end Alire.Repositories.Apt;
src/alire-repositories-git.adb
-29
View File
@@ -1,29 +0,0 @@
with Ada.Directories;
with Alire.OS_Lib;
package body Alire.Repositories.Git is
overriding procedure Checkout (R : Repository; Id : Release_Id; Folder : String) is
begin
Log ("Checking out: " & R.Image);
OS_Lib.Spawn ("git", "clone -n -q --progress " & R.Image & " " & Folder);
declare
use Ada.Directories;
Parent : constant String := Current_Directory;
begin
Set_Directory (Folder);
OS_Lib.Spawn ("git", "reset --hard -q " & Id);
Set_Directory (Parent);
end;
exception
when others =>
Trace.Error ("Checkout of " & Id & " from " & R.Image & " to " & Folder & " failed");
if Ada.Directories.Exists (Folder) then
Ada.Directories.Delete_Tree (Folder);
end if;
raise;
end Checkout;
end Alire.Repositories.Git;
src/alire-repositories-git.ads
-26
View File
@@ -1,26 +0,0 @@
package Alire.Repositories.Git is
subtype Commit_ID is String (1 .. 40);
type Repository (<>) is new Repositories.Repository with private;
not overriding function New_Repository (URL : String) return Repository;
overriding function Image (Repo : Repository) return String;
overriding procedure Checkout (R : Repository; Id : Release_Id; Folder : String)
with Pre => Id in Commit_Id;
private
type Repository (URL_Length : Natural) is new Repositories.Repository with record
URL : String (1 .. URL_Length);
end record;
function New_Repository (URL : String) return Repository
is (URL_Length => Url'Length,
URL => URL);
function Image (Repo : Repository) return String is (Repo.URL);
end Alire.Repositories.Git;
src/alire-repositories-local.ads
-26
View File
@@ -1,26 +0,0 @@
package Alire.Repositories.Local is
-- Special repository meant to be used for the current project, which is not checked out
-- For this reason, its checkout is never useful and raises Program_Error
type Repository (<>) is new Repositories.Repository with private;
Repo : constant Repository;
Local_Id : constant Release_Id;
overriding function Image (Repo : Repository) return String is
(raise Program_Error);
overriding procedure Checkout (R : Repository; Id : Release_Id; Folder : String) is null
with Pre'Class => (raise Program_Error);
private
type Repository is new Repositories.Repository with null record;
Repo : constant Repository := (Repositories.Repository with null record);
Local_Id : constant Release_Id := "local"; -- not "" because that fails assertion on length
end Alire.Repositories.Local;
src/alire-repositories.ads
-30
View File
@@ -1,30 +0,0 @@
with Ada.Containers.Indefinite_Holders;
package Alire.Repositories with Preelaborate is
subtype Release_Id is String
with Dynamic_Predicate => Release_Id'Length > 0;
-- Uniquely identifies a particular release within a repository
-- E.g., git/hg hashes, a zip file within a file server...
type Repository is interface;
function Image (Repo : Repository) return String is abstract;
function "<" (L, R : Repository'Class) return Boolean is (L.Image < R.Image);
function "=" (L, R : Repository'Class) return Boolean is (L.Image = R.Image);
procedure Checkout (R : Repository; Id : Release_Id; Folder : String)
is abstract
-- Minimum defence against improper command spawning
with Pre'Class => (for all C of Folder => C /= ' ') and
(for all C of Id => C /= ' ') and
(for all C of R.Image => C /= ' ');
-- Folder must afterwards contain the checked-out repository
package Repository_Holders is new Ada.Containers.Indefinite_Holders (Repository'Class);
type Repository_H is new Repository_Holders.Holder with null record;
end Alire.Repositories;
src/alire-root_project.adb
+6 -3
View File
@@ -1,6 +1,8 @@
with Ada.Directories;
with Alire.Origins;
with Alire.Properties;
with Alire.Requisites;
with Alire.Repositories.Local;
package body Alire.Root_Project is
@@ -13,12 +15,13 @@ package body Alire.Root_Project is
Depends_On : Dependencies.Vectors.Vector := Dependencies.Vectors.No_Dependencies)
return Releases.Release
is
use Origins;
Rel : constant Releases.Release :=
Alire.Releases.New_Release (Project,
"working copy of " & Project, -- FIXME might be too long
Version,
Alire.Repositories.Local.Repo,
"filesystem",
New_Filesystem (Ada.Directories.Current_Directory),
Depends_On,
Properties => Properties.No_Properties,
Requisites => Requisites.No_Requisites,
src/alire.ads
+1 -3
View File
@@ -2,9 +2,7 @@ with Simple_Logging;
package Alire with Preelaborate is
File_Error : exception;
type URL is new String;
subtype URL is String;
Max_Name_Length : constant := 72; -- Github maximum is 100 and bitbucket 128, but since Description is 72...
Max_Description_Length : constant := 72; -- Git line recommendation (although it's 50 for subject line)