time-machine: Honor the standard build options.

* guix/scripts/time-machine.scm (show-help): Call 'show-build-options-help'.
(%options): Add %STANDARD-BUILD-OPTIONS.
(%default-options): New variable.
(parse-args): Pass (list %default-options) to 'parse-command-line' and
remove #:build-options? parameter.
(guix-time-machine): Call 'set-build-options-from-command-line' and wrap
'cached-channel-instance' call in 'with-status-verbosity'.
* doc/guix.texi (Invoking guix time-machine): Mention common build options.
This commit is contained in:
Ludovic Courtès 2019-11-15 21:48:35 +01:00
parent d17e012da7
commit 87e7faa2ae
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 46 additions and 13 deletions

View file

@ -4222,6 +4222,10 @@ will thus build the package @code{hello} as defined in the master branch,
which is in general a newer revison of Guix than you have installed. which is in general a newer revison of Guix than you have installed.
Time travel works in both directions! Time travel works in both directions!
Note that @command{guix time-machine} can trigger builds of channels and
their dependencies, and these are controlled by the standard build
options (@pxref{Common Build Options}).
@node Inferiors @node Inferiors
@section Inferiors @section Inferiors

View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net> ;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -22,8 +23,15 @@ (define-module (guix scripts time-machine)
#:use-module (guix inferior) #:use-module (guix inferior)
#:use-module (guix channels) #:use-module (guix channels)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix status)
#:use-module ((guix utils)
#:select (%current-system))
#:use-module ((guix scripts pull) #:use-module ((guix scripts pull)
#:select (with-git-error-handling channel-list)) #:select (with-git-error-handling channel-list))
#:use-module ((guix scripts build)
#:select (%standard-build-options
show-build-options-help
set-build-options-from-command-line))
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
@ -47,6 +55,9 @@ (define (show-help)
--commit=COMMIT use the specified COMMIT")) --commit=COMMIT use the specified COMMIT"))
(display (G_ " (display (G_ "
--branch=BRANCH use the tip of the specified BRANCH")) --branch=BRANCH use the tip of the specified BRANCH"))
(newline)
(show-build-options-help)
(newline)
(display (G_ " (display (G_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
(display (G_ " (display (G_ "
@ -56,9 +67,9 @@ (define (show-help)
(define %options (define %options
;; Specifications of the command-line options. ;; Specifications of the command-line options.
(list (option '(#\C "channels") #t #f (cons* (option '(#\C "channels") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'channel-file arg result))) (alist-cons 'channel-file arg result)))
(option '("url") #t #f (option '("url") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'repository-url arg (alist-cons 'repository-url arg
@ -69,20 +80,35 @@ (define %options
(option '("branch") #t #f (option '("branch") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'ref `(branch . ,arg) result))) (alist-cons 'ref `(branch . ,arg) result)))
(option '(#\h "help") #f #f (option '(#\h "help") #f #f
(lambda args (lambda args
(show-help) (show-help)
(exit 0))) (exit 0)))
(option '(#\V "version") #f #f (option '(#\V "version") #f #f
(lambda args (lambda args
(show-version-and-exit "guix time-machine"))))) (show-version-and-exit "guix time-machine")))
%standard-build-options))
(define %default-options
;; Alist of default option values.
`((system . ,(%current-system))
(substitutes? . #t)
(build-hook? . #t)
(print-build-trace? . #t)
(print-extended-build-trace? . #t)
(multiplexed-build-output? . #t)
(graft? . #t)
(debug . 0)
(verbosity . 1)))
(define (parse-args args) (define (parse-args args)
"Parse the list of command line arguments ARGS." "Parse the list of command line arguments ARGS."
;; The '--' token is used to separate the command to run from the rest of ;; The '--' token is used to separate the command to run from the rest of
;; the operands. ;; the operands.
(let-values (((args command) (break (cut string=? "--" <>) args))) (let-values (((args command) (break (cut string=? "--" <>) args)))
(let ((opts (parse-command-line args %options '(()) #:build-options? #f))) (let ((opts (parse-command-line args %options
(list %default-options))))
(match command (match command
(() opts) (() opts)
(("--") opts) (("--") opts)
@ -100,7 +126,10 @@ (define (guix-time-machine . args)
(channels (channel-list opts)) (channels (channel-list opts))
(command-line (assoc-ref opts 'exec))) (command-line (assoc-ref opts 'exec)))
(when command-line (when command-line
(let* ((directory (with-store store (let* ((directory
(cached-channel-instance store channels))) (with-store store
(with-status-verbosity (assoc-ref opts 'verbosity)
(set-build-options-from-command-line store opts)
(cached-channel-instance store channels))))
(executable (string-append directory "/bin/guix"))) (executable (string-append directory "/bin/guix")))
(apply execl (cons* executable executable command-line)))))))) (apply execl (cons* executable executable command-line))))))))