New alr cache

.gitmodules

@@ -60,3 +60,9 @@
 [submodule "deps/dirty_booleans"]
 	path = deps/dirty_booleans
 	url = https://github.com/mosteo/dirty_booleans
+[submodule "deps/den"]
+	path = deps/den
+	url = https://github.com/mosteo/den
+[submodule "deps/cstrings"]
+	path = deps/cstrings
+	url = https://github.com/mosteo/cstrings

alire.gpr

@@ -3,7 +3,9 @@ with "ada_toml";
 with "alire_common";
 with "ajunitgen";
 with "ansiada";
+with "c_strings";
 with "clic";
+with "den";
 with "dirty_booleans";
 with "diskflags";
 with "gnatcoll";

alire.toml

@@ -19,7 +19,9 @@ aaa = "~0.3.0"
 ada_toml = "~0.3"
 ajunitgen = "^1.0.1"
 ansiada = "^1.0"
+c_strings = "^1.0"
 clic = "~0.3"
+den = "~0.1"
 dirty_booleans = "~0.1"
 diskflags = "~0.1"
 gnatcoll = "^21"
@@ -48,18 +50,27 @@ windows = { ALIRE_OS = "windows" }
 
 # Some dependencies require precise versions during the development cycle:
 [[pins]]
+
 [pins.aaa]
 url    = "https://github.com/mosteo/aaa"
-commit = "dff61d2615cc6332fa6205267bae19b4d044b9da"
+commit = "0c3b440ac183c450345d4a67d407785678779aae"
 
 [pins.ada_toml]
 url    = "https://github.com/mosteo/ada-toml"
 commit = "da4e59c382ceb0de6733d571ecbab7ea4919b33d"
 
+[pins.c_strings]
+url    = "https://github.com/mosteo/cstrings"
+commit = "e4d58ad90bf32bc44304197e5906a519f5a9a7bf"
+
 [pins.clic]
 url    = "https://github.com/alire-project/clic"
 commit = "56bbdc008e16996b6f76e443fd0165a240de1b13"
 
+[pins.den]
+url    = "https://github.com/mosteo/den"
+commit = "35d1f38395b93766dd64bca5901ce3b6a416ba1a"
+
 [pins.dirty_booleans]
 url    = "https://github.com/mosteo/dirty_booleans"
 commit = "05c40d88ecfe109e575ec8b21dd6ffa2e61df1dc"

alr_env.gpr

@@ -14,6 +14,8 @@ aggregate project Alr_Env is
                          "deps/ajunitgen",
                          "deps/ansi",
                          "deps/clic",
+                         "deps/cstrings",
+                         "deps/den",
                          "deps/dirty_booleans",
                          "deps/diskflags",
                          "deps/gnatcoll-slim",

src/alire/alire-builds.adb

@@ -1,11 +1,11 @@
 with AAA.Strings;
 
-with Alire.Settings.Builtins;
-with Alire.Settings.Edit;
+with Alire.Cache;
 with Alire.Directories;
 with Alire.Flags;
 with Alire.Paths.Vault;
 with Alire.Roots;
+with Alire.Settings.Builtins;
 
 with GNATCOLL.VFS;
 
@@ -83,7 +83,7 @@ package body Alire.Builds is
    ----------
 
    function Path return Absolute_Path
