summaryrefslogtreecommitdiff
path: root/guix/scripts/graph.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-23 23:31:53 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-23 23:34:15 +0100
commit38b92daa81d6c5eca77ae0cc3d454da46a64b48a (patch)
treefd0fff0db6096636bd5556b7c481c46ca1e8a5c5 /guix/scripts/graph.scm
parent961d0d2d2237baca7bd2099aebee279765bbd257 (diff)
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.
Diffstat (limited to 'guix/scripts/graph.scm')
-rw-r--r--guix/scripts/graph.scm48
1 files changed, 36 insertions, 12 deletions
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))