Towards progress processing

deps/simple_logging/src/simple_logging.adb

@@ -4,11 +4,12 @@ package body Simple_Logging is
 
    function Prefix (Level : Levels) return String is
      (case Level is
-         when Error => "ERROR: ",
+         when Always  => "",
+         when Error   => "ERROR: ",
          when WARNING => "Warning: ",
-         when Info => "",
-         when Detail => "-> ",
-         when Debug => "-->> ");
+         when Info    => "",
+         when Detail  => "-> ",
+         when Debug   => "-->> ");
 
    ---------
    -- Log --

deps/simple_logging/src/simple_logging.ads

@@ -1,6 +1,7 @@
 package Simple_Logging with Preelaborate is
 
-   type Levels is (Error,
+   type Levels is (Always,
+                   Error,
                    Warning,
                    Info,
                    Detail,

src/alire-os_lib.adb

@@ -1,5 +1,8 @@
+with GNAT.Expect;
 with GNAT.OS_Lib;
 
+with System;
+
 package body Alire.OS_Lib is
 
    use GNAT.OS_Lib;
@@ -20,17 +23,99 @@ package body Alire.OS_Lib is
       end if;
    end Locate_In_Path;
 
+   -------------------------
+   -- Spawn_With_Progress --
+   -------------------------
+
+   function Spawn_With_Progress (Command      : String;
+                                 Arguments    : String;
+                                 Percent_Only : Boolean) return Integer
+   is
+      use GNAT.Expect;
+
+      procedure Filter
+        (Descriptor : Process_Descriptor'Class;
+         Str        : String;
+         User_Data  : System.Address)
+      is
+         pragma Unreferenced (Descriptor, User_Data);
+      begin
+         Log ("X: " & Str, Always);
+      end Filter;
+
+      Pid : Process_Descriptor;
+
+      Trash : Expect_Match;
+   begin
+      Log ("A: " & Command & " " & Arguments, Always);
+      Non_Blocking_Spawn
+        (Pid,
+         Command,
+         Argument_String_To_List (Arguments).all,
+         Err_To_Out => True);
+      Log ("B", Always);
+      Add_Filter (Pid, Filter'Unrestricted_Access); -- No fear, clearly in scope
+      Log ("C", Always);
+
+      loop
+         begin
+            Expect (Pid, Trash, "");
+            Log ("D", Always);
+         exception
+            when Process_Died =>
+               exit;
+         end;
+      end loop;
+      Log ("D2", Always);
+
+      return Code : Integer do
+         Close (Pid, Code);
+         Log ("E", Always);
+      end return;
+   exception
+      when Process_Died =>
+         Log ("THE END", Always);
+         raise;
+   end Spawn_With_Progress;
+
    -----------
    -- Spawn --
    -----------
    -- FIXME: memory leaks
-   function Spawn (Command   : String;
-                   Arguments : String := "") return Integer is
+   function Spawn (Command             : String;
+                   Arguments           : String := "";
+                   Understands_Verbose : Boolean := False) return Integer
+   is
+      Extra : constant String := (if Understands_Verbose then "-v " else "");
+      File  : File_Descriptor;
+      Name  : String_Access;
+      Ok    : Boolean;
    begin
       Log ("Spawning: " & Command & " " & Arguments, Debug);
-      return
-        (Spawn (Locate_In_Path (Command),
-                Argument_String_To_List (Arguments).all));
+
+      case Simple_Logging.Level is
+         when Always | Error | Warning =>
+            Create_Temp_Output_File (File, Name);
+            return Code : Integer do
+               Spawn
+                 (Locate_In_Path (Command),
+                  Argument_String_To_List (Arguments).all,
+                  File,
+                  Code,
+                  Err_To_Out => False);
+               Delete_File (Name.all, Ok);
+               if not Ok then
+                  Log ("Failed to delete tmp file: " & Name.all, Warning);
+               end if;
+               Free (Name);
+            end return;
+         when Info | Detail =>
+            return Spawn_With_Progress (Command, Arguments, Percent_Only => Simple_Logging.Level = Info);
+         when Debug =>
+            return
+              (Spawn (Locate_In_Path (Command),
+               Argument_String_To_List (Extra & Arguments).all));
+      end case;
    end Spawn;
 
    -----------
@@ -38,9 +123,10 @@ package body Alire.OS_Lib is
    -----------
 
    procedure Spawn (Command   : String;
-                    Arguments : String := "")
+                    Arguments : String := "";
+                    Understands_Verbose : Boolean := False)
    is
-      Code : constant Integer := Spawn (Command, Arguments);
+      Code : constant Integer := Spawn (Command, Arguments, Understands_Verbose);
    begin
       if Code /= 0 then
          raise Program_Error with "Exit code:" & Code'Image;

src/alire-os_lib.ads

@@ -4,10 +4,13 @@ with Ada.Finalization;
 package Alire.OS_Lib is
 
    function Spawn (Command   : String;
-                   Arguments : String := "") return Integer;
+                   Arguments : String := "";
+                   Understands_Verbose : Boolean := False) return Integer;
+   --  If understands, an extra -v will be passed on Debug log levels
 
    procedure Spawn (Command   : String;
-                    Arguments : String:= "");
+                    Arguments : String := "";
+                    Understands_Verbose : Boolean := False);
    --  Raises PROGRAM_ERROR if exit code /= 0
 
    type Folder_Guard (<>) is limited private;