get command working

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;

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;

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;

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;

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;

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;

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;

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;

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;

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
    

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);

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;