From 825cd8bea8fd92b57b40aa027535918b5eb82065 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 23 Sep 2022 21:35:13 +0200 Subject: Document and parameterize use2dot-all. --- module/scripts/use2dot-all.scm | 126 ++++++++++++++++++++++++++++------------- scripts/use2dot-all.sh | 8 +++ 2 files changed, 96 insertions(+), 38 deletions(-) create mode 100755 scripts/use2dot-all.sh 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] ") +(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 -- cgit v1.2.3