diff options
| -rw-r--r-- | doc/guix.texi | 14 | ||||
| -rw-r--r-- | guix/scripts/graph.scm | 53 | ||||
| -rw-r--r-- | tests/graph.scm | 22 |
3 files changed, 74 insertions, 15 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 74733f4fd1..47fc199c6c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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: diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 782fca5d63..2f70d64c90 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -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." diff --git a/tests/graph.scm b/tests/graph.scm index 1ce06cc817..f2e441cee6 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -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 '()))) |