graph: Add "module" node type.

* guix/scripts/graph.scm (module-from-package)
(source-module-dependencies*): New procedures.
(%module-node-type): New variable.
(%node-types): Add it.
* guix/modules.scm (source-module-dependencies): Export.
* tests/graph.scm ("module graph"): New test.
* doc/guix.texi (Invoking guix graph): Document it.
This commit is contained in:
Ludovic Courtès 2018-03-27 14:00:48 +02:00
parent de0021322d
commit b06a70e05d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 66 additions and 4 deletions

View File

@ -6997,6 +6997,15 @@ name instead of a package name, as in:
@example @example
guix graph -t derivation `guix system build -d my-config.scm` guix graph -t derivation `guix system build -d my-config.scm`
@end example @end example
@item module
This is the graph of @dfn{package modules} (@pxref{Package Modules}).
For example, the following command shows the graph for the package
module that defines the @code{guile} package:
@example
guix graph -t module guile | dot -Tpdf > module-graph.pdf
@end example
@end table @end table
All the types above correspond to @emph{build-time dependencies}. The All the types above correspond to @emph{build-time dependencies}. The

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -29,6 +29,7 @@
file-name->module-name file-name->module-name
module-name->file-name module-name->file-name
source-module-dependencies
source-module-closure source-module-closure
live-module-closure live-module-closure
guix-module-name?)) guix-module-name?))

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -27,9 +27,11 @@
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix modules)
#:use-module ((guix build-system gnu) #:select (standard-packages)) #:use-module ((guix build-system gnu) #:select (standard-packages))
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (guix sets) #:use-module (guix sets)
#:use-module ((guix utils) #:select (location-file))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
@ -44,6 +46,7 @@
%derivation-node-type %derivation-node-type
%reference-node-type %reference-node-type
%referrer-node-type %referrer-node-type
%module-node-type
%node-types %node-types
guix-graph)) guix-graph))
@ -330,6 +333,36 @@ substitutes."
(label store-path-package-name) (label store-path-package-name)
(edges non-derivation-referrers))) (edges non-derivation-referrers)))
;;;
;;; Scheme modules.
;;;
(define (module-from-package package)
(file-name->module-name (location-file (package-location package))))
(define (source-module-dependencies* module)
"Like 'source-module-dependencies' but filter out modules that are not
package modules, while attempting to retain user package modules."
(remove (match-lambda
(('guix _ ...) #t)
(('system _ ...) #t)
(('language _ ...) #t)
(('ice-9 _ ...) #t)
(('srfi _ ...) #t)
(_ #f))
(source-module-dependencies module)))
(define %module-node-type
;; Show the graph of package modules.
(node-type
(name "module")
(description "the graph of package modules")
(convert (lift1 (compose list module-from-package) %store-monad))
(identifier (lift1 identity %store-monad))
(label object->string)
(edges (lift1 source-module-dependencies* %store-monad))))
;;; ;;;
;;; List of node types. ;;; List of node types.
@ -344,7 +377,8 @@ substitutes."
%bag-emerged-node-type %bag-emerged-node-type
%derivation-node-type %derivation-node-type
%reference-node-type %reference-node-type
%referrer-node-type)) %referrer-node-type
%module-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."

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -271,6 +271,24 @@ edges."
(list txt out)) (list txt out))
(equal? edges `((,txt ,out))))))))))) (equal? edges `((,txt ,out)))))))))))
(test-assert "module graph"
(let-values (((backend nodes+edges) (make-recording-backend)))
(run-with-store %store
(export-graph '((gnu packages guile)) 'port
#:node-type %module-node-type
#:backend backend))
(let-values (((nodes edges) (nodes+edges)))
(and (member '(gnu packages guile)
(match nodes
(((ids labels) ...) ids)))
(->bool (and (member (list '(gnu packages guile)
'(gnu packages libunistring))
edges)
(member (list '(gnu packages guile)
'(gnu packages bdw-gc))
edges)))))))
(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 '())))