From a773c3142dd168e1c4480614d3f5fd9d003954cd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 20 May 2016 17:07:23 +0200 Subject: graph: Allow store file names for 'derivation' and 'references' graphs. * guix/scripts/graph.scm (%derivation-node-type)[convert]: Add 'derivation-path?' and catch-all clauses. (%reference-node-type)[convert]: Add 'store-path?' and catch-all clauses. (assert-package, nodes-from-package): New procedures. (%package-node-type, %bag-node-type,%bag-with-origins-node-type) (%bag-emerged-node-type): Add 'convert' field (guix-graph): Rename 'packages' to 'items' and allow 'store-path?' arguments. * guix/graph.scm ()[convert]: Adjust comment. * doc/guix.texi (Invoking guix graph): Document it. --- doc/guix.texi | 14 +++++++++++ guix/graph.scm | 2 +- guix/scripts/graph.scm | 63 ++++++++++++++++++++++++++++++++++++++++---------- tests/guix-graph.sh | 18 ++++++++++++++- 4 files changed, 83 insertions(+), 14 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 3f0106be02..d88cc256d7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5161,6 +5161,12 @@ derivations (@pxref{Derivations}) and plain store items. Compared to the above representation, many additional nodes are visible, including build scripts, patches, Guile modules, etc. +For this type of graph, it is also possible to pass a @file{.drv} file +name instead of a package name, as in: + +@example +guix graph -t derivation `guix system build -d my-config.scm` +@end example @end table All the types above correspond to @emph{build-time dependencies}. The @@ -5173,6 +5179,14 @@ by @command{guix gc --references} (@pxref{Invoking guix gc}). If the given package output is not available in the store, @command{guix graph} attempts to obtain dependency information from substitutes. + +Here you can also pass a store file name instead of a package name. For +example, the command below produces the reference graph of your profile +(which can be big!): + +@example +guix graph -t references `readlink -f ~/.guix-profile` +@end example @end table The available options are the following: diff --git a/guix/graph.scm b/guix/graph.scm index 1a8f2d55b3..ad93403a1e 100644 --- a/guix/graph.scm +++ b/guix/graph.scm @@ -65,7 +65,7 @@ (define-record-type* node-type make-node-type (identifier node-type-identifier) ;node -> M identifier (label node-type-label) ;node -> string (edges node-type-edges) ;node -> M list of nodes - (convert node-type-convert ;package -> M list of nodes + (convert node-type-convert ;any -> M list of nodes (default (lift1 list %store-monad))) (name node-type-name) ;string (description node-type-description)) ;string diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 1623421196..782fca5d63 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -33,6 +33,7 @@ (define-module (guix scripts graph) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:export (%package-node-type @@ -70,11 +71,27 @@ (define (package-node-edges package) ;; Filter out origins and other non-package dependencies. (filter package? packages)))) +(define assert-package + (match-lambda + ((? package? package) + package) + (x + (raise + (condition + (&message + (message (format #f (_ "~a: invalid argument (package name expected)") + x)))))))) + +(define nodes-from-package + ;; The default conversion method. + (lift1 (compose list assert-package) %store-monad)) + (define %package-node-type ;; Type for the traversal of package nodes. (node-type (name "package") (description "the DAG of packages, excluding implicit inputs") + (convert nodes-from-package) ;; We use package addresses as unique identifiers. This generally works ;; well, but for generated package objects, we could end up with two @@ -131,6 +148,7 @@ (define %bag-node-type (node-type (name "bag") (description "the DAG of packages, including implicit inputs") + (convert nodes-from-package) (identifier bag-node-identifier) (label node-full-name) (edges (lift1 (compose (cut filter package? <>) bag-node-edges) @@ -140,6 +158,7 @@ (define %bag-with-origins-node-type (node-type (name "bag-with-origins") (description "the DAG of packages and origins, including implicit inputs") + (convert nodes-from-package) (identifier bag-node-identifier) (label node-full-name) (edges (lift1 (lambda (thing) @@ -170,6 +189,7 @@ (define %bag-emerged-node-type (node-type (name "bag-emerged") (description "same as 'bag', but without the bootstrap nodes") + (convert nodes-from-package) (identifier bag-node-identifier) (label node-full-name) (edges (lift1 (compose (cut filter package? <>) @@ -215,10 +235,19 @@ (define %derivation-node-type (node-type (name "derivation") (description "the DAG of derivations") - (convert (lambda (package) - (with-monad %store-monad - (>>= (package->derivation package) - (lift1 list %store-monad))))) + (convert (match-lambda + ((? package? package) + (with-monad %store-monad + (>>= (package->derivation package) + (lift1 list %store-monad)))) + ((? derivation-path? item) + (mbegin %store-monad + ((store-lift add-temp-root) item) + (return (list (file->derivation item))))) + (x + (raise + (condition (&message (message "unsupported argument for \ +derivation graph"))))))) (identifier (lift1 derivation-node-identifier %store-monad)) (label derivation-node-label) (edges (lift1 derivation-dependencies %store-monad)))) @@ -246,12 +275,20 @@ (define %reference-node-type (node-type (name "references") (description "the DAG of run-time dependencies (store references)") - (convert (lambda (package) - ;; Return the output file names of PACKAGE. - (mlet %store-monad ((drv (package->derivation package))) - (return (match (derivation->output-paths drv) - (((_ . file-names) ...) - file-names)))))) + (convert (match-lambda + ((? package? package) + ;; Return the output file names of PACKAGE. + (mlet %store-monad ((drv (package->derivation package))) + (return (match (derivation->output-paths drv) + (((_ . file-names) ...) + file-names))))) + ((? store-path? item) + (with-monad %store-monad + (return (list item)))) + (x + (raise + (condition (&message (message "unsupported argument for \ +reference graph"))))))) (identifier (lift1 identity %store-monad)) (label store-path-package-name) (edges references*))) @@ -348,7 +385,9 @@ (define (guix-graph . args) (alist-cons 'argument arg result)) %default-options)) (type (assoc-ref opts 'node-type)) - (packages (filter-map (match-lambda + (items (filter-map (match-lambda + (('argument . (? store-path? item)) + item) (('argument . spec) (specification->package spec)) (('expression . exp) @@ -364,7 +403,7 @@ (define (guix-graph . args) (mlet %store-monad ((_ (set-grafting #f)) (nodes (mapm %store-monad (node-type-convert type) - packages))) + items))) (export-graph (concatenate nodes) (current-output-port) #:node-type type))))))) diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh index 4d5a755bc1..1ec99706fd 100644 --- a/tests/guix-graph.sh +++ b/tests/guix-graph.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2015 Ludovic Courtès +# Copyright © 2015, 2016 Ludovic Courtès # # This file is part of GNU Guix. # @@ -20,6 +20,10 @@ # Test the 'guix graph' command-line utility. # +tmpfile1="t-guix-graph1-$$" +tmpfile2="t-guix-graph2-$$" +trap 'rm -f "$tmpfile1" "$tmpfile2"' EXIT + guix graph --version for package in guile-bootstrap coreutils python @@ -37,3 +41,15 @@ guix graph -e '(@ (gnu packages bootstrap) %bootstrap-guile)' \ | grep guile-bootstrap if guix graph -e +; then false; else true; fi + +# Try passing store file names. + +guix graph -t references guile-bootstrap > "$tmpfile1" +guix graph -t references `guix build guile-bootstrap` > "$tmpfile2" +cmp "$tmpfile1" "$tmpfile2" + +# XXX: Filter the file names in the graph to work around the fact that we get +# a mixture of relative and absolute file names. +guix graph -t derivation coreutils > "$tmpfile1" +guix graph -t derivation `guix build -d coreutils` > "$tmpfile2" +cmp "$tmpfile1" "$tmpfile2" -- cgit v1.2.3