summary refs log tree commit diff
path: root/guix-gc.in
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2013-02-14 04:15:25 -0500
committerMark H Weaver <mhw@netris.org>2013-02-16 22:17:37 -0500
commite49951eb3e1e1a8e7bad6d7471483e70b0865352 (patch)
tree7924fec33724f1de6a1cdd0757c7ebe38c7bee6b /guix-gc.in
parent040860152e63bbafb2eb3e93619e18d107c96b55 (diff)
downloadguix-e49951eb3e1e1a8e7bad6d7471483e70b0865352.tar.gz
Replace individual scripts with master 'guix' script.
* scripts/guix.in: New script.

* Makefile.am (bin_SCRIPTS): Add 'scripts/guix'.  Remove 'guix-build',
  'guix-download', 'guix-import', 'guix-package', and 'guix-gc'.

  (MODULES): Add 'guix/scripts/build.scm', 'guix/scripts/download.scm',
  'guix/scripts/import.scm', 'guix/scripts/package.scm', and
  'guix/scripts/gc.scm'.

* configure.ac (AC_CONFIG_FILES): Add 'scripts/guix'.  Remove 'guix-build',
  'guix-download', 'guix-import', 'guix-package', and 'guix-gc'.

* guix-build.in, guix-download.in, guix-gc.in, guix-import.in,
  guix-package.in: Remove shell script boilerplate.  Move to guix-COMMAND.in
  to guix/scripts/COMMAND.scm.  Rename module from (guix-COMMAND) to
  (guix scripts COMMAND).  Change "guix-COMMAND" to "guix COMMAND" in
  usage help string.

* pre-inst-env.in: Add "@abs_top_builddir@/scripts" to the front of $PATH.
  Export $GUIX_UNINSTALLED.

* tests/guix-build.sh, tests/guix-daemon.sh, tests/guix-download.sh,
  tests/guix-gc.sh, tests/guix-package.sh: Use "guix COMMAND" instead of
  "guix-COMMAND".

* doc/guix.texi: Replace all occurrences of "guix-COMMAND" with
  "guix COMMAND".

* po/POTFILES.in: Update.
Diffstat (limited to 'guix-gc.in')
-rw-r--r--guix-gc.in183
1 files changed, 0 insertions, 183 deletions
diff --git a/guix-gc.in b/guix-gc.in
deleted file mode 100644
index 1a4a5413d9..0000000000
--- a/guix-gc.in
+++ /dev/null
@@ -1,183 +0,0 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-
-prefix="@prefix@"
-datarootdir="@datarootdir@"
-
-GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH"
-export GUILE_LOAD_COMPILED_PATH
-
-main='(module-ref (resolve-interface '\''(guix-gc)) '\'guix-gc')'
-exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
-         -c "(apply $main (cdr (command-line)))" "$@"
-!#
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix-gc)
-  #:use-module (guix ui)
-  #:use-module (guix store)
-  #:use-module (ice-9 match)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
-  #:use-module (srfi srfi-37)
-  #:export (guix-gc))
-
-
-;;;
-;;; Command-line options.
-;;;
-
-(define %default-options
-  ;; Alist of default option values.
-  `((action . collect-garbage)))
-
-(define (show-help)
-  (display (_ "Usage: guix-gc [OPTION]... PATHS...
-Invoke the garbage collector.\n"))
-  (display (_ "
-  -C, --collect-garbage[=MIN]
-                         collect at least MIN bytes of garbage"))
-  (display (_ "
-  -d, --delete           attempt to delete PATHS"))
-  (display (_ "
-      --list-dead        list dead paths"))
-  (display (_ "
-      --list-live        list live paths"))
-  (newline)
-  (display (_ "
-  -h, --help             display this help and exit"))
-  (display (_ "
-  -V, --version          display version information and exit"))
-  (newline)
-  (show-bug-report-information))
-
-(define (size->number str)
-  "Convert STR, a storage measurement representation such as \"1024\" or
-\"1MiB\", to a number of bytes.  Raise an error if STR could not be
-interpreted."
-  (define unit-pos
-    (string-rindex str char-set:digit))
-
-  (define unit
-    (and unit-pos (substring str (+ 1 unit-pos))))
-
-  (let* ((numstr (if unit-pos
-                     (substring str 0 (+ 1 unit-pos))
-                     str))
-         (num    (string->number numstr)))
-    (if num
-        (* num
-           (match unit
-             ("KiB" (expt 2 10))
-             ("MiB" (expt 2 20))
-             ("GiB" (expt 2 30))
-             ("TiB" (expt 2 40))
-             ("KB"  (expt 10 3))
-             ("MB"  (expt 10 6))
-             ("GB"  (expt 10 9))
-             ("TB"  (expt 10 12))
-             (""    1)
-             (_
-              (format (current-error-port) (_ "error: unknown unit: ~a~%")
-                      unit)
-              (exit 1))))
-        (begin
-          (format (current-error-port)
-                  (_ "error: invalid number: ~a") numstr)
-          (exit 1)))))
-
-(define %options
-  ;; Specification of the command-line options.
-  (list (option '(#\h "help") #f #f
-                (lambda args
-                  (show-help)
-                  (exit 0)))
-        (option '(#\V "version") #f #f
-                (lambda args
-                  (show-version-and-exit "guix-gc")))
-
-        (option '(#\C "collect-garbage") #f #t
-                (lambda (opt name arg result)
-                  (let ((result (alist-cons 'action 'collect-garbage
-                                            (alist-delete 'action result))))
-                   (match arg
-                     ((? string?)
-                      (let ((amount (size->number arg)))
-                        (if arg
-                            (alist-cons 'min-freed amount result)
-                            (begin
-                              (format (current-error-port)
-                                      (_ "error: invalid amount of storage: ~a~%")
-                                      arg)
-                              (exit 1)))))
-                     (#f result)))))
-        (option '(#\d "delete") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'action 'delete
-                              (alist-delete 'action result))))
-        (option '("list-dead") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'action 'list-dead
-                              (alist-delete 'action result))))
-        (option '("list-live") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'action 'list-live
-                              (alist-delete 'action result))))))
-
-
-;;;
-;;; Entry point.
-;;;
-
-(define (guix-gc . args)
-  (define (parse-options)
-    ;; Return the alist of option values.
-    (args-fold args %options
-               (lambda (opt name arg result)
-                 (leave (_ "~A: unrecognized option~%") name))
-               (lambda (arg result)
-                 (alist-cons 'argument arg result))
-               %default-options))
-
-  (install-locale)
-  (textdomain "guix")
-  (setvbuf (current-output-port) _IOLBF)
-  (setvbuf (current-error-port) _IOLBF)
-
-  (with-error-handling
-    (let ((opts  (parse-options))
-          (store (open-connection)))
-      (case (assoc-ref opts 'action)
-        ((collect-garbage)
-         (let ((min-freed (assoc-ref opts 'min-freed)))
-           (if min-freed
-               (collect-garbage store min-freed)
-               (collect-garbage store))))
-        ((delete)
-         (let ((paths (filter-map (match-lambda
-                                   (('argument . arg) arg)
-                                   (_ #f))
-                                  opts)))
-           (delete-paths store paths)))
-        ((list-dead)
-         (for-each (cut simple-format #t "~a~%" <>)
-                   (dead-paths store)))
-        ((list-live)
-         (for-each (cut simple-format #t "~a~%" <>)
-                   (live-paths store)))))))