diff --git a/private/html.rkt b/private/html.rkt index 1e26c55..c75de4e 100644 --- a/private/html.rkt +++ b/private/html.rkt @@ -6,29 +6,53 @@ (require rackunit "../cover.rkt" racket/runtime-path)) ;;; Coverage [PathString] -> Void -(define (generate-html-coverage coverage [dir "coverage"]) +(define (generate-html-coverage coverage [d "coverage"]) + (define dir (simplify-path d)) (make-directory* dir) - (for ([(k v) coverage]) - (define relative-file-name - (string-replace k (path->string (build-path (current-directory))) "")) - (define coverage-path (path->string (build-path (current-directory) dir))) - (define coverage-file-relative - (string-replace (string-replace relative-file-name ".rkt" "") "/" "-")) - (define output-file (string-append coverage-path "/" coverage-file-relative ".html")) - (with-output-to-file output-file - (λ () (write-xexpr (make-html-file (hash-ref coverage k) relative-file-name))) - #:exists 'replace))) + (define file-list + (for/list ([(k v) coverage]) + (define exploded (explode-path k)) + (define-values (_ dir-list) + (split-at exploded + (length (explode-path (current-directory))))) + (define coverage-dir-list + (cons dir (take dir-list (sub1 (length dir-list))))) + (define relative-output-file (path-replace-suffix (last exploded) ".html")) + (define output-file (apply build-path (append coverage-dir-list (list relative-output-file)))) + (define output-dir (apply build-path coverage-dir-list)) + (make-directory* output-dir) + (with-output-to-file output-file + (λ () (write-xexpr (make-html-file (hash-ref coverage k) k))) + #:exists 'replace) + output-file)) + (build-index! coverage file-list dir)) + +(define (build-index! coverage file-list dir) + (define %ages (get-percentages/top coverage)) + (define xexpr + `(html + (body + ,@(%s->xexprs %ages) + ,@(for/list ([file file-list]) + (define f (path->string (apply build-path (rest (explode-path file))))) + `(p () (a ([href ,f]) ,f)))))) + (with-output-to-file (build-path dir "index.html") + #:exists 'replace + (thunk + (write-xexpr xexpr)))) -;;;;; html ;; FileCoverage PathString -> Xexpr (define (make-html-file coverage path) (define %age (get-percentages/file path coverage)) `(html () (body () - ,@(for/list ([(type %) %age]) - `(p () ,(~a type ': " " (~r (* 100 %) #:precision 2) "%") (br ()))) + ,@(%s->xexprs %age) ,@(file->html coverage path)))) +(define (%s->xexprs %age) + (for/list ([(type %) %age]) + `(p () ,(~a type ': " " (~r (* 100 %) #:precision 2) "%") (br ())))) + (module+ test (define-runtime-path path "../tests/basic/prog.rkt") (test-begin