diff --git a/src/alire-depends.ads b/src/alire-depends.ads index c0e799b0..29375c87 100644 --- a/src/alire-depends.ads +++ b/src/alire-depends.ads @@ -4,21 +4,21 @@ package Alire.Depends with Preelaborate is package Dependency_Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Dependency); - subtype Dependencies is Dependency_Vectors.Vector; + type Dependencies is new Dependency_Vectors.Vector with null record ; - function Nothing return Dependencies is (Dependency_Vectors.Empty_Vector); + function Nothing return Dependencies is (Dependency_Vectors.Empty_Vector with null record); function New_Dependency (Name : Project_Name; Versions : Semantic_Versioning.Version_Set) return Dependencies; function Depends_On (Name : Project_Name; Versions : Semantic_Versioning.Version_Set) return Dependencies renames New_Dependency; + function On (Name : Project_Name; + Versions : Semantic_Versioning.Version_Set) return Dependencies renames New_Dependency; function "and" (Dep1, Dep2 : Dependencies) return Dependencies; private - use all type Dependencies; - function New_Dependency (Name : Project_Name; Versions : Semantic_Versioning.Version_Set) return Dependencies is (To_Vector ((Name'Length, Name, To_Holder (Versions)), 1)); diff --git a/src/alire-index.ads b/src/alire-index.ads index 25112e53..6c621dda 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -2,6 +2,7 @@ with Alire.Containers; with Alire.Depends; with Alire.Releases; with Alire.Repositories.Git; +with Alire.Repositories.Local; with Semantic_Versioning; @@ -10,6 +11,8 @@ package Alire.Index is Releases : Containers.Release_Set; subtype Dependencies is Depends.Dependencies; + use all type Dependencies; + subtype Release is Alire.Releases.Release; subtype Solution is Containers.Version_Map; -- A dependence-valid mapping of project -> version @@ -31,6 +34,12 @@ package Alire.Index is Commit : Repositories.Git.Commit_ID; Depends_On : Dependencies := Depends.Nothing; License : Licenses := Unknown) return Release; + + function Register_Local (Project : Project_Name; + Version : Semantic_Versioning.Version; + Depends_On : Dependencies := Depends.Nothing; + License : Licenses := Unknown) return Release; + -- Shortcuts to give dependencies: @@ -46,14 +55,14 @@ package Alire.Index is subtype Version is Semantic_Versioning.Version; subtype Version_Set is Semantic_Versioning.Version_Set; - function At_Least_Within_Major (V : Version) return Version_Set renames Semantic_Versioning.At_Least_Within_Major; + function At_Least_Within_Major (P : Project_Name; V : Version) return Dependencies; - function At_Least (V : Version) return Version_Set renames Semantic_Versioning.At_Least; - function At_Most (V : Version) return Version_Set renames Semantic_Versioning.At_Most; - function Less_Than (V : Version) return Version_Set renames Semantic_Versioning.Less_Than; - function More_Than (V : Version) return Version_Set renames Semantic_Versioning.More_Than; - function Exactly (V : Version) return Version_Set renames Semantic_Versioning.Exactly; - function Except (V : Version) return Version_Set renames Semantic_Versioning.Except; + function At_Least (P : Project_Name; V : Version) return Dependencies; + function At_Most (P : Project_Name; V : Version) return Dependencies; + function Less_Than (P : Project_Name; V : Version) return Dependencies; + function More_Than (P : Project_Name; V : Version) return Dependencies; + function Exactly (P : Project_Name; V : Version) return Dependencies; + function Except (P : Project_Name; V : Version) return Dependencies; private @@ -70,6 +79,16 @@ private Depends_On, License)); + function Register_Local (Project : Project_Name; + Version : Semantic_Versioning.Version; + Depends_On : Dependencies := Depends.Nothing; + License : Licenses := Unknown) return Release is + (Register (Project, + Version, + Repositories.Local.Repo, "", + Depends_On, + License)); + use Depends; use Semantic_Versioning; @@ -94,5 +113,26 @@ private function Except (R : Release) return Dependencies is (New_Dependency (R.Project, Except (R.Version))); + + function At_Least_Within_Major (P : Project_Name; V : Version) return Dependencies is + (Depends_On (P, At_Least_Within_Major (V))); + + function At_Least (P : Project_Name; V : Version) return Dependencies is + (Depends_On (P, At_Least (V))); + + function At_Most (P : Project_Name; V : Version) return Dependencies is + (Depends_On (P, At_Most (V))); + + function Less_Than (P : Project_Name; V : Version) return Dependencies is + (Depends_On (P, Less_Than (V))); + + function More_Than (P : Project_Name; V : Version) return Dependencies is + (Depends_On (P, More_Than (V))); + + function Exactly (P : Project_Name; V : Version) return Dependencies is + (Depends_On (P, Exactly (V))); + + function Except (P : Project_Name; V : Version) return Dependencies is + (Depends_On (P, Except (V))); end Alire.Index; diff --git a/src/alire-os_lib.adb b/src/alire-os_lib.adb index a6ebd295..496f9c30 100644 --- a/src/alire-os_lib.adb +++ b/src/alire-os_lib.adb @@ -1,3 +1,4 @@ +with Ada.Directories; with GNAT.OS_Lib; package body Alire.OS_Lib is @@ -43,4 +44,30 @@ package body Alire.OS_Lib is end if; end Spawn; + ------------------ + -- Enter_Folder -- + ------------------ + + function Enter_Folder (Path : String) return Folder_Guard is + Current : constant String := Ada.Directories.Current_Directory; + begin + return Guard : Folder_Guard (Current'Length) do + Guard.Original := Current; + Ada.Directories.Set_Directory (Path); + Guard.Initialized := True; + end return; + end Enter_Folder; + + -------------- + -- Finalize -- + -------------- + + overriding procedure Finalize (This : in out Folder_Guard) is + begin + if This.Initialized then + Ada.Directories.Set_Directory (This.Original); + -- FIXME: what if this throws? + end if; + end Finalize; + end Alire.OS_Lib; diff --git a/src/alire-os_lib.ads b/src/alire-os_lib.ads index 19bcf230..6456744a 100644 --- a/src/alire-os_lib.ads +++ b/src/alire-os_lib.ads @@ -1,4 +1,6 @@ -package Alire.OS_Lib with Preelaborate is +with Ada.Finalization; + +package Alire.OS_Lib is function Spawn (Command : String; Arguments : String) return Integer; @@ -7,5 +9,20 @@ package Alire.OS_Lib with Preelaborate is procedure Spawn (Command : String; Arguments : String); -- Raises PROGRAM_ERROR if exit code /= 0 + + type Folder_Guard (<>) is limited private; + -- use this type in conjunction with Enter_Folder to ensure that + -- the CWD is modified and restored when creating/destroying the Folder_Guard + + function Enter_Folder (Path : String) return Folder_Guard; + +private + + type Folder_Guard (Original_Len : Positive) is new Ada.Finalization.Limited_Controlled with record + Original : String (1 .. Original_Len); + Initialized : Boolean := False; + end record; + + overriding procedure Finalize (This : in out Folder_Guard); end Alire.OS_Lib; diff --git a/src/alire-index-query.adb b/src/alire-query.adb similarity index 97% rename from src/alire-index-query.adb rename to src/alire-query.adb index 4a353772..392c4bf2 100644 --- a/src/alire-index-query.adb +++ b/src/alire-query.adb @@ -1,4 +1,6 @@ -package body Alire.Index.Query is +with Alire.Containers; + +package body Alire.Query is ------------ -- Exists -- @@ -110,4 +112,4 @@ package body Alire.Index.Query is return Resolve (Deps, Containers.Project_Release_Maps.Empty_Map); end Resolve; -end Alire.Index.Query; +end Alire.Query; diff --git a/src/alire-index-query.ads b/src/alire-query.ads similarity index 70% rename from src/alire-index-query.ads rename to src/alire-query.ads index ed668c10..d1cf71b9 100644 --- a/src/alire-index-query.ads +++ b/src/alire-query.ads @@ -1,4 +1,6 @@ -package Alire.Index.Query is +with Alire.Index; use Alire.Index; + +package Alire.Query is function Exists (Project : Project_Name) return Boolean; @@ -6,4 +8,4 @@ package Alire.Index.Query is procedure Print_Solution (I : Instance); -end Alire.Index.Query; +end Alire.Query; diff --git a/src/alire-releases.ads b/src/alire-releases.ads index 24fda58a..d98fa42f 100644 --- a/src/alire-releases.ads +++ b/src/alire-releases.ads @@ -7,7 +7,7 @@ is subtype Dependencies is Depends.Dependencies; - type Release (<>) is tagged private; + type Release (<>) is tagged private; function New_Release (Project : Project_Name; Version : Semantic_Versioning.Version; diff --git a/src/alire-repositories-git.adb b/src/alire-repositories-git.adb index b3b5c549..e83c5454 100644 --- a/src/alire-repositories-git.adb +++ b/src/alire-repositories-git.adb @@ -6,14 +6,14 @@ package body Alire.Repositories.Git is overriding procedure Checkout (R : Repository; Id : Release_Id; Folder : String) is begin - OS_Lib.Spawn ("git", "clone -n " & R.Image & " " & Folder); + OS_Lib.Spawn ("git", "clone -n -q " & R.Image & " " & Folder); declare use Ada.Directories; Parent : constant String := Current_Directory; begin Set_Directory (Folder); - OS_Lib.Spawn ("git", "reset --hard " & Id); + OS_Lib.Spawn ("git", "reset --hard -q " & Id); Set_Directory (Parent); end; end Checkout; diff --git a/src/alire-repositories-local.ads b/src/alire-repositories-local.ads new file mode 100644 index 00000000..cbb2baa9 --- /dev/null +++ b/src/alire-repositories-local.ads @@ -0,0 +1,22 @@ +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; + + 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); + +end Alire.Repositories.Local; diff --git a/src/alire.ads b/src/alire.ads index d3165a97..ae16d97c 100644 --- a/src/alire.ads +++ b/src/alire.ads @@ -7,18 +7,17 @@ with Semantic_Versioning; package Alire with Preelaborate is File_Error : exception; - - + type URL is new String; - - + subtype Project_Name is String; + -- FIXME: add predicate on valid characters (must be a valid gnat filename part) type Licenses is (Unknown); - - + -- FIXME: use this information to look for solutions with compatible licenses + type Dependency (<>) is tagged private;