mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
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:
parent
783ae212c2
commit
7f8fec0fa4
3 changed files with 74 additions and 15 deletions
|
@ -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."
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue