diff --git a/index/alire-index-example_dependencies.ads b/index/alire-index-example_dependencies.ads index 18990bfe..0dac94c5 100644 --- a/index/alire-index-example_dependencies.ads +++ b/index/alire-index-example_dependencies.ads @@ -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; diff --git a/src/alire-index.adb b/src/alire-index.adb index 37229ac5..d34071dc 100644 --- a/src/alire-index.adb +++ b/src/alire-index.adb @@ -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, diff --git a/src/alire-index.ads b/src/alire-index.ads index 638bf5cc..90ab559d 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -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, diff --git a/src/alire-origins.ads b/src/alire-origins.ads index 9866088a..f8244cc1 100644 --- a/src/alire-origins.ads +++ b/src/alire-origins.ads @@ -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; diff --git a/src/alire-os_lib.adb b/src/alire-os_lib.adb index 46e78f7d..7251df8c 100644 --- a/src/alire-os_lib.adb +++ b/src/alire-os_lib.adb @@ -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; diff --git a/src/alire-releases.adb b/src/alire-releases.adb deleted file mode 100644 index 9207a7d1..00000000 --- a/src/alire-releases.adb +++ /dev/null @@ -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; diff --git a/src/alire-releases.ads b/src/alire-releases.ads index f52e7437..47681278 100644 --- a/src/alire-releases.ads +++ b/src/alire-releases.ads @@ -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; diff --git a/src/alire-repositories-apt.adb b/src/alire-repositories-apt.adb deleted file mode 100644 index c6dac531..00000000 --- a/src/alire-repositories-apt.adb +++ /dev/null @@ -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; diff --git a/src/alire-repositories-apt.ads b/src/alire-repositories-apt.ads deleted file mode 100644 index e231898d..00000000 --- a/src/alire-repositories-apt.ads +++ /dev/null @@ -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; diff --git a/src/alire-repositories-git.adb b/src/alire-repositories-git.adb deleted file mode 100644 index aac26346..00000000 --- a/src/alire-repositories-git.adb +++ /dev/null @@ -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; diff --git a/src/alire-repositories-git.ads b/src/alire-repositories-git.ads deleted file mode 100644 index 79ab5005..00000000 --- a/src/alire-repositories-git.ads +++ /dev/null @@ -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; diff --git a/src/alire-repositories-local.ads b/src/alire-repositories-local.ads deleted file mode 100644 index c4ecdb81..00000000 --- a/src/alire-repositories-local.ads +++ /dev/null @@ -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; diff --git a/src/alire-repositories.ads b/src/alire-repositories.ads deleted file mode 100644 index aa2a269c..00000000 --- a/src/alire-repositories.ads +++ /dev/null @@ -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; diff --git a/src/alire-root_project.adb b/src/alire-root_project.adb index f14f3648..f03f2e07 100644 --- a/src/alire-root_project.adb +++ b/src/alire-root_project.adb @@ -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, diff --git a/src/alire.ads b/src/alire.ads index ab6a5882..0a79ee30 100644 --- a/src/alire.ads +++ b/src/alire.ads @@ -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)