graph: Add '%bag-with-origins-node-type'.

* guix/scripts/graph.scm (bag-node-edges): Remove 'filter' call.  Add
case for 'origin'.
(%bag-node-type)[edges]: Add filtering here.
(%bag-with-origins-node-type): New variable.
(%node-types): Add it.
* tests/graph.scm ("bag DAG, including origins"): New test.
* tests/guix-graph.sh: Add 'bag-with-origins'.
* doc/guix.texi (Invoking guix graph): Document it.
This commit is contained in:
Ludovic Courtès 2015-11-23 23:31:53 +01:00
parent 961d0d2d22
commit 38b92daa81
4 changed files with 66 additions and 13 deletions

View file

@ -4631,6 +4631,9 @@ here, for conciseness.
Similar to @code{bag-emerged}, but this time including all the bootstrap
dependencies.
@item bag-with-origins
Similar to @code{bag}, but also showing origins and their dependencies.
@item derivations
This is the most detailed representation: It shows the DAG of
derivations (@pxref{Derivations}) and plain store items. Compared to

View file

@ -30,11 +30,13 @@ (define-module (guix scripts graph)
#:use-module (gnu packages)
#:use-module (guix sets)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (%package-node-type
%bag-node-type
%bag-with-origins-node-type
%bag-emerged-node-type
%derivation-node-type
%reference-node-type
@ -104,17 +106,23 @@ (define (bag-node-identifier thing)
low))))))
(define (bag-node-edges thing)
"Return the list of dependencies of THING, a package or origin, etc."
(if (package? thing)
"Return the list of dependencies of THING, a package or origin.
Dependencies may include packages, origin, and file names."
(cond ((package? thing)
(match (bag-direct-inputs (package->bag thing))
(((labels things . outputs) ...)
(filter-map (match-lambda
((? package? p) p)
;; XXX: Here we choose to filter out origins, files,
;; etc. Replace "#f" with "x" to reinstate them.
(x #f))
things)))
'()))
((origin? thing)
(cons (origin-patch-guile thing)
(if (or (pair? (origin-patches thing))
(origin-snippet thing))
(match (origin-patch-inputs thing)
(#f '())
(((labels dependencies _ ...) ...)
(delete-duplicates dependencies eq?)))
'())))
(else
'())))
(define %bag-node-type
;; Type for the traversal of package nodes via the "bag" representation,
@ -124,7 +132,22 @@ (define %bag-node-type
(description "the DAG of packages, including implicit inputs")
(identifier bag-node-identifier)
(label node-full-name)
(edges (lift1 bag-node-edges %store-monad))))
(edges (lift1 (compose (cut filter package? <>) bag-node-edges)
%store-monad))))
(define %bag-with-origins-node-type
(node-type
(name "bag-with-origins")
(description "the DAG of packages and origins, including implicit inputs")
(identifier bag-node-identifier)
(label node-full-name)
(edges (lift1 (lambda (thing)
(filter (match-lambda
((? package?) #t)
((? origin?) #t)
(_ #f))
(bag-node-edges thing)))
%store-monad))))
(define standard-package-set
(memoize
@ -239,6 +262,7 @@ (define %node-types
;; List of all the node types.
(list %package-node-type
%bag-node-type
%bag-with-origins-node-type
%bag-emerged-node-type
%derivation-node-type
%reference-node-type))

View file

@ -134,6 +134,32 @@ (define (edge->tuple source target)
(((labels packages) ...)
(map package-full-name packages))))))))
(test-assert "bag DAG, including origins"
(let-values (((backend nodes+edges) (make-recording-backend)))
(let* ((m (lambda* (uri hash-type hash name #:key system)
(text-file "foo-1.2.3.tar.gz" "This is a fake!")))
(o (origin (method m) (uri "the-uri") (sha256 #vu8(0 1 2))))
(p (dummy-package "p" (source o))))
(run-with-store %store
(export-graph (list p) 'port
#:node-type %bag-with-origins-node-type
#:backend backend))
;; We should see O among the nodes, with an edge coming from P.
(let-values (((nodes edges) (nodes+edges)))
(run-with-store %store
(mlet %store-monad ((o* (lower-object o))
(p* (lower-object p)))
(return
(and (find (match-lambda
((file "the-uri") #t)
(_ #f))
nodes)
(find (match-lambda
((source target)
(and (string=? source (derivation-file-name p*))
(string=? target o*))))
edges)))))))))
(test-assert "derivation DAG"
(let-values (((backend nodes+edges) (make-recording-backend)))
(run-with-store %store

View file

@ -24,7 +24,7 @@ guix graph --version
for package in guile-bootstrap coreutils python
do
for graph in package bag-emerged bag
for graph in package bag-emerged bag bag-with-origins
do
guix graph -t "$graph" "$package" | grep "$package"
done