diff options
| -rw-r--r-- | doc/guix.texi | 3 | ||||
| -rw-r--r-- | guix/scripts/graph.scm | 48 | ||||
| -rw-r--r-- | tests/graph.scm | 26 | ||||
| -rw-r--r-- | tests/guix-graph.sh | 2 |
4 files changed, 66 insertions, 13 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index a56bda9c79..5eb6720934 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index f607ebee31..9255f0018a 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -30,11 +30,13 @@ #: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 @@ file name." low)))))) (define (bag-node-edges thing) - "Return the list of dependencies of THING, a package or origin, etc." - (if (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))) - '())) + "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) ...) + 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 @@ file name." (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 @@ substitutes." ;; 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)) diff --git a/tests/graph.scm b/tests/graph.scm index 9c9e3666b7..ad8aea0ada 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -134,6 +134,32 @@ edges." (((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 diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh index e0cbebb753..4d5a755bc1 100644 --- a/tests/guix-graph.sh +++ b/tests/guix-graph.sh @@ -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 |