mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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:
parent
97507ebedc
commit
a773c3142d
4 changed files with 83 additions and 14 deletions
|
@ -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:
|
||||||
|
|
|
@ -65,7 +65,7 @@ (define-record-type* <node-type> node-type make-node-type
|
||||||
(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
|
||||||
|
|
|
@ -33,6 +33,7 @@ (define-module (guix scripts graph)
|
||||||
#: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 @@ (define (package-node-edges package)
|
||||||
;; 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 @@ (define %bag-node-type
|
||||||
(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 @@ (define %bag-with-origins-node-type
|
||||||
(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 @@ (define %bag-emerged-node-type
|
||||||
(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 @@ (define %derivation-node-type
|
||||||
(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 @@ (define %reference-node-type
|
||||||
(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 @@ (define (guix-graph . args)
|
||||||
(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 @@ (define (guix-graph . args)
|
||||||
(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)))))))
|
||||||
|
|
|
@ -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"
|
||||||
|
|
Loading…
Reference in a new issue