From 2fb7feecbb781c35ad9a4f8a44896465af168264 Mon Sep 17 00:00:00 2001
From: Pierre Neidhardt <mail@ambrevar.xyz>
Date: Sat, 26 Dec 2020 16:19:49 +0100
Subject: [PATCH] ambrevar/guix: Add disk-usage-store and delete-store-items.

---
 .../common-lisp/source/ambrevar/guix.lisp     | 29 +++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/.local/share/common-lisp/source/ambrevar/guix.lisp b/.local/share/common-lisp/source/ambrevar/guix.lisp
index 2e966bed..25a62249 100644
--- a/.local/share/common-lisp/source/ambrevar/guix.lisp
+++ b/.local/share/common-lisp/source/ambrevar/guix.lisp
@@ -43,3 +43,32 @@
 (defun setup-all ()
   (share-setup-files)
   (publish))
+
+(export-always 'disk-usage-store)
+(defun disk-usage-store (&key (limit 30)
+                           dead?)
+  (flet ((size->human (pair)
+           (list (first pair)
+                 (sera:format-human-size nil (second pair))))
+         (pair-item-with-disk-usage (path)
+           ;; TODO: Replace `du' with native version? `disk-usage' only work on files.
+           (list path
+                 (parse-integer
+                  (first (first
+                          ($:tokenize
+                           ($:run* "du" "-sb" path))))))))
+    (mapcar
+     #'size->human
+     (sera:take
+      limit
+      (sort (mapcar #'pair-item-with-disk-usage
+                    (if dead?
+                        (alex:flatten ($:tokenize ($:run* "guix" "gc" "--list-dead")))
+                        ($:directory-listing "/gnu/store" :sort? t)))
+            #'> :key #'second)))))
+
+(export-always 'delete-store-items)
+(declaim (ftype (function (cons (or string pathname))) 'delete-store-items))
+(defun delete-store-items (items)
+  "Garbage-collect items."
+  (apply #'$:run* "guix" "gc" "--delete" items))