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 (<node-type>)[convert]: Adjust comment.
* doc/guix.texi (Invoking guix graph): Document it.
This commit is contained in:
Ludovic Courtès 2016-05-20 17:07:23 +02:00
parent 97507ebedc
commit a773c3142d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 83 additions and 14 deletions

View File

@ -5161,6 +5161,12 @@ derivations (@pxref{Derivations}) and plain store items. Compared to
the above representation, many additional nodes are visible, including the above representation, many additional nodes are visible, including
build scripts, patches, Guile modules, etc. 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 @end table
All the types above correspond to @emph{build-time dependencies}. The 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 If the given package output is not available in the store, @command{guix
graph} attempts to obtain dependency information from substitutes. 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 @end table
The available options are the following: The available options are the following:

View File

@ -65,7 +65,7 @@
(identifier node-type-identifier) ;node -> M identifier (identifier node-type-identifier) ;node -> M identifier
(label node-type-label) ;node -> string (label node-type-label) ;node -> string
(edges node-type-edges) ;node -> M list of nodes (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))) (default (lift1 list %store-monad)))
(name node-type-name) ;string (name node-type-name) ;string
(description node-type-description)) ;string (description node-type-description)) ;string

View File

@ -33,6 +33,7 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37) #:use-module (srfi srfi-37)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (%package-node-type #:export (%package-node-type
@ -70,11 +71,27 @@ name."
;; Filter out origins and other non-package dependencies. ;; Filter out origins and other non-package dependencies.
(filter package? packages)))) (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 (define %package-node-type
;; Type for the traversal of package nodes. ;; Type for the traversal of package nodes.
(node-type (node-type
(name "package") (name "package")
(description "the DAG of packages, excluding implicit inputs") (description "the DAG of packages, excluding implicit inputs")
(convert nodes-from-package)
;; We use package addresses as unique identifiers. This generally works ;; We use package addresses as unique identifiers. This generally works
;; well, but for generated package objects, we could end up with two ;; well, but for generated package objects, we could end up with two
@ -131,6 +148,7 @@ Dependencies may include packages, origin, and file names."
(node-type (node-type
(name "bag") (name "bag")
(description "the DAG of packages, including implicit inputs") (description "the DAG of packages, including implicit inputs")
(convert nodes-from-package)
(identifier bag-node-identifier) (identifier bag-node-identifier)
(label node-full-name) (label node-full-name)
(edges (lift1 (compose (cut filter package? <>) bag-node-edges) (edges (lift1 (compose (cut filter package? <>) bag-node-edges)
@ -140,6 +158,7 @@ Dependencies may include packages, origin, and file names."
(node-type (node-type
(name "bag-with-origins") (name "bag-with-origins")
(description "the DAG of packages and origins, including implicit inputs") (description "the DAG of packages and origins, including implicit inputs")
(convert nodes-from-package)
(identifier bag-node-identifier) (identifier bag-node-identifier)
(label node-full-name) (label node-full-name)
(edges (lift1 (lambda (thing) (edges (lift1 (lambda (thing)
@ -170,6 +189,7 @@ GNU-BUILD-SYSTEM have zero dependencies."
(node-type (node-type
(name "bag-emerged") (name "bag-emerged")
(description "same as 'bag', but without the bootstrap nodes") (description "same as 'bag', but without the bootstrap nodes")
(convert nodes-from-package)
(identifier bag-node-identifier) (identifier bag-node-identifier)
(label node-full-name) (label node-full-name)
(edges (lift1 (compose (cut filter package? <>) (edges (lift1 (compose (cut filter package? <>)
@ -215,10 +235,19 @@ a plain store file."
(node-type (node-type
(name "derivation") (name "derivation")
(description "the DAG of derivations") (description "the DAG of derivations")
(convert (lambda (package) (convert (match-lambda
(with-monad %store-monad ((? package? package)
(>>= (package->derivation package) (with-monad %store-monad
(lift1 list %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)) (identifier (lift1 derivation-node-identifier %store-monad))
(label derivation-node-label) (label derivation-node-label)
(edges (lift1 derivation-dependencies %store-monad)))) (edges (lift1 derivation-dependencies %store-monad))))
@ -246,12 +275,20 @@ substitutes."
(node-type (node-type
(name "references") (name "references")
(description "the DAG of run-time dependencies (store references)") (description "the DAG of run-time dependencies (store references)")
(convert (lambda (package) (convert (match-lambda
;; Return the output file names of PACKAGE. ((? package? package)
(mlet %store-monad ((drv (package->derivation package))) ;; Return the output file names of PACKAGE.
(return (match (derivation->output-paths drv) (mlet %store-monad ((drv (package->derivation package)))
(((_ . file-names) ...) (return (match (derivation->output-paths drv)
file-names)))))) (((_ . 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)) (identifier (lift1 identity %store-monad))
(label store-path-package-name) (label store-path-package-name)
(edges references*))) (edges references*)))
@ -348,7 +385,9 @@ Emit a Graphviz (dot) representation of the dependencies of PACKAGE...\n"))
(alist-cons 'argument arg result)) (alist-cons 'argument arg result))
%default-options)) %default-options))
(type (assoc-ref opts 'node-type)) (type (assoc-ref opts 'node-type))
(packages (filter-map (match-lambda (items (filter-map (match-lambda
(('argument . (? store-path? item))
item)
(('argument . spec) (('argument . spec)
(specification->package spec)) (specification->package spec))
(('expression . exp) (('expression . exp)
@ -364,7 +403,7 @@ Emit a Graphviz (dot) representation of the dependencies of PACKAGE...\n"))
(mlet %store-monad ((_ (set-grafting #f)) (mlet %store-monad ((_ (set-grafting #f))
(nodes (mapm %store-monad (nodes (mapm %store-monad
(node-type-convert type) (node-type-convert type)
packages))) items)))
(export-graph (concatenate nodes) (export-graph (concatenate nodes)
(current-output-port) (current-output-port)
#:node-type type))))))) #:node-type type)))))))

View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU # GNU Guix --- Functional package management for GNU
# Copyright © 2015 Ludovic Courtès <ludo@gnu.org> # Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
# #
# This file is part of GNU Guix. # This file is part of GNU Guix.
# #
@ -20,6 +20,10 @@
# Test the 'guix graph' command-line utility. # Test the 'guix graph' command-line utility.
# #
tmpfile1="t-guix-graph1-$$"
tmpfile2="t-guix-graph2-$$"
trap 'rm -f "$tmpfile1" "$tmpfile2"' EXIT
guix graph --version guix graph --version
for package in guile-bootstrap coreutils python for package in guile-bootstrap coreutils python
@ -37,3 +41,15 @@ guix graph -e '(@ (gnu packages bootstrap) %bootstrap-guile)' \
| grep guile-bootstrap | grep guile-bootstrap
if guix graph -e +; then false; else true; fi 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"