Changeset 5797 in project

Timestamp:

08/29/07 00:01:13 (13 years ago)

Author:

Mario Domenech Goulart

Message:

Experimental dependencies graph generation.

Location:

nest-tool/trunk

Files:

• chicken-nest-tool.scm (modified) (2 diffs)
• nest-tool.scm (modified) (1 diff)

nest-tool/trunk/chicken-nest-tool.scm

@@ -1 +1 @@
 (use tool nest-tool (srfi 13))
 
-(define-flag '(#\d "omit-date") "omit release date" omit-date)
-(define-flag '(#\D "omit-deps") "omit dependencies" omit-dependencies)
-(define-flag '(#\f "omit-file") "omit egg filename" omit-file)
+(define-flag '(#\d "omit-date") "omit release date when showing search results" omit-date)
+(define-flag '(#\D "omit-deps") "omit dependencies when showing search results" omit-dependencies)
+(define-flag '(#\f "omit-file") "omit egg filename when showing search results" omit-file)
+
+(define dep-graph-dir ".")
+(define dep-graph-format 'png)
 
 (define (show egg date file deps)
@@ -24 +27 @@
     (exit 0)))
   
-(define-option '(#\s "search") "search eggs names"
+(define-option '(#\s "search")
+  "search eggs names"
   (search nest-tool:search-names))
 
-(define-option '(#\S "search-deps") "search eggs dependencies"
+(define-option '(#\S "search-deps")
+  "search eggs dependencies"
   (search nest-tool:search-dependencies))
 
-(define-option '(#\R "repository") "specify a repository file (HTTP URLs are also accepted)"
+(define-option '(#\R "repository")
+  "specify a repository file (HTTP URLs are also accepted)"
   (lambda (opt name arg seeds)
     (nest-tool:repository arg)))
-  
+
+(define-option '(#\G "dep-graph-dir")
+  "directory where to save dependencies graphs files (default = .)"
+  (lambda (opt name arg seeds)
+    (set! dep-graph-dir arg)))
+
+(define-option '(#\F "dep-graph-format")
+  "format of output graphs graphic files (default = png)"
+  (lambda (opt name arg seeds)
+    (set! dep-graph-format arg)))
+
+(define-option '(#\g "generate-dep-graph")
+  "generate dependencies graphs. Its argument is a comma-separated list of eggs or nothing, which indicates that all the dependencies graphs should be generated"
+  (lambda (opt name arg seeds)
+    (let ((eggs (if (string? arg) (string-split arg ",") #f)))
+      (nest-tool:all-dep-graphs->graphic eggnames: eggs
+                                         output-dir: dep-graph-dir
+                                         format: dep-graph-format))
+    (exit 0)))
+
 (tool-name "chicken-nest-tool")
 (tool-help "Provides operations on CHICKEN extensions repository listings")

nest-tool/trunk/nest-tool.scm

@@ -50 +50 @@
             (not (null? (grep pattern (map symbol->string (nest-tool:egg-dependencies egg))))))
           (nest-tool:raw)))
+
+(define (nest-tool:dep-graph->dot eggname #!key (raw #f))
+  (define labels "")
+  (define links '())
+  
+  (define (scm->dot name)
+    (cond ((eq? name 'digraph) "digraph_")
+          ((equal? name "digraph") "digraph_")
+          (else (string-translate (->string name) "-" "_"))))
+
+  (define (add-link! from to)
+    (unless (member (cons from to) links)
+      (set! links (cons (cons from to) links))))
+
+  (define (links->string)
+    (string-intersperse
+     (map (lambda (link)
+            (string-append (scm->dot (car link)) " -> "
+                           (scm->dot (cdr link)) ";\n"))
+          links)))
+    
+  (define (link-dependencies egg)
+    (let ((deps (filter (lambda (egg)
+                          (not (memq egg ##sys#core-library-modules)))
+                        (nest-tool:egg-dependencies (car (nest-tool:search-names (->string egg) raw))))))
+      (with-output-to-string
+        (lambda ()
+          (let ((dot-egg (scm->dot egg)))
+            (set! labels (string-append labels dot-egg " [label=\"" (->string egg) "\"]\n"))
+            (for-each (lambda (egg-dep)
+                        (add-link! egg egg-dep)
+                        (link-dependencies egg-dep))
+                      deps))))))
+  (link-dependencies eggname)
+  (string-append "digraph eggs {\n" labels "\n" (links->string) "\n}"))
+
+(define (nest-tool:dep-graphs->graphic eggname #!key (output-dir ".") (raw #f) (format 'png))
+  (with-output-to-file  (make-pathname output-dir (->string eggname) "dot")
+    (lambda ()
+      (print (nest-tool:dep-graph->dot eggname raw: raw))))
+  (system (conc "dot -T" format " "
+                " -o " (make-pathname output-dir eggname (->string format)) " "
+                (make-pathname output-dir eggname "dot")
+                " &")))
+
+(define (nest-tool:all-dep-graphs->graphic #!key (eggnames #f) (output-dir ".") (format 'png))
+  (let ((raw (nest-tool:raw)))
+    (for-each (lambda (egg)
+                (nest-tool:dep-graphs->graphic egg output-dir: output-dir raw: raw format: format))
+              (map ->string (or eggnames (nest-tool:names))))))