(module salmonella-html-report-cmd ()
(import scheme)
(cond-expand
(chicken-4
(import chicken)
(use data-structures extras files ports posix srfi-1)
(use salmonella-html-report salmonella-log-parser))
((or chicken-5 chicken-6)
(import (chicken base)
(chicken file)
(chicken format)
(chicken pathname)
(chicken port)
(chicken process-context)
(chicken string))
(import salmonella-html-report salmonella-log-parser srfi-1)))
;; TODO
;; - maybe optimize `all-dependencies' (memoization?)
(include "version.scm")
;;; Misc
(define *verbose* #f)
(define (info msg)
(when *verbose*
(print "=== " msg)))
;;; Usage
(define (usage #!optional exit-code)
(let* ((this-program (pathname-strip-directory (program-name)))
(msg #<#EOF
Usage: #this-program [ ]
--verbose
Verbose output.
--version
Show version and exit.
--disable-graphs
Disable generation of dependency graphs.
--css-uri=
URI of the CSS file to be used in the generatated pages.
--graphics-format=
Format of the [reverse] dependency graph images. The supported ones
are those supported by dot (GraphViz). The default format is SVG.
--compress-html
Compress HTML files using gzip.
--html-compressor
External program to use to compress HTML files.
--html-compressor-args
Arguments to be passed to the external program to compress HTML files.
--compress-graphics
Compress graphics files using gzip.
--graphics-compressor
External program to use to compress graphics files.
--graphics-compressor-args
Arguments to be passed to the external program to compress graphics files.
--keep-dot-files
By default, #this-program will remove dot files (GraphViz) after converting
them to graphics files. This command line can be used to avoid removing
them.
EOF
))
(with-output-to-port
(if (and exit-code (not (zero? exit-code)))
(current-error-port)
(current-output-port))
(cut print msg))
(when exit-code (exit exit-code))))
(let* ((args (command-line-arguments))
(disable-graphs? (and (member "--disable-graphs" args) #t))
(graphics-format (or (cmd-line-arg '--graphics-format args) "svg"))
(css (cmd-line-arg '--css-uri args))
(keep-dot-files? (and (member "--keep-dot-files" args) #t)))
(when (or (member "--help" args)
(member "-help" args)
(member "-h" args))
(usage 0))
(when (member "--version" args)
(print salmonella-html-report-version)
(exit 0))
(when (< (length args) 2)
(usage 1))
(when (member "--verbose" args)
(set! *verbose* #t))
(let ((out-dir (last args))
(log-file (last (butlast args))))
(unless (file-exists? log-file)
(die "Could not find " log-file ". Aborting."))
(when (file-exists? out-dir)
(die out-dir " already exists. Aborting."))
(when css
(salmonella-page-css css))
(compress-html?
(and (member "--compress-html" args) #t))
(html-compressor
(or (cmd-line-arg '--html-compressor args)
(html-compressor)))
(html-compressor-args
(or (cmd-line-arg '--html-compressor-args args)
(html-compressor-args)))
(compressed-html-extension
(or (cmd-line-arg '--compressed-html-extension args)
(compressed-html-extension)))
(compress-graphics?
(and (member "--compress-graphics" args) #t))
(graphics-compressor
(or (cmd-line-arg '--graphics-compressor args)
(graphics-compressor)))
(compressed-graphics-extension
(or (cmd-line-arg '--compressed-graphics-extension args)
(compressed-graphics-extension)))
(graphics-compressor-args
(or (cmd-line-arg '--graphics-compressor-args args)
(graphics-compressor-args)))
;; Create directories
(let ((installation-report-dir (make-pathname out-dir "install"))
(test-report-dir (make-pathname out-dir "test"))
(dep-graphs-dir (make-pathname out-dir "dep-graphs"))
(rev-dep-graphs-dir (make-pathname out-dir "rev-dep-graphs"))
(ranks-dir (make-pathname out-dir "ranks")))
(create-directory out-dir 'with-parents)
(create-directory installation-report-dir)
(create-directory test-report-dir)
(create-directory dep-graphs-dir)
(create-directory rev-dep-graphs-dir)
(create-directory ranks-dir)
(let* ((log (read-log-file log-file))
(eggs (sort-eggs (log-eggs log)))
(circular-deps '()) ;; alist mapping eggs to circular-dependency objects
(circular-rev-deps '()) ;; alist mapping eggs to circular-dependecy objects
(eggs/deps '()) ;; alist mapping dependencies '((egg1 . egg2) ...)
(eggs/rev-deps '()) ;; alist mapping reverse dependencies '((egg1 . egg2) ...)
)
;; Generate dependencies data
(info "Generating dependencies data")
(for-each (lambda (egg)
(let ((deps (all-dependencies egg eggs log)))
(if (circular-dependency? deps)
(set! circular-deps
(cons (cons egg deps) circular-deps))
(set! eggs/deps
(cons (cons egg deps) eggs/deps)))))
eggs)
(for-each (lambda (egg)
(let ((deps (all-dependencies egg eggs log 'reverse)))
(if (circular-dependency? deps)
(set! circular-rev-deps
(cons (cons egg deps) circular-rev-deps))
(set! eggs/rev-deps
(cons (cons egg deps) eggs/rev-deps)))))
eggs)
;; Generate the index page
(info "Generating the index page")
(sxml-log->html (make-index log eggs circular-deps)
(make-pathname out-dir "index.html"))
;; Generate the installation report for each egg
(for-each (lambda (egg)
(info (conc "Generating installation report for " egg))
(sxml-log->html
(egg-installation-report-page egg log)
(make-pathname installation-report-dir
(symbol->string egg)
"html")))
eggs)
;; Generate the test report for each egg that has test and whose
;; installation is successful
(for-each (lambda (egg)
(when (and (has-test? egg log)
(zero? (install-status egg log)))
(info (conc "Generating test report for " egg))
(sxml-log->html
(egg-test-report-page egg log)
(make-pathname test-report-dir
(symbol->string egg)
"html"))))
eggs)
;; Generate the dependencies graphs page for each egg
(if (and (dot-installed?) (not disable-graphs?))
(for-each (lambda (egg)
(info (conc "Generating reverse dependencies graph for " egg))
(unless (egg-has-circular-dependencies? egg circular-deps)
(egg-dependencies->dot egg log rev-dep-graphs-dir graphics-format keep-dot-files? reverse?: #t))
(sxml-log->html
(egg-reverse-dependencies-report egg
eggs/rev-deps
circular-rev-deps
graphics-format
log)
(make-pathname rev-dep-graphs-dir
(symbol->string egg)
"html"))
(info (conc "Generating dependencies graph for " egg))
(unless (egg-has-circular-dependencies? egg circular-deps)
(egg-dependencies->dot egg log dep-graphs-dir graphics-format keep-dot-files?))
(sxml-log->html
(egg-dependencies-report egg eggs/deps circular-deps graphics-format log)
(make-pathname dep-graphs-dir
(symbol->string egg)
"html")))
eggs)
(fprintf (current-error-port)
"~a ~a\n"
"Warning: the external program `dot' has not been found."
"[Reverse] dependencies graphs are not going to be generated."))
;; Generate the ranks page
(sxml-log->html (rank-installation-time log)
(make-pathname ranks-dir "installation-time" "html"))
(sxml-log->html (rank-test-time log)
(make-pathname ranks-dir "test-time" "html"))
(sxml-log->html (rank-dependencies log eggs/deps circular-deps disable-graphs?)
(make-pathname ranks-dir "deps" "html"))
(sxml-log->html (rank-dependencies log eggs/rev-deps circular-rev-deps disable-graphs? 'reverse)
(make-pathname ranks-dir "rev-deps" "html"))
))))
) ;; end module