allowed for excluding directores from output

private/html.rkt

@@ -65,7 +65,7 @@
     (body ()
           ,@(%s->xexprs %age)
           (div ([class "code"])
-               ,@(file->html coverage path)))))
+               ,(file->html coverage path)))))
 
 (define (%s->xexprs %age)
   (for/list ([(type %) %age])
@@ -82,23 +82,27 @@
                    (body ()
                          (p () "expr: 100%" (br ()))
                          (div ([class "code"])
-                              ,@(file->html (hash-ref (get-test-coverage) f) f)))))
+                              ,(file->html (hash-ref (get-test-coverage) f) f)))))
    (clear-coverage!)))
 
 (define (file->html cover path)
   (define file (file->string path))
-  (let loop ([loc 1] [start 1] [left (string-length file)] [mode (covered? 1 cover path)])
-    (define (get-xml)
-      (mode-xml mode (encode-string (substring file (sub1 start) (sub1 loc)))))
-    (case left
-      [(0) (list (get-xml))]
-      [else
-       (define m (covered? loc cover path))
-       (define (loop* start) (loop (add1 loc) start (sub1 left) m))
-       (if (eq? m mode)
-           (loop* start)
-           (cons (get-xml)
-                 (loop* loc)))])))
+  (define-values (lines _)
+    (for/fold ([ls null] [pos 1])
+              ([line (string-split file "\n")])
+      (define-values (rline npos)
+        (for/fold ([r null] [pos pos])
+                  ([c line])
+          (values
+           (cons (mode-xml (covered? pos cover path)
+                           (encode-char c))
+                 r)
+           (add1 pos))))
+      (values
+       (cons `(li () ,@(reverse rline)) ls)
+       (add1 npos))))
+  `(ol ()
+    ,@(reverse lines)))
 
 (define (get-mode loc c)
   (define-values (mode _)
@@ -113,20 +117,13 @@
              (values mode last-start))])))
   mode)
 