-   is (Settings.Edit.Cache_Path
+   is (Cache.Path
        / Paths.Build_Folder_Inside_Working_Folder);
 
    ----------

src/alire/alire-cache.adb

@@ -0,0 +1,126 @@
+with Ada.Calendar;
+
+with Alire.Directories;
+with Alire.Paths;
+with Alire.Platforms.Folders;
+with Alire.Settings.Builtins;
+with Alire.Settings.Edit;
+
+with Den.Du;
+
+package body Alire.Cache is
+
+   use Alire.Directories.Operators;
+
+   package Adirs renames Ada.Directories;
+   package Du is new Den.Du;
+
+   ----------
+   -- Path --
+   ----------
+
+   function Path return Absolute_Path
+   is (if Settings.Builtins.Cache_Dir.Get /= "" then
+          Settings.Builtins.Cache_Dir.Get
+       elsif not Settings.Edit.Is_At_Default_Dir then
+          Settings.Edit.Path / Paths.Cache_Folder_Inside_Working_Folder
+       else
+          Platforms.Folders.Cache);
+
+   -----------
+   -- Usage --
+   -----------
+
+   function Usage return Usages is
+
+      Busy_Top : Simple_Logging.Ongoing :=
+                   Simple_Logging.Activity ("Listing");
+
+      Busy : Simple_Logging.Ongoing := Simple_Logging.Activity ("");
+
+      Last_Check : Ada.Calendar.Time := Ada.Calendar.Clock;
+
+      --------------
+      -- Progress --
+      --------------
+
+      procedure Progress (Path : String) is
+         use Ada.Calendar;
+      begin
+         if Clock - Last_Check >= 0.1
+           and then Directories.Is_File (Path / Alire.Paths.Crate_File_Name)
+         then
+            Busy_Top.Step;
+            Busy.Step (Adirs.Simple_Name (Path));
+            Last_Check := Clock;
+         end if;
+      end Progress;
+
+      Tree  : constant Du.Tree := Du.List (Path,
+                                           Progress => Progress'Access);
+
+      ----------------
+      -- Usage_Wrap --
+      ----------------
+
+      procedure Usage_Wrap (Parent   : in out Usages;
+                            Children : Du.Tree;
+                            Depth    : Depths;
+                            Branch   : String := ""
+                              --  Says if toolchains, releases, or builds
+                           )
+      is
+      begin
+         for Child of Children loop
+            declare
+               Branch           : constant String
+                 := (if Usage_Wrap.Branch /= ""
+                     then Usage_Wrap.Branch
+                     else Adirs.Simple_Name (Child.Element.Path));
+               Wrapped_Children : Usages;
+            begin
+
+               --  Wrap the children if we still have room to go down
+
+               if Depth < Release or else
+                 (Depth < Build
+                  and then Branch = Paths.Build_Folder_Inside_Working_Folder)
+               then
+                  Usage_Wrap (Wrapped_Children,
+                              Child.Element.Children,
+                              Depth  => Depths'Succ (Depth),
+                              Branch => Branch);
+               end if;
+
+               --  Create the wrapped node at the current depth
+
+               Parent.Insert
+                 (Item'
+                    (Depth    => Depth,
+                     Name     => +Adirs.Simple_Name (Child.Element.Path),
+                     Path     => +Child.Element.Path,
+                     Size     => Child.Tree_Size,
+                     Children => Wrapped_Children));
+            end;
+         end loop;
+      end Usage_Wrap;
+
+   begin
+      --  The root node should be the cache dir itself, unless there is still
+      --  no cache at all.
+      if Tree.Is_Empty then
+         return Item_Sets.Empty_Set;
+      elsif Tree.Length not in 1 then
+         raise Program_Error
+           with "Cache tree root length /= 1:" & Tree.Length'Image;
+      end if;
+
+      --  Iterate the obtained tree wrapping contents as our usage type
+      return Result : Usages do
+         Usage_Wrap (Result,
+                     Tree.First_Element.Element.Children,
+                     Depths'First);
+      end return;
+   end Usage;
+
+end Alire.Cache;

src/alire/alire-cache.ads

@@ -0,0 +1,111 @@
+with Ada.Containers.Indefinite_Ordered_Multisets;
+with Ada.Directories;
+
+package Alire.Cache is
+
+   --  Cache inspection and management. The cache is where we store all data
+   --  that, if not found, is re-downloaded or regenerated. This currently
+   --  comprises toolchains, pristine releases (the vault), builds, and the
+   --  user index fork clone when publishing.
+
+   function Path return Absolute_Path;
+   --  The location for data that will be recreated if missing; its value in
+   --  precedence order is:
+   --  1) Setting builtin 'cache.dir'
+   --  2) if Alire.Settings.Path is overridden, Settings.Path/cache
+   --  3) Platforms.Folders.Cache
+
+   subtype Sizes is Ada.Directories.File_Size;
+   --  A size, in bytes
+
+   --  The following builds a tree of items in the cache, that can be queried
+   --  to present information up to a level of detail.
+
+   type Depths is (Location, Release, Build);
+   --  Locations are the top-level folders: toolchains, releases, builds.
+   --  Releases are a unique release milestone plus short commit.
+   --  Builds are synced copies for a release, named as the release + build id.
+
+   type Base_Item is abstract tagged null record;
+
+   function "<" (L, R : Base_Item'Class) return Boolean;
+
+   function Depth (This : Base_Item'Class) return Depths;
+
+   function Name (This : Base_Item'Class) return String;
+
+   function Path (This : Base_Item'Class) return Absolute_Path;
+
+   function Size (This : Base_Item'Class) return Sizes;
+
+   package Item_Sets is
+     new Ada.Containers.Indefinite_Ordered_Multisets (Base_Item'Class);
+
+   subtype Usages is Item_Sets.Set;
+
+   function Children (This : Base_Item'Class) return Usages;
+
+   function Usage return Usages;
+   --  Compute cache usage. First level is locations, second level is releases,
+   --  third level is builds. Within level, childen are sorted by size.
+
+   type Item is new Base_Item with record
+      Depth    : Depths;
+      Name     : UString;
+      Path     : Unbounded_Absolute_Path;
+      Size     : Sizes; -- Accumulated size below this item
+      Children : Usages;
+   end record;
+
+   function Element (This : Base_Item'Class) return Item is (Item (This))
+     with Inline;
+
+private
+
+   use type Sizes;
+
+   --------------
+   -- Children --
+   --------------
+
+   function Children (This : Base_Item'Class) return Usages
+   is (This.Element.Children);
+
+   -----------
+   -- Depth --
+   -----------
+
+   function Depth (This : Base_Item'Class) return Depths
+   is (This.Element.Depth);
+
+   ----------
+   -- Name --
+   ----------
+
+   function Name (This : Base_Item'Class) return String
+   is (UStrings.To_String (This.Element.Name));
+
+   ----------
+   -- Path --
+   ----------
+
+   function Path (This : Base_Item'Class) return Absolute_Path
+   is (Absolute_Path (UStrings.To_String (This.Element.Path)));
+
+   ----------
+   -- Size --
+   ----------
+
+   function Size (This : Base_Item'Class) return Sizes is (This.Element.Size);
+
+   ---------
+   -- "<" --
+   ---------
+
+   function "<" (L, R : Base_Item'Class) return Boolean
+   is (L.Size > R.Size
+       or else
+         (L.Size = R.Size
+          and then L.Name < R.Name));
+
+end Alire.Cache;

src/alire/alire-paths-vault.ads

@@ -1,4 +1,4 @@
-with Alire.Settings.Edit;
+with Alire.Cache;
 
 package Alire.Paths.Vault is
 
@@ -10,7 +10,7 @@ package Alire.Paths.Vault is
    --  are run there (see Alire.Builds).
 
    function Path return Absolute_Path
-   is (Settings.Edit.Cache_Path
+   is (Cache.Path
        / Release_Folder_Inside_Working_Folder);
 
 end Alire.Paths.Vault;

src/alire/alire-settings-edit.adb

@@ -242,18 +242,6 @@ package body Alire.Settings.Edit is
       end if;
    end Path;
 
-   ----------------
-   -- Cache_Path --
-   ----------------
-
-   function Cache_Path return Absolute_Path
-   is (if Builtins.Cache_Dir.Get /= "" then
-          Builtins.Cache_Dir.Get
-       elsif Path /= Default_Config_Path then
-          Path / Paths.Cache_Folder_Inside_Working_Folder
-       else
-          Platforms.Folders.Cache);
-
    --------------
    -- Set_Path --
    --------------

src/alire/alire-settings-edit.ads

@@ -46,13 +46,6 @@ package Alire.Settings.Edit is
    --  * An ALIRE_SETTINGS_DIR env given folder
    --  * Default per-platform path (see alire-platforms-*)
 
-   function Cache_Path return Absolute_Path;
-   --  The location for data that will be recreated if missing; its value in
-   --  precedence order is:
-   --  1) Setting builtin 'cache.dir'
-   --  2) if Path above is overridden, Path/cache
-   --  3) Platforms.Folders.Cache
-
    procedure Set_Path (Path : Absolute_Path);
    --  Override global settings folder path