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

@ -5546,6 +5546,20 @@ example, the command below produces the reference graph of your profile
@example
guix graph -t references `readlink -f ~/.guix-profile`
@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
The available options are the following:

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."

View File

@ -232,6 +232,28 @@ edges."
(list 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"
(run-with-store %store
(let ((packages (fold-packages cons '())))