diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-11-07 18:15:55 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-11-07 18:39:55 +0100 |
commit | 3e962e59d849e4300e447d94487684102d9d412e (patch) | |
tree | 3d69d4365af0c02f5afa121355872da2d97d9295 /guix/scripts | |
parent | 7de9471707116b51ef88d042887dd93e8260513d (diff) |
graph: Support package transformation options.
* guix/scripts/graph.scm (%options): Append %TRANSFORMATION-OPTIONS.
(show-help): Call 'show-transformation-options-help'.
(guix-graph): Call 'options->transformation' and use it.
* tests/guix-graph.sh: Add test.
* doc/guix.texi (Invoking guix graph): Document it.
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/graph.scm | 105 |
1 files changed, 60 insertions, 45 deletions
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 2e14857f1e..7558cb1e85 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -32,6 +32,10 @@ #:use-module (gnu packages) #:use-module (guix sets) #:use-module ((guix utils) #:select (location-file)) + #:use-module ((guix scripts build) + #:select (show-transformation-options-help + options->transformation + %transformation-options)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) @@ -446,36 +450,38 @@ package modules, while attempting to retain user package modules." ;;; (define %options - (list (option '(#\t "type") #t #f - (lambda (opt name arg result) - (alist-cons 'node-type (lookup-node-type arg) - result))) - (option '("list-types") #f #f - (lambda (opt name arg result) - (list-node-types) - (exit 0))) - (option '(#\b "backend") #t #f - (lambda (opt name arg result) - (alist-cons 'backend (lookup-backend arg) - result))) - (option '("list-backends") #f #f - (lambda (opt name arg result) - (list-backends) - (exit 0))) - (option '(#\e "expression") #t #f - (lambda (opt name arg result) - (alist-cons 'expression arg result))) - (option '(#\s "system") #t #f - (lambda (opt name arg result) - (alist-cons 'system arg - (alist-delete 'system result eq?)))) - (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix edit"))))) + (cons* (option '(#\t "type") #t #f + (lambda (opt name arg result) + (alist-cons 'node-type (lookup-node-type arg) + result))) + (option '("list-types") #f #f + (lambda (opt name arg result) + (list-node-types) + (exit 0))) + (option '(#\b "backend") #t #f + (lambda (opt name arg result) + (alist-cons 'backend (lookup-backend arg) + result))) + (option '("list-backends") #f #f + (lambda (opt name arg result) + (list-backends) + (exit 0))) + (option '(#\e "expression") #t #f + (lambda (opt name arg result) + (alist-cons 'expression arg result))) + (option '(#\s "system") #t #f + (lambda (opt name arg result) + (alist-cons 'system arg + (alist-delete 'system result eq?)))) + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix graph"))) + + %transformation-options)) (define (show-help) ;; TRANSLATORS: Here 'dot' is the name of a program; it must not be @@ -495,6 +501,8 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (display (G_ " -s, --system=SYSTEM consider the graph for SYSTEM--e.g., \"i686-linux\"")) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " @@ -514,21 +522,28 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (define (guix-graph . args) (with-error-handling - (let* ((opts (parse-command-line args %options - (list %default-options) - #:build-options? #f)) - (backend (assoc-ref opts 'backend)) - (type (assoc-ref opts 'node-type)) - (items (filter-map (match-lambda - (('argument . (? store-path? item)) - item) - (('argument . spec) - (specification->package spec)) - (('expression . exp) - (read/eval-package-expression exp)) - (_ #f)) - opts))) - (with-store store + (define opts + (parse-command-line args %options + (list %default-options) + #:build-options? #f)) + (define backend + (assoc-ref opts 'backend)) + (define type + (assoc-ref opts 'node-type)) + + (with-store store + (let* ((transform (options->transformation opts)) + (items (filter-map (match-lambda + (('argument . (? store-path? item)) + item) + (('argument . spec) + (transform store + (specification->package spec))) + (('expression . exp) + (transform store + (read/eval-package-expression exp))) + (_ #f)) + opts))) ;; Ask for absolute file names so that .drv file names passed from the ;; user to 'read-derivation' are absolute when it returns. (with-fluids ((%file-port-name-canonicalization 'absolute)) |