graph: Add '%referrer-node-type'.

* guix/scripts/graph.scm (ensure-store-items): New procedure.
(%reference-node-type)[convert]: Use it.
(non-derivation-referrers): New procedure.
(%referrer-node-type): New variable.
(%node-types): Add it.
* tests/graph.scm ("referrer DAG"): New test.
* doc/guix.texi (Invoking guix graph): Document it.
This commit is contained in:
Ludovic Courtès 2016-10-15 22:47:42 +02:00
parent 783ae212c2
commit 7f8fec0fa4
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 74 additions and 15 deletions

View file

@ -42,6 +42,7 @@
%bag-emerged-node-type
%derivation-node-type
%reference-node-type
%referrer-node-type
%node-types
guix-graph))
@ -257,6 +258,24 @@ derivation graph")))))))
;;; DAG of residual references (aka. run-time dependencies).
;;;
(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.
(match-lambda
((? package? package)
;; Return the output file names of PACKAGE.
(mlet %store-monad ((drv (package->derivation package)))
(return (match (derivation->output-paths drv)
(((_ . file-names) ...)
file-names)))))
((? store-path? item)
(with-monad %store-monad
(return (list item))))
(x
(raise
(condition (&message (message "unsupported argument for \
this type of graph")))))))
(define (references* item)
"Return as a monadic value the references of ITEM, based either on the
information available in the local store or using information about
@ -275,24 +294,27 @@ substitutes."
(node-type
(name "references")
(description "the DAG of run-time dependencies (store references)")
(convert (match-lambda
((? package? package)
;; Return the output file names of PACKAGE.
(mlet %store-monad ((drv (package->derivation package)))
(return (match (derivation->output-paths drv)
(((_ . file-names) ...)
file-names)))))
((? store-path? item)
(with-monad %store-monad
(return (list item))))
(x
(raise
(condition (&message (message "unsupported argument for \
reference graph")))))))
(convert ensure-store-items)
(identifier (lift1 identity %store-monad))
(label store-path-package-name)
(edges references*)))
(define non-derivation-referrers
(let ((referrers (store-lift referrers)))
(lambda (item)
"Return the referrers of ITEM, except '.drv' files."
(mlet %store-monad ((items (referrers item)))
(return (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))
(label store-path-package-name)
(edges non-derivation-referrers)))
;;;
;;; List of node types.
@ -305,7 +327,8 @@ reference graph")))))))
%bag-with-origins-node-type
%bag-emerged-node-type
%derivation-node-type
%reference-node-type))
%reference-node-type
%referrer-node-type))
(define (lookup-node-type name)
"Return the node type called NAME. Raise an error if it is not found."