summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-05-10 00:04:59 +0200
committerLudovic Courtès <ludo@gnu.org>2020-05-11 23:30:55 +0200
commit724020213664239ec5c92d04f5fee44c25408a7f (patch)
treef1c6d4c48b8be527b5900ab15a3e60bca2833980 /guix
parentc2b2c19a7b8b75ef6dd153ca121dd8765cdcd746 (diff)
downloadpatches-724020213664239ec5c92d04f5fee44c25408a7f.tar
patches-724020213664239ec5c92d04f5fee44c25408a7f.tar.gz
graph: reference/referrer node types work with graph traversal.
The graph traversal procedures in (guix graph) assume that nodes can be compared with 'eq?', which was not the case for nodes of %REFERENCE-NODE-TYPE and %REFERRER-NODE-TYPE (strings). * guix/scripts/graph.scm (intern): New procedure. (ensure-store-items, references*) (%reference-node-type, non-derivation-referrers) (%referrer-node-type): Use it on all store items. * tests/graph.scm ("node-transitive-edges, references"): New test.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/graph.scm23
1 files changed, 16 insertions, 7 deletions
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index fca1e3777c..d69dace14f 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -307,6 +307,14 @@ derivation graph")))))))
;;; DAG of residual references (aka. run-time dependencies).
;;;
+(define intern
+ (mlambda (str)
+ "Intern STR, a string denoting a store item."
+ ;; This is necessary for %REFERENCE-NODE-TYPE and %REFERRER-NODE-TYPE
+ ;; because their nodes are strings but the (guix graph) traversal
+ ;; procedures expect to be able to compare nodes with 'eq?'.
+ str))
+
(define ensure-store-items
;; Return a list of store items as a monadic value based on the given
;; argument, which may be a store item or a package.
@@ -316,10 +324,10 @@ derivation graph")))))))
(mlet %store-monad ((drv (package->derivation package)))
(return (match (derivation->output-paths drv)
(((_ . file-names) ...)
- file-names)))))
+ (map intern file-names))))))
((? store-path? item)
(with-monad %store-monad
- (return (list item))))
+ (return (list (intern item)))))
(x
(raise
(condition (&message (message "unsupported argument for \
@@ -333,18 +341,19 @@ substitutes."
(guard (c ((store-protocol-error? c)
(match (substitutable-path-info store (list item))
((info)
- (values (substitutable-references info) store))
+ (values (map intern (substitutable-references info))
+ store))
(()
(leave (G_ "references for '~a' are not known~%")
item)))))
- (values (references store item) store))))
+ (values (map intern (references store item)) store))))
(define %reference-node-type
(node-type
(name "references")
(description "the DAG of run-time dependencies (store references)")
(convert ensure-store-items)
- (identifier (lift1 identity %store-monad))
+ (identifier (lift1 intern %store-monad))
(label store-path-package-name)
(edges references*)))
@@ -353,14 +362,14 @@ substitutes."
(lambda (item)
"Return the referrers of ITEM, except '.drv' files."
(mlet %store-monad ((items (referrers item)))
- (return (remove derivation-path? items))))))
+ (return (map intern (remove derivation-path? items)))))))
(define %referrer-node-type
(node-type
(name "referrers")
(description "the DAG of referrers in the store")
(convert ensure-store-items)
- (identifier (lift1 identity %store-monad))
+ (identifier (lift1 intern %store-monad))
(label store-path-package-name)
(edges non-derivation-referrers)))