Basic report

.gitmodules

@@ -60,3 +60,6 @@
 [submodule "deps/dirty_booleans"]
 	path = deps/dirty_booleans
 	url = https://github.com/mosteo/dirty_booleans
+[submodule "deps/ncdu"]
+	path = deps/ncdu
+	url = https://github.com/mosteo/ncdu-ada

alire.gpr

@@ -8,6 +8,7 @@ with "dirty_booleans";
 with "diskflags";
 with "gnatcoll";
 with "minirest";
+with "ncdu";
 with "optional";
 with "semantic_versioning";
 with "simple_logging";

alire.toml

@@ -24,6 +24,7 @@ dirty_booleans = "~0.1"
 diskflags = "~0.1"
 gnatcoll = "^21"
 minirest = "~0.3"
+ncdu = "~0.1"
 optional = "~0.1"
 semantic_versioning = "^3.0"
 simple_logging = "^2.0"
@@ -75,6 +76,10 @@ commit = "4e663b87a028252e7e074f054f8f453661397166"
 url    = "https://github.com/mosteo/minirest.git"
 commit = "9a9c660f9c6f27f5ef75417e7fac7061dff14d78"
 
+[pins.ncdu]
+url    = "https://github.com/mosteo/ncdu-ada.git"
+commit = "89f6deec1815b8b27ea906aeb51b323336122868"
+
 [pins.semantic_versioning]
 url    = "https://github.com/alire-project/semantic_versioning"
 commit = "cc2148cf9c8934fb557b5ae49a3f7947194fa7ee"

alr_env.gpr

@@ -18,6 +18,7 @@ aggregate project Alr_Env is
                          "deps/diskflags",
                          "deps/gnatcoll-slim",
                          "deps/minirest",
+                         "deps/ncdu",
                          "deps/optional",
                          "deps/semantic_versioning",
                          "deps/si_units",

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 Ncdu;
+
+package body Alire.Cache is
+
+   use Alire.Directories.Operators;
+
+   package Adirs renames Ada.Directories;
+   package Du is new Ncdu;
+
+   ----------
+   -- 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
 

src/alire/alire-toolchains.adb

@@ -3,7 +3,7 @@ with AAA.Text_IO;
 with Ada.Containers.Indefinite_Vectors;
 with Ada.Directories;
 
-with Alire.Settings.Edit;
+with Alire.Cache;
 with Alire.Directories;
 with Alire.Index;
 with Alire.Manifest;
@@ -12,6 +12,7 @@ with Alire.Paths;
 with Alire.Platforms.Current;
 with Alire.Properties;
 with Alire.Root;
+with Alire.Settings.Edit;
 with Alire.Toolchains.Solutions;
 with Alire.Warnings;
 
@@ -610,7 +611,7 @@ package body Alire.Toolchains is
    function Path return Absolute_Path
    is (if Settings.Builtins.Toolchain_Dir.Get /= ""
        then Settings.Builtins.Toolchain_Dir.Get
-       else Settings.Edit.Cache_Path / "toolchains");
+       else Cache.Path / "toolchains");
 
    ------------
    -- Deploy --

src/alire/os_windows/alire-settings-builtins-windows.ads

@@ -1,4 +1,5 @@
 --  Ensure config is loaded for some defaults below
+with Alire.Cache;
 with Alire.Settings.Edit.Early_Load;
 pragma Unreferenced (Alire.Settings.Edit.Early_Load);
 
@@ -21,7 +22,7 @@ package Alire.Settings.Builtins.Windows is
    Msys2_Install_Dir : constant Builtin := New_Builtin
      (Key  => "msys2.install_dir",
       Kind => Stn_Absolute_Path,
-      Def  => Settings.Edit.Cache_Path / "msys64",
+      Def  => Cache.Path / "msys64",
       Help =>
         "Directory where Alire will detect and/or install" &
         " msys2 system package manager. (Windows only)");