diff --git a/src/alire-containers.ads b/src/alire-containers.ads index a216b83c..e0fe61ba 100644 --- a/src/alire-containers.ads +++ b/src/alire-containers.ads @@ -1,6 +1,5 @@ with Ada.Containers.Indefinite_Ordered_Maps; with Ada.Containers.Indefinite_Ordered_Sets; -with Ada.Containers.Indefinite_Vectors; with Alire.Releases; @@ -10,12 +9,16 @@ package Alire.Containers with Preelaborate is Releases."<", Releases."="); subtype Release_Set is Release_Sets.Set; - - package Milestone_Sets is new Ada.Containers.Indefinite_Ordered_Sets (Milestone); - subtype Milestone_Set is Milestone_Sets.Set; + +-- package Milestone_Sets is new Ada.Containers.Indefinite_Ordered_Sets (Milestone); +-- subtype Milestone_Set is Milestone_Sets.Set; package Project_Version_Maps is new Ada.Containers.Indefinite_Ordered_Maps (Project_Name, Semantic_Versioning.Version, "<", Semantic_Versioning."<"); subtype Version_Map is Project_Version_Maps.Map; + + package Project_Release_Maps is new Ada.Containers.Indefinite_Ordered_Maps + (Project_Name, Releases.Release, "<", Releases."="); + subtype Release_Map is Project_Release_Maps.Map; end Alire.Containers; diff --git a/src/alire-index-query.adb b/src/alire-index-query.adb index c994eaa6..4a353772 100644 --- a/src/alire-index-query.adb +++ b/src/alire-index-query.adb @@ -19,30 +19,38 @@ package body Alire.Index.Query is -- Print_Solution -- -------------------- - procedure Print_Solution (Solution : Containers.Version_Map) is - use Containers.Project_Version_Maps; + procedure Print_Solution (I : Instance) is + use Containers.Project_Release_Maps; begin - for I in Solution.Iterate loop - Log (" " & Key (I) & "=" & Image (Element (I))); + for Rel of I loop + Log (" " & Rel.Milestone_Image); end loop; end Print_Solution; + ---------- + -- Fail -- + ---------- + + function Fail return Instance is (Containers.Project_Release_Maps.Empty_Map); + ------------- -- Resolve -- ------------- - function Fail return Containers.Version_Map is (Containers.Project_Version_Maps.Empty_Map); - function Resolve (Unresolved : Dependencies; - Frozen : Containers.Version_Map) return Containers.Version_Map + Frozen : Instance) return Instance is -- FIXME: since this is depth-first, Frozen can be passed in-out and updated on the spot, -- thus saving copies. Probably the same applies to Unresolved. Dep : constant Dependency := Unresolved.First_Element; Remain : Dependencies := Unresolved; + --------------- + -- Go_Deeper -- + --------------- + function Go_Deeper (Unresolved : Dependencies; - Frozen : Containers.Version_Map) return Containers.Version_Map + Frozen : Instance) return Instance is begin if Unresolved.Is_Empty then @@ -58,7 +66,7 @@ package body Alire.Index.Query is Remain.Delete_First; if Frozen.Contains (Dep.Project) then - if Satisfies (Frozen.Element (Dep.Project), Dep.Versions) then + if Satisfies (Frozen.Element (Dep.Project).Version, Dep.Versions) then -- Dependency already met, simply go down... return Go_Deeper (Remain, Frozen); else @@ -71,12 +79,12 @@ package body Alire.Index.Query is for R of reverse Index.Releases loop if Dep.Project = R.Project and then Satisfies (R.Version, Dep.Versions) then declare - New_Frozen : Containers.Version_Map := Frozen; - New_Remain : Dependencies := Remain; + New_Frozen : Instance := Frozen; + New_Remain : Dependencies := Remain; - Solution : Containers.Version_Map; + Solution : Instance; begin - New_Frozen.Insert (R.Project, R.Version); + New_Frozen.Insert (R.Project, R); New_Remain.Append (R.Depends); Solution := Go_Deeper (New_Remain, New_Frozen); @@ -97,9 +105,9 @@ package body Alire.Index.Query is -- Resolve -- ------------- - function Resolve (Deps : Dependencies) return Containers.Version_Map is + function Resolve (Deps : Dependencies) return Instance is begin - return Resolve (Deps, Containers.Project_Version_Maps.Empty_Map); + return Resolve (Deps, Containers.Project_Release_Maps.Empty_Map); end Resolve; end Alire.Index.Query; diff --git a/src/alire-index-query.ads b/src/alire-index-query.ads index 0834c85c..ed668c10 100644 --- a/src/alire-index-query.ads +++ b/src/alire-index-query.ads @@ -1,11 +1,9 @@ -with Alire.Containers; - -package Alire.Index.Query with Preelaborate is +package Alire.Index.Query is function Exists (Project : Project_Name) return Boolean; - function Resolve (Deps : Dependencies) return Containers.Version_Map; + function Resolve (Deps : Dependencies) return Instance; - procedure Print_Solution (Solution : Containers.Version_Map); + procedure Print_Solution (I : Instance); end Alire.Index.Query; diff --git a/src/alire-index.ads b/src/alire-index.ads index 67bbce26..25112e53 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -5,15 +5,15 @@ with Alire.Repositories.Git; with Semantic_Versioning; -package Alire.Index with Preelaborate is - --- Milestones : Containers.Milestone_Set; --- FIXME: Milestones seem entirely unused, wipe all cruft out +package Alire.Index is Releases : Containers.Release_Set; subtype Dependencies is Depends.Dependencies; - subtype Release is Alire.Releases.Release; + subtype Release is Alire.Releases.Release; + + subtype Solution is Containers.Version_Map; -- A dependence-valid mapping of project -> version + subtype Instance is Containers.Release_Map; -- A list of releases complying with a Solution function V (Semantic_Version : String) return Semantic_Versioning.Version renames Semantic_Versioning.New_Version; diff --git a/src/alire-os_lib.adb b/src/alire-os_lib.adb new file mode 100644 index 00000000..a6ebd295 --- /dev/null +++ b/src/alire-os_lib.adb @@ -0,0 +1,46 @@ +with GNAT.OS_Lib; + +package body Alire.OS_Lib is + + use GNAT.OS_Lib; + + -------------------- + -- Locate_In_Path -- + -------------------- + + function Locate_In_Path (Name : String) return String is + Target : String_Access := Locate_Exec_On_Path (Name); + begin + if Target /= null then + return Result : constant String := Target.all do + Free (Target); + end return; + else + raise Program_Error with "Could not locate " & Name & " in $PATH"; + end if; + end Locate_In_Path; + + ----------- + -- Spawn -- + ----------- + -- FIXME: memory leaks + function Spawn (Command : String; + Arguments : String) return Integer is + (Spawn (Locate_In_Path (Command), + Argument_String_To_List (Arguments).all)); + + ----------- + -- Spawn -- + ----------- + + procedure Spawn (Command : String; + Arguments : String) + is + Code : constant Integer := Spawn (Command, Arguments); + begin + if Code /= 0 then + raise Program_Error with "Exit code:" & Code'Image; + end if; + end Spawn; + +end Alire.OS_Lib; diff --git a/src/alire-os_lib.ads b/src/alire-os_lib.ads new file mode 100644 index 00000000..19bcf230 --- /dev/null +++ b/src/alire-os_lib.ads @@ -0,0 +1,11 @@ +package Alire.OS_Lib with Preelaborate is + + function Spawn (Command : String; + Arguments : String) return Integer; + -- Returns exit code + + procedure Spawn (Command : String; + Arguments : String); + -- Raises PROGRAM_ERROR if exit code /= 0 + +end Alire.OS_Lib; diff --git a/src/alire-releases.adb b/src/alire-releases.adb new file mode 100644 index 00000000..fffb713e --- /dev/null +++ b/src/alire-releases.adb @@ -0,0 +1,16 @@ +with GNAT.OS_Lib; + +package body Alire.Releases is + + 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 ade68fa2..24fda58a 100644 --- a/src/alire-releases.ads +++ b/src/alire-releases.ads @@ -1,7 +1,9 @@ with Alire.Depends; with Alire.Repositories; -package Alire.Releases with Preelaborate is +package Alire.Releases +with Preelaborate +is subtype Dependencies is Depends.Dependencies; @@ -19,6 +21,17 @@ package Alire.Releases with Preelaborate is function Version (R : Release) return Semantic_Versioning.Version; function Depends (R : Release) return Dependencies; + function Image (R : Release) return String; + -- Unique string built as name-version-id + function Unique_Folder (R : Release) return String renames Image; + + function Milestone_Image (R : Release) return String; + -- project=version string + + procedure Checkout (R : Release; Parent_Folder : String); + -- Appends its unique folder to Parent_Folder + -- May raise File_Error + private type Release (Name_Len, Id_Len : Positive) is tagged record @@ -51,5 +64,12 @@ private function Project (R : Release) return Project_Name is (R.Project); function Version (R : Release) return Semantic_Versioning.Version is (R.Version); function Depends (R : Release) return Dependencies is (R.Depends_On); + + -- 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) & "_" & R.Id); + + function Milestone_Image (R : Release) return String is + (R.Project & "=" & Semantic_Versioning.Image (R.Version)); end Alire.Releases; diff --git a/src/alire-repositories-git.adb b/src/alire-repositories-git.adb new file mode 100644 index 00000000..b3b5c549 --- /dev/null +++ b/src/alire-repositories-git.adb @@ -0,0 +1,21 @@ +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 + OS_Lib.Spawn ("git", "clone -n " & R.Image & " " & Folder); + + declare + use Ada.Directories; + Parent : constant String := Current_Directory; + begin + Set_Directory (Folder); + OS_Lib.Spawn ("git", "reset --hard " & Id); + Set_Directory (Parent); + end; + end Checkout; + +end Alire.Repositories.Git; diff --git a/src/alire-repositories-git.ads b/src/alire-repositories-git.ads index 41a8a465..79ab5005 100644 --- a/src/alire-repositories-git.ads +++ b/src/alire-repositories-git.ads @@ -1,12 +1,15 @@ -package Alire.Repositories.Git with Preelaborate is +package Alire.Repositories.Git is + subtype Commit_ID is String (1 .. 40); + type Repository (<>) is new Repositories.Repository with private; - function New_Repository (URL : String) return Repository; + not overriding function New_Repository (URL : String) return Repository; - function Image (Repo : Repository) return String; + overriding function Image (Repo : Repository) return String; - subtype Commit_ID is String (1 .. 40); + overriding procedure Checkout (R : Repository; Id : Release_Id; Folder : String) + with Pre => Id in Commit_Id; private diff --git a/src/alire-repositories.ads b/src/alire-repositories.ads index 6cac69c3..94df078e 100644 --- a/src/alire-repositories.ads +++ b/src/alire-repositories.ads @@ -1,7 +1,11 @@ with Ada.Containers.Indefinite_Holders; package Alire.Repositories with Preelaborate is - + + subtype Release_Id is String; + -- 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; @@ -9,7 +13,13 @@ package Alire.Repositories with Preelaborate is function "<" (L, R : Repository'Class) return Boolean is (L.Image < R.Image); function "=" (L, R : Repository'Class) return Boolean is (L.Image = R.Image); - type Release_Id is new String; + 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); diff --git a/src/alire.ads b/src/alire.ads index 77b50783..d3165a97 100644 --- a/src/alire.ads +++ b/src/alire.ads @@ -4,7 +4,11 @@ private with GNAT.IO; -- For debugging purposes, FIXME getting rid of it and usi with Semantic_Versioning; -package Alire with Preelaborate is +package Alire with Preelaborate is + + File_Error : exception; + + type URL is new String;