From b06a70e05dc6252a3ecb28db5898de7ebc110973 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 27 Mar 2018 14:00:48 +0200
Subject: 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.
---
 guix/modules.scm       |  3 ++-
 guix/scripts/graph.scm | 38 ++++++++++++++++++++++++++++++++++++--
 2 files changed, 38 insertions(+), 3 deletions(-)

(limited to 'guix')

diff --git a/guix/modules.scm b/guix/modules.scm
index 6c602eda48..bf656bb241 100644
--- a/guix/modules.scm
+++ b/guix/modules.scm
@@ -1,5 +1,5 @@
 ;;; 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.
 ;;;
@@ -29,6 +29,7 @@
             file-name->module-name
             module-name->file-name
 
+            source-module-dependencies
             source-module-closure
             live-module-closure
             guix-module-name?))
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 78f09f181b..346ca4ea88 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -1,5 +1,5 @@
 ;;; 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.
 ;;;
@@ -27,9 +27,11 @@
   #:use-module (guix gexp)
   #:use-module (guix derivations)
   #:use-module (guix memoization)
+  #:use-module (guix modules)
   #:use-module ((guix build-system gnu) #:select (standard-packages))
   #:use-module (gnu packages)
   #:use-module (guix sets)
+  #:use-module ((guix utils) #:select (location-file))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -44,6 +46,7 @@
             %derivation-node-type
             %reference-node-type
             %referrer-node-type
+            %module-node-type
             %node-types
 
             guix-graph))
@@ -330,6 +333,36 @@ substitutes."
    (label store-path-package-name)
    (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.
@@ -344,7 +377,8 @@ substitutes."
         %bag-emerged-node-type
         %derivation-node-type
         %reference-node-type
-        %referrer-node-type))
+        %referrer-node-type
+        %module-node-type))
 
 (define (lookup-node-type name)
   "Return the node type called NAME.  Raise an error if it is not found."
-- 
cgit v1.2.3