From 499b166d1ce3ead61afb985053012ceb451f3beb Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 13 Feb 2019 15:27:36 +0100
Subject: guix system: Add 'delete-generations'.

* guix/scripts/package.scm (delete-matching-generations): Export.
* guix/scripts/system.scm (show-help): Add 'delete-generations'.
(process-command): Honor it.
(guix-system): Support it.
* doc/guix.texi (Invoking guix system): Document it.
---
 guix/scripts/system.scm | 17 +++++++++++++++--
 1 file changed, 15 insertions(+), 2 deletions(-)

(limited to 'guix/scripts/system.scm')

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 4c8d8acc8f..c0301eac2b 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -36,6 +36,8 @@
   #:use-module (guix profiles)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
+  #:autoload   (guix scripts package) (delete-generations
+                                       delete-matching-generations)
   #:use-module (guix graph)
   #:use-module (guix scripts graph)
   #:use-module (guix build utils)
@@ -962,10 +964,12 @@ Some ACTIONS support additional ARGS.\n"))
    reconfigure      switch to a new operating system configuration\n"))
   (display (G_ "\
    roll-back        switch to the previous operating system configuration\n"))
+  (display (G_ "\
+   list-generations list the system generations\n"))
   (display (G_ "\
    switch-generation switch to an existing operating system configuration\n"))
   (display (G_ "\
-   list-generations list the system generations\n"))
+   delete-generations delete old system generations\n"))
   (display (G_ "\
    build            build the operating system without installing anything\n"))
   (display (G_ "\
@@ -1202,6 +1206,14 @@ argument list and OPTS is the option alist."
      (apply (resolve-subcommand "search") args))
     ;; The following commands need to use the store, but they do not need an
     ;; operating system configuration file.
+    ((delete-generations)
+     (let ((pattern (match args
+                      (() "")
+                      ((pattern) pattern)
+                      (x (leave (G_ "wrong number of arguments~%"))))))
+       (with-store store
+         (delete-matching-generations store %system-profile pattern)
+         (reinstall-bootloader store (generation-number %system-profile)))))
     ((switch-generation)
      (let ((pattern (match args
                       ((pattern) pattern)
@@ -1228,7 +1240,8 @@ argument list and OPTS is the option alist."
         (let ((action (string->symbol arg)))
           (case action
             ((build container vm vm-image disk-image reconfigure init
-              extension-graph shepherd-graph list-generations roll-back
+              extension-graph shepherd-graph
+              list-generations delete-generations roll-back
               switch-generation search docker-image)
              (alist-cons 'action action result))
             (else (leave (G_ "~a: unknown action~%") action))))))
-- 
cgit v1.2.3