Document and parameterize use2dot-all.

2 files changed, 96 insertions, 38 deletions

diff --git a/module/scripts/use2dot-all.scm b/module/scripts/use2dot-all.scm
index c970d003..18639619 100755
--- a/module/scripts/use2dot-all.scm
+++ b/module/scripts/use2dot-all.scm
@@ -2,15 +2,89 @@
   :use-module ((scripts frisk) :select (make-frisker edge-type edge-up
                                                      edge-down))
   :use-module (srfi srfi-1)
+  :use-module (srfi srfi-88)
   :use-module ((graphviz) :prefix gv.)
   :use-module (hnh module-introspection all-modules)
+  :use-module (hnh util options)
+  :use-module (ice-9 getopt-long)
   :export (main))
 
+(define default-remove
+ '((srfi srfi-1)
+   (srfi srfi-9)
+   (srfi srfi-26)
+   (srfi srfi-41)
+
+   (ice-9 match)
+   (ice-9 format)))
+
+(define option-spec
+  `((engine (value #t)
+            (description "Graphviz rendering engine to use. Defaults to FDP"))
+    (default-module
+      (single-char #\m)
+      (value #t)
+      (description "Set MOD as the default module, see guild help use2dot for more information. Defaults to (guile-user)"))
+    (output
+     (single-char #\o)
+     (value #t)
+     (description "Name of output PDF"))
+    (remove
+     (value #t)
+     (description "Modules to remove from check, usually since to many other modules depend on them."))
+    (ignore-default-remove
+     (description "Don't ignore the modules which are ignored by default, which are:" (br)
+                  ,@(append-map (lambda (item) (list (with-output-to-string (lambda () (display item))) '(br)))
+                                default-remove)))))
+
+(define %synopsis "use2dot-all [options] <directory>")
+(define %summary "Like use2dot, but for multiple modules")
+(define %help (format-arg-help option-spec))
+
+(define (remove-edges blacklist edges)
+  (remove (lambda (edge)
+            (or (member (edge-up edge) blacklist)
+                (member (edge-down edge) blacklist)))
+          edges))
+
 (define (main . args)
-  (define scan (make-frisker `(default-module . (calp main))))
+  (define options (getopt-long (cons "use2dot-all" args)
+                               (getopt-opt option-spec)
+                               stop-at-first-non-option: #t))
+  (define default-module
+    (cond ((option-ref options 'default-module #f)
+           => (lambda (s) (let ((mod (with-input-from-string s read)))
+                       (unless (list? mod)
+                         (format (current-error-port)
+                                 "Module must be a list: ~s~%" mod)
+                         (exit 1)))))
+          (else '(guile-user))))
+  (define engine (option-ref options 'engine "fdp"))
+  (define output-file (option-ref options 'output "graph.pdf"))
+  (define custom-remove (cond ((option-ref options 'remove #f)
+                               => (lambda (s) (let ((lst (with-input-from-string s read)))
+                                           (unless (and (list? lst) (every list? lst))
+                                             (format (current-error-port)
+                                                     "custom-remove must get a list of lists: ~s~%" lst)
+                                             (exit 1))
+                                           lst)))
+                              (else '())))
+  (define to-remove (if (option-ref options 'default-remove #f)
+                        custom-remove
+                        (append custom-remove default-remove)))
+  (define target-directory
+    (let ((remaining (option-ref options '() '())))
+      (cond ((null? remaining)
+             (format (current-error-port) "Target directory required~%")
+             (exit 1))
+            (else (car remaining)))))
+
+  ;; End of command line parsing
+
+  (define scan (make-frisker `(default-module . ,default-module)))
 
   (define-values (files our-modules)
-    (all-modules-under-directory "module"))
+    (all-modules-under-directory target-directory))
 
   (define graph
     (let ((graph (gv.digraph "G")))
@@ -28,28 +102,28 @@
   (define rem our-modules)
 
   ;; (for-each (lambda (key)
-  ;; 
+  ;;
   ;;             (define subgraph (gv.graph graph (format #f "cluster_~a" count)))
-  ;; 
+  ;;
   ;;             (define-values (use rem*) (partition (lambda (mod) (eq? key (car mod))) rem))
   ;;             (set! rem rem*)
-  ;; 
+  ;;
   ;;             ;; (gv.setv subgraph "rankdir" "TB")
   ;;             (gv.setv subgraph "color" (list-ref colors count))
-  ;; 
+  ;;
   ;;             (for-each (lambda (name)
   ;;                         (gv.node subgraph (format #f "~a" name)))
   ;;                       use)
-  ;; 
+  ;;
   ;;             (set! count (1+ count))
   ;;             )
   ;;           '(calp vcomponent))
 
   ;; (define subgraph (gv.graph graph (format #f "cluster_~a" count)))
-  ;; 
+  ;;
   ;; ;; (gv.setv subgraph "rankdir" "TB")
   ;; (gv.setv subgraph "color" (list-ref colors count))
-  ;; 
+  ;;
   ;; (for-each (lambda (name)
   ;;             (gv.node subgraph (format #f "~a" name)))
   ;;           rem)
@@ -81,8 +155,8 @@
     (let ((calpgraphs (make-hash-table)))
       (for-each (lambda (name)
                   (let ((g (hashq-ref calpgraphs (cadr name)
-                                      (gv.graph 
-                                       ;; calp-base 
+                                      (gv.graph
+                                       ;; calp-base
                                        graph
                                        (format #f "cluster_~a" (cadr name))))))
                     (hashq-set! calpgraphs (car name) g)
@@ -98,16 +172,6 @@
       calpgraphs))
 
 
-  (define (remove-edges blacklist edges)
-    (remove (lambda (edge)
-              (or (member (edge-up edge) blacklist)
-                  (member (edge-down edge) blacklist)))
-            edges))
-
-
-
-
-
   (for-each (lambda (edge)
               (let ((gv-edge (gv.edge graph
                                       (format #f "~a" (edge-down edge))
@@ -120,22 +184,8 @@
                            (not (memv (car (edge-down edge)) '(vcomponent calp ))))
                   (gv.setv gv-edge "color" "blue"))
                 ))
-            (remove-edges '((srfi srfi-1)
-                            (srfi srfi-9)
-                            (srfi srfi-26)
-                            (srfi srfi-41)
-
-                            (ice-9 match)
-                            (ice-9 format)
-
-                            (datetime)
-                            (vcomponent)
-                            (hnh util)
-                            )
+            (remove-edges to-remove
                           ((scan files) 'edges)))
 
-  (gv.layout graph "fdp")
-  (gv.render graph "pdf" "graph.pdf")
-
-
-  (display "done\n"))
+  (gv.layout graph engine)
+  (gv.render graph "pdf" output-file))
diff --git a/scripts/use2dot-all.sh b/scripts/use2dot-all.sh
new file mode 100755
index 00000000..80703d33
--- /dev/null
+++ b/scripts/use2dot-all.sh
@@ -0,0 +1,8 @@
+#!/bin/sh
+
+guild use2dot-all \
+	--engine fdp \
+	--output graph.pdf \
+	--default-module '(calp main)' \
+	--remove '((datetime) (vcomponent) (hnh util))' \
+	module