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
|
@ -5546,6 +5546,20 @@ example, the command below produces the reference graph of your profile
|
||||||
@example
|
@example
|
||||||
guix graph -t references `readlink -f ~/.guix-profile`
|
guix graph -t references `readlink -f ~/.guix-profile`
|
||||||
@end example
|
@end example
|
||||||
|
|
||||||
|
@item referrers
|
||||||
|
This is the graph of the @dfn{referrers} of a store item, as returned by
|
||||||
|
@command{guix gc --referrers} (@pxref{Invoking guix gc}).
|
||||||
|
|
||||||
|
This relies exclusively on local information from your store. For
|
||||||
|
instance, let us suppose that the current Inkscape is available in 10
|
||||||
|
profiles on your machine; @command{guix graph -t referrers inkscape}
|
||||||
|
will show a graph rooted at Inkscape and with those 10 profiles linked
|
||||||
|
to it.
|
||||||
|
|
||||||
|
It can help determine what is preventing a store item from being garbage
|
||||||
|
collected.
|
||||||
|
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
The available options are the following:
|
The available options are the following:
|
||||||
|
|
|
@ -42,6 +42,7 @@
|
||||||
%bag-emerged-node-type
|
%bag-emerged-node-type
|
||||||
%derivation-node-type
|
%derivation-node-type
|
||||||
%reference-node-type
|
%reference-node-type
|
||||||
|
%referrer-node-type
|
||||||
%node-types
|
%node-types
|
||||||
|
|
||||||
guix-graph))
|
guix-graph))
|
||||||
|
@ -257,6 +258,24 @@ derivation graph")))))))
|
||||||
;;; DAG of residual references (aka. run-time dependencies).
|
;;; 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)
|
(define (references* item)
|
||||||
"Return as a monadic value the references of ITEM, based either on the
|
"Return as a monadic value the references of ITEM, based either on the
|
||||||
information available in the local store or using information about
|
information available in the local store or using information about
|
||||||
|
@ -275,24 +294,27 @@ substitutes."
|
||||||
(node-type
|
(node-type
|
||||||
(name "references")
|
(name "references")
|
||||||
(description "the DAG of run-time dependencies (store references)")
|
(description "the DAG of run-time dependencies (store references)")
|
||||||
(convert (match-lambda
|
(convert ensure-store-items)
|
||||||
((? 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")))))))
|
|
||||||
(identifier (lift1 identity %store-monad))
|
(identifier (lift1 identity %store-monad))
|
||||||
(label store-path-package-name)
|
(label store-path-package-name)
|
||||||
(edges references*)))
|
(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.
|
;;; List of node types.
|
||||||
|
@ -305,7 +327,8 @@ reference graph")))))))
|
||||||
%bag-with-origins-node-type
|
%bag-with-origins-node-type
|
||||||
%bag-emerged-node-type
|
%bag-emerged-node-type
|
||||||
%derivation-node-type
|
%derivation-node-type
|
||||||
%reference-node-type))
|
%reference-node-type
|
||||||
|
%referrer-node-type))
|
||||||
|
|
||||||
(define (lookup-node-type name)
|
(define (lookup-node-type name)
|
||||||
"Return the node type called NAME. Raise an error if it is not found."
|
"Return the node type called NAME. Raise an error if it is not found."
|
||||||
|
|
|
@ -232,6 +232,28 @@ edges."
|
||||||
(list out txt))
|
(list out txt))
|
||||||
(equal? edges `((,out ,txt)))))))))))
|
(equal? edges `((,out ,txt)))))))))))
|
||||||
|
|
||||||
|
(test-assert "referrer DAG"
|
||||||
|
(let-values (((backend nodes+edges) (make-recording-backend)))
|
||||||
|
(run-with-store %store
|
||||||
|
(mlet* %store-monad ((txt (text-file "referrer-node" (random-text)))
|
||||||
|
(drv (gexp->derivation "referrer"
|
||||||
|
#~(symlink #$txt #$output)))
|
||||||
|
(out -> (derivation->output-path drv)))
|
||||||
|
;; We should see only TXT and OUT, with an edge from the former to the
|
||||||
|
;; latter.
|
||||||
|
(mbegin %store-monad
|
||||||
|
(built-derivations (list drv))
|
||||||
|
(export-graph (list txt) 'port
|
||||||
|
#:node-type %referrer-node-type
|
||||||
|
#:backend backend)
|
||||||
|
(let-values (((nodes edges) (nodes+edges)))
|
||||||
|
(return
|
||||||
|
(and (equal? (match nodes
|
||||||
|
(((ids labels) ...)
|
||||||
|
ids))
|
||||||
|
(list txt out))
|
||||||
|
(equal? edges `((,txt ,out)))))))))))
|
||||||
|
|
||||||
(test-assert "node-edges"
|
(test-assert "node-edges"
|
||||||
(run-with-store %store
|
(run-with-store %store
|
||||||
(let ((packages (fold-packages cons '())))
|
(let ((packages (fold-packages cons '())))
|
||||||
|
|
Loading…
Reference in New Issue