-(define (encode-string s)
-  (reverse
-   (for/fold ([r null]) ([c s])
-     (cons
-      (case c
-        [(#\space) 'nbsp]
-        [(#\newline) '(br ())]
-        [else (string c)])
-      r))))
+(define (encode-char c)
+  (case c
+    [(#\space) 'nbsp]
+    [else (string c)]))
 (module+ test
-  (check-equal? (encode-string " ")
-                '(nbsp))
-  (check-equal? (encode-string "\n")
-                '((br ()))))
+  (check-equal? (encode-char #\space)
+                'nbsp))
 
 (define (mode-xml mode body)
   (define class
@@ -134,7 +131,7 @@
       [(yes) "covered"]
       [(no) "uncovered"]
       [(missing) "missing"]))
-  `(span ((class ,class)) ,@body))
+  `(span ((class ,class)) ,body))
 
 (module+ test
   (define (test file out)
@@ -145,5 +142,9 @@
     (clear-coverage!))
   (define f (path->string (simplify-path path)))
   (test f
-        `((span ((class "covered"))
-          ,@(encode-string (file->string f))))))
+        `(ol ()
+          ,@(for/list ([l (string-split (file->string f) "\n")])
+              `(li ()
+                ,@(for/list ([c l])
+                    `(span ((class "covered"))
+                      ,(encode-char c))))))))

raco.rkt

@@ -1,10 +1,13 @@
 #lang racket
 (require raco/command-name "cover.rkt" "format.rkt" "private/shared.rkt")
+(module+ test
+  (require rackunit racket/runtime-path))
 
 (module+ main
 
   (define coverage-dir "coverage")
   (define output-format "html")
+  (define exclude-dirs '())
 
   (define files
     (expand-directories
@@ -20,6 +23,10 @@
       [("-v" "--verbose")
        "Verbose mode"
        (verbose #t)]
+      #:multi
+      [("-e" "--exclude-from-output") t
+       "exclude all directories named this from the coverage report. By default excludes dirs named tests"
+       (set! exclude-dirs (cons t exclude-dirs))]
       #:args (file . files)
       (cons file files))))
   (define generate-coverage
@@ -30,7 +37,7 @@
       [else (error 'cover "given unknown coverage output format: ~s" output-format)]))
   (printf "generating test coverage for ~s\n" files)
   (define passed (apply test-files! files))
-  (define coverage (get-test-coverage))
+  (define coverage (remove-dirs (get-test-coverage) exclude-dirs))
   (printf "dumbing coverage info into ~s\n" coverage-dir)
   (generate-coverage coverage coverage-dir)
   (exit
@@ -51,6 +58,7 @@
                              (build-path (current-directory) f))])
            (expand-directory))))))
 
+;; -> (HorribyNestedListsOf PathString)
 (define (expand-directory)
   (for/list ([p (directory-list)])
     (cond [(directory-exists? p)
@@ -59,3 +67,50 @@
           [(ormap (lambda (r) (regexp-match r (path->string p))) extensions)
            (path->string (build-path (current-directory) p))]
           [else null])))
+(module+ test
+  (define-runtime-path cur ".")
+  (parameterize ([current-directory (build-path cur "tests/basic")])
+    (check-equal? (list->set (map (compose path->string ->relative)
+                                  (flatten (expand-directory))))
+                  (set "prog.rkt"
+                       "not-run.rkt"))))
+
+;; Coverage -> Coverage
+(define (remove-dirs cover dirs)
+  (for/hash ([(k v) cover]
+             #:unless (is-dir? k dirs))
+    (values k v)))
+(module+ test
+  (parameterize ([current-directory (build-path "/tests")])
+    (check-equal? (remove-dirs (hash "/tests/tests/x.rkt" null
+                                     "/tests/x/tests/x/x.rkt" null
+                                     "/tests/x.rkt" null)
+                               '("tests"))
+                  (hash "/tests/x.rkt" null))))
+
+
+;; PathString -> any/c
+(define (is-dir? k dirs)
+  (define expl (explode-path (->relative k)))
+  (ormap (lambda (d) (member (build-path d) expl))
+         dirs))
+(module+ test
+  (parameterize ([current-directory (build-path "/tests")])
+    (check-not-false (is-dir? "/test/test/x.rkt" '("test")))
+    (check-false (is-dir? "/test/x.rkt" '("test")))
+    (check-false (is-dir? "/test/t/x.rkt" '("test")))))
+
+;; PathString -> Path
+(define (->relative path)
+  (if (relative-path? path)
+      (build-path path)
+      (let-values ([(_ lst)
+                    (split-at (explode-path path)
+                              (length (explode-path (current-directory))))])
+        (apply build-path lst))))
+(module+ test
+  (parameterize ([current-directory (build-path "/test")])
+    (check-equal? (->relative "a")
+                  (build-path "a"))
+    (check-equal? (->relative "/test/a/b")
+                  (build-path "a" "b"))))

scribblings/basics.scrbl

@@ -1,18 +1,18 @@
 #lang scribble/doc
 @(require "base.rkt")
 
-@title[#:tag "basics"]{Basic Useage of Cover}
+@title[#:tag "basics"]{Basic Usage of Cover}
 
 The cover library adds the command @exec{raco cover} command to run test coverage. For
 every file it is given it will execute that file and its @racket[test] submodule (it if
 exists). It will then dump the coverage information into a directory, by default
-@filepath{coverage}. By default the coverage inforamtion will be generated as html.
+@filepath{coverage}. By default the coverage information will be generated as html.
 
 The @exec{raco cover} command accepts the following flags:
 
 @itemize[@item{@Flag{c} or @DFlag{coverage}
                --- Sets the coverage output type. This flag defaults to html.
-               valid foramts are:
+               valid formats are:
                @itemize[@item{html: Generates one html file per tested file.}
                         @item{coveralls: generates a coveralls json file.
                               This will then read COVERALLS_REPO_TOKEN from the environment
@@ -22,4 +22,8 @@ The @exec{raco cover} command accepts the following flags:
 
          @item{@Flag{d} or @DFlag{directory}
                --- Specifies the directory output the coverage too.
-               defaults to @filepath{coverage}.}]
+               defaults to @filepath{coverage}.}
+         @item{@Flag{e} or @DFlag{exclude-from-output}
+               --- excludes any directories by given name from the coverage report.
+               Files in these directories are still run, they are just excluded from the
+               outputted coverage. This flag may appear any number of times.}]