new api, scribblings, and bug fixes

cover.rkt

@@ -0,0 +1,135 @@
+#lang racket/base
+(provide test-files! clear-coverage! get-test-coverage)
+(require (for-syntax racket/base))
+(require racket/dict
+         syntax/modcode
+         racket/function
+         syntax/modread
+         syntax/parse
+         racket/runtime-path
+         rackunit)
+
+
+
+(define ns (make-base-namespace))
+
+;; PathString * -> Boolean
+;; Test files and build coverage map
+;; returns true if all tests passed
+(define (test-files! . paths)
+  (clear-coverage!)
+  (for ([p paths])
+    (let loop ()
+      (define-values (loc type) (get-module-path (build-path p)))
+      (case type
+        [(zo so)
+         (delete-file loc)
+         (loop)]
+        [else (void)])))
+  (parameterize ([use-compiled-file-paths
+                  (cons (build-path "compiled" "better-test")
+                        (use-compiled-file-paths))]
+                 [current-compile (make-better-test-compile)])
+    (define tests-failed #f)
+    (for ([p paths])
+      (define old-check (current-check-handler))
+      (parameterize* ([current-namespace ns]
+                      [current-check-handler
+                       (lambda x
+                         (set! tests-failed #t)
+                         (apply old-check x))])
+        (eval `(dynamic-require '(file ,p) #f))
+        (namespace-require `(file ,p))
+        (define submod `(submod (file ,p) test))
+        (when (module-declared? submod)
+          (namespace-require submod))))
+    (not tests-failed)))
+
+(define (make-better-test-compile)
+  (define compile (current-compile))
+  (define reg (namespace-module-registry ns))
+  (define phase (namespace-base-phase ns))
+  (define annotate-top (get-annotate-top))
+  (lambda (e immediate-eval?)
+    (define to-compile
+      (if (eq? reg (namespace-module-registry (current-namespace)))
+          (annotate-top
+           (if (syntax? e) (expand e) (datum->syntax #f e))
+           phase)
+          e))
+    (compile to-compile immediate-eval?)))
+
+(define-runtime-path cov "coverage.rkt")
+(define-runtime-path strace "strace.rkt")
+;; -> Void
+;; clear coverage map
+(define (clear-coverage!)
+  ;(dict-clear! coverage)
+  (set! ns (make-base-namespace))
+  ;(namespace-attach-module (current-namespace) cov ns)
+  (namespace-attach-module (current-namespace) 'rackunit ns)
+  (parameterize ([current-namespace ns])
+    (namespace-require `(file ,(path->string cov)))
+    (namespace-require `(file ,(path->string strace)))
+    (namespace-require 'rackunit)))
+
+;; -> [Hashof PathString (Listof (List Boolean srcloc))]
+;; returns a hash of file to a list, where the first of the list is if
+;; that srcloc was covered or not
+;; based on <pkgs>/drracket/drracket/private/debug.rkt
+(define (get-test-coverage)
+  ;; can-annotate : (listof (list boolean srcloc))
+  ;; boolean is #t => code was run
+  ;;            #f => code was not run
+  ;; remove those that cannot be annotated
+  (define can-annotate
+    (filter values
+            (for/list ([(stx covered?) (get-raw-coverage)])
+              (and (syntax? stx)
+                   (let* ([orig-src  (syntax-source stx)]
+                          [src (if (path? orig-src) (path->string orig-src) orig-src)]
+                          [pos (syntax-position stx)]
+                          [span (syntax-span stx)])
+                     (and pos
+                          span
+                          (list covered?
+                                (make-srcloc src #f #f pos span))))))))
+
+  ;; actions-ht : (list src number number) -> (list boolean syntax)
+  (define actions-ht (make-hash))
+
+  (for-each
+   (λ (pr)
+     (let* ([on? (car pr)]
+            [key (cadr pr)]
+            [old (hash-ref actions-ht key 'nothing)])
+       (cond
+        [(eq? old 'nothing)
+         (hash-set! actions-ht key on?)]
+        [old ;; recorded as executed
+         (void)]
+        [(not old) ;; recorded as unexected
+         (when on?
+           (hash-set! actions-ht key #t))])))
+   can-annotate)
+
+  ;; filtered : (listof (list boolean srcloc))
+  ;; remove redundant expressions
+  (define filtered (hash-map actions-ht (λ (k v) (list v k))))
+
+  (define out (make-hash))
+
+  (for ([v filtered])
+    (define file (srcloc-source (cadr v)))
+    (hash-update! out
+                  file
+                  (lambda (l) (cons v l))
+                  null))
+  out)
+
+(define (get-annotate-top)
+  (get-ns-var 'annotate-top))
+(define (get-raw-coverage)
+  (get-ns-var 'coverage))
+(define (get-ns-var sym)
+  (namespace-variable-value sym #t #f ns))

format.rkt

@@ -1,3 +1,3 @@
-#lang racket
+#lang racket/base
 (require "private/html.rkt" "private/coveralls.rkt")
-(provide generate-html-coverage generate-coveralls-coverage)
+(provide generate-html-coverage generate-coveralls-coverage)

info.rkt

@@ -2,6 +2,10 @@
 (define name "cover")
 (define deps '("base" "errortrace-lib" "rackunit-lib"
                "syntax-color-lib"))
+(define build-deps
+  '("racket-doc" "scribble-lib"))
 
 (define raco-commands
-  '(("cover" (submod cover/raco main) "a code coverage tool" 100)))
+  '(("cover" (submod cover/raco main) "a code coverage tool" 30)))
+
+(define scribblings '(("scribblings/main.scrbl" ())))

main.rkt

@@ -1,135 +1,11 @@
 #lang racket/base
-(provide test-files! clear-coverage! get-test-coverage)
-(require (for-syntax racket/base))
-(require racket/dict
-         syntax/modcode
-         racket/function
-         syntax/modread
-         syntax/parse
-         racket/runtime-path
-         rackunit)
-
-
-
-(define ns (make-base-namespace))
-
-;; PathString * -> Boolean
-;; Test files and build coverage map
-;; returns true if all tests passed
-(define (test-files!  . paths)
-  (clear-coverage!)
-  (for ([p paths])
-    (let loop ()
-      (define-values (loc type) (get-module-path (build-path p)))
-      (case type
-        [(zo so)
-         (delete-file loc)
-         (loop)]
-        [else (void)])))
-  (parameterize ([use-compiled-file-paths
-                  (cons (build-path "compiled" "better-test")
-                        (use-compiled-file-paths))]
-                 [current-compile (make-better-test-compile)])
-    (define tests-failed #f)
-    (for ([p paths])
-      (define old-check (current-check-handler))
-      (parameterize* ([current-namespace ns]
-                      [current-check-handler
-                       (lambda x
-                         (set! tests-failed #t)
-                         (apply old-check x))])
-        (eval `(dynamic-require '(file ,p) #f))
-        (namespace-require `(file ,p))
-        (define submod `(submod (file ,p) test))
-        (when (module-declared? submod)
-          (namespace-require submod))))
-    (not tests-failed)))
-
-(define (make-better-test-compile)
-  (define compile (current-compile))
-  (define reg (namespace-module-registry ns))
-  (define phase (namespace-base-phase ns))
-  (define annotate-top (get-annotate-top))
-  (lambda (e immediate-eval?)
-    (define to-compile
-      (if (eq? reg (namespace-module-registry (current-namespace)))
-          (annotate-top
-           (if (syntax? e) (expand e) (datum->syntax #f e))
-           phase)
-          e))
-    (compile to-compile immediate-eval?)))
-
-(define-runtime-path cov "coverage.rkt")
-(define-runtime-path strace "strace.rkt")
-;; -> Void
-;; clear coverage map
-(define (clear-coverage!)
-  ;(dict-clear! coverage)
-  (set! ns (make-base-namespace))
-  ;(namespace-attach-module (current-namespace) cov ns)
-  (namespace-attach-module (current-namespace) 'rackunit ns)
-  (parameterize ([current-namespace ns])
-    (namespace-require `(file ,(path->string cov)))
-    (namespace-require `(file ,(path->string strace)))
-    (namespace-require 'rackunit)))
-
-;; -> [Hashof PathString (Listof (List Boolean srcloc))]
-;; returns a hash of file to a list, where the first of the list is if
-;; that srcloc was covered or not
-;; based on <pkgs>/drracket/drracket/private/debug.rkt
-(define (get-test-coverage)
-  ;; can-annotate : (listof (list boolean srcloc))
-  ;; boolean is #t => code was run
-  ;;            #f => code was not run
-  ;; remove those that cannot be annotated
-  (define can-annotate
-    (filter values
-            (for/list ([(stx covered?) (get-raw-coverage)])
-              (and (syntax? stx)
-                   (let* ([orig-src  (syntax-source stx)]
-                          [src (if (path? orig-src) (path->string orig-src) orig-src)]
-                          [pos (syntax-position stx)]
-                          [span (syntax-span stx)])
-                     (and pos
-                          span
-                          (list covered?
-                                (make-srcloc src #f #f pos span))))))))
-
-  ;; actions-ht : (list src number number) -> (list boolean syntax)
-  (define actions-ht (make-hash))
-
-  (for-each
-   (λ (pr)
-     (let* ([on? (car pr)]
-            [key (cadr pr)]
-            [old (hash-ref actions-ht key 'nothing)])
-       (cond
-        [(eq? old 'nothing)
-         (hash-set! actions-ht key on?)]
-        [old ;; recorded as executed
-         (void)]
-        [(not old) ;; recorded as unexected
-         (when on?
-           (hash-set! actions-ht key #t))])))
-   can-annotate)
-
-  ;; filtered : (listof (list boolean srcloc))
-  ;; remove redundant expressions
-  (define filtered (hash-map actions-ht (λ (k v) (list v k))))
-
-  (define out (make-hash))
-
-  (for ([v filtered])
-    (define file (srcloc-source (cadr v)))
-    (hash-update! out
-                  file
-                  (lambda (l) (cons v l))
-                  null))
-  out)
-
-(define (get-annotate-top)
-  (get-ns-var 'annotate-top))
-(define (get-raw-coverage)
-  (get-ns-var 'coverage))
-(define (get-ns-var sym)
-  (namespace-variable-value sym #t #f ns))
+(require "cover.rkt" "format.rkt" "private/contracts.rkt" "private/format-utils.rkt"
+         racket/contract)
+(provide
+ (contract-out
+  [test-files! (->* () () #:rest path-string? any/c)]
+  [clear-coverage! (-> any)]
+  [get-test-coverage (-> coverage/c)]
+  [covered? (-> exact-positive-integer? file-coverage/c path-string? (or/c 'yes 'no 'missing))]
+  [generate-coveralls-coverage (->* (coverage/c) (path-string?) any)]
+  [generate-html-coverage (->* (coverage/c) (path-string?) any)]))

private/contracts.rkt

@@ -0,0 +1,7 @@
+#lang racket/base
+(provide coverage/c file-coverage/c)
+(require racket/contract)
+
+(define file-coverage/c (listof (list/c boolean? srcloc?)))
+(define coverage/c (hash/c (and/c path-string? absolute-path?)
+                           file-coverage/c))

private/coveralls.rkt

@@ -3,17 +3,17 @@
 (require racket/runtime-path json "format-utils.rkt")
 
 (module+ test
-  (require rackunit "../main.rkt" racket/runtime-path))
+  (require rackunit "../cover.rkt" racket/runtime-path))
 
 ;; Coveralls
 
-;; Coverage [Hasheq String String] [path-string] -> Void
+;; Coverage [path-string] -> Void
 (define-runtime-path post "curl.sh")
-(define (generate-coveralls-coverage coverage meta [dir "coverage"])
+(define (generate-coveralls-coverage coverage [dir "coverage"])
   (make-directory* dir)
   (define coverage-path (path->string (build-path (current-directory) dir)))
   (define coverage-file (string-append coverage-path "/coverage.json"))
-  (define json (generate-coveralls-json coverage meta))
+  (define json (generate-coveralls-json coverage (hasheq)))
   (define token (or (getenv "COVERALLS_REPO_TOKEN") ""))
   (with-output-to-file coverage-file
     (λ () (write-json (hash-set (hash-set json 'repo_token token)

private/format-utils.rkt

@@ -1,7 +1,7 @@
 #lang racket
 (provide get-percentages/top get-percentages/file covered?)
 (require syntax/modread syntax/parse unstable/sequence syntax-color/racket-lexer)
-(module+ test (require rackunit "../main.rkt" racket/runtime-path))
+(module+ test (require rackunit "../cover.rkt" racket/runtime-path))
 
 ;;;;; a Coverage is the output of (get-test-coverage)
 ;;;;; a FileCoverage is the values of the hashmap from (get-test-coverage)

private/html.rkt

@@ -3,7 +3,7 @@
 (require (only-in xml write-xexpr) "format-utils.rkt")
 
 (module+ test
-  (require rackunit "../main.rkt" racket/runtime-path))
+  (require rackunit "../cover.rkt" racket/runtime-path))
 
 ;;; Coverage [PathString] -> Void
 (define (generate-html-coverage coverage [dir "coverage"])

raco.rkt

@@ -1,5 +1,5 @@
 #lang racket
-(require raco/command-name "main.rkt" "format.rkt")
+(require raco/command-name "cover.rkt" "format.rkt")
 
 (module+ main
 
@@ -11,9 +11,11 @@
      (command-line
       #:program (short-program+command-name)
       #:once-any
-      [("-d" "--directory") d "Specify output directory" (set! coverage-dir d)]
+      [("-d" "--directory") d
+       "Specify output directory. Defaults to ./coverage."
+       (set! coverage-dir d)]
       [("-c" "--coverage") format
-       "Specify that coverage should be run and optional what format"
+       "Specify that coverage should be run and optional what format. Defaults to html."
        (set! output-format format)]
       #:args (file . files)
       (cons file files))))
@@ -22,7 +24,7 @@
   (define coverage (get-test-coverage))
   (case output-format
     [("html") (generate-html-coverage coverage coverage-dir)]
-    [("coveralls") (generate-coveralls-coverage coverage (hasheq) coverage-dir)])
+    [("coveralls") (generate-coveralls-coverage coverage coverage-dir)])
   (exit
    (case passed
      [(#t) 0]

scribblings/api.scrbl

@@ -0,0 +1,57 @@
+#lang scribble/doc
+@(require "base.rkt")
+
+@title[#:tag "api"]{Racket API}
+
+@defmodule[cover #:use-sources (cover)]
+
+In addition to a raco tool Cover provides racket bindings for running
+tests and collecting coverage information. The following are the basic
+functions of test coverage.
+
+@defproc[(test-files! (files path-string?) ...) any/c]{
+
+Clears all coverage information, then tests all given @racket[files]
+and stores the coverage information. Returns false if tests
+failed. Test coverage information is still collected when test fail.}
+
+@defproc[(clear-coverage!) any]{Clears all coverage information.}
+
+@defproc[(get-coverage-information) coverage/c]{Gets coverage information.}
+@defproc[(covered? (loc exact-positive-integer?) (coverage file-coverage/c)
+                   (path path-string?))
+         (or/c 'yes 'no 'missing)
+         ]{
+Given some location in a file, the
+coverage information for that file, and the path to that file,
+@racket[covered?] returns if that position how that position is
+covered. There are three possible results:
+@itemize[@item{@racket['missing] --- The location is not in the
+coverage information, is a comment, or is in a submodule}
+@item{@racket['yes] --- The location is not @racket['missing] and is
+covered} @item{@racket['no] --- The location is not @racket['missing]
+and is not covered}]
+                                   }
+
+@deftogether[(@defproc[(generate-coveralls-coverage (c coverage/c) (p path-string? "coverage")) any]
+              @defproc[(generate-html-coverage (c coverage/c) (p path-string? "coverage")) any])]{
+Generates coverage information in the coveralls and html
+formats. Equivalent to the specifications of the @Flag{c} argument to
+@exec{raco cover}.}
+
+@deftogether[(@defthing[coverage/c
+                         contract?
+                         #:value (hash/c (and/c path-string? absolute-path?)
+                                         file-coverage/c)]
+                @defthing[file-coverage/c contract? #:value (listof (list/c boolean? srcloc?))])]{
+Coverage infomation is a hash map mapping absolute
+file paths to a list detailing the coverage of that file. The coverage
+information is a list of lists, mapping a boolean to a range of
+characters within the file. True means @racket[srcloc] structure
+represents an expression that was run, and False means the structure
+represents an expression that was not run. Not that not all
+expressions may be represented directly in this coverage
+information. For example, type annotations in @racket[typed/racket]
+removed during macro expansion and are thus neither run or not run.
+Not that the @racket[srcloc]s are one indexed, meaning a @racket[1]
+represents the first character in the file.}

scribblings/base.rkt

@@ -0,0 +1,12 @@
+#lang racket/base
+
+(require
+ scribble/eval
+ scribble/manual
+
+ (for-label racket/base cover))
+
+(provide
+ (all-from-out scribble/eval
+               scribble/manual)
+ (for-label (all-from-out racket/base cover)))

scribblings/basics.scrbl

@@ -0,0 +1,23 @@
+#lang scribble/doc
+@(require "base.rkt")
+
+@title[#:tag "basics"]{Basic Useage 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.
+
+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:
+               @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
+                              and submit the report to coveralls using that repo token.}]}
+
+         @item{@Flag{d} or @DFlag{directory}
+               --- Specifies the directory output the coverage too.
+               defaults to @filepath{coverage}.}]

scribblings/main.scrbl

@@ -0,0 +1,15 @@
+#lang scribble/doc
+@(require "base.rkt")
+@title{Cover: A test coverage tool}
+
+@author[(author+email "Spencer Florence" "spencer@florence.io")
+        (author+email "Ryan Plessner" "rpless@ccs.neu.edu")]
+
+Cover is a test coverage tool. It is designed to be used in addition to raco test
+
+@table-of-contents[]
+
+@include-section["basics.scrbl"]
+@include-section["api.scrbl"]
+
+@index-section[]

tests/main.rkt

@@ -3,7 +3,7 @@
 ;; for every .rkt file in those directories it loads
 ;; tests that file and checks its coverage against an
 ;; .rktl file of the same name
-(require "../main.rkt" racket/runtime-path rackunit)
+(require "../cover.rkt" racket/runtime-path rackunit)
 
 (define (test-dir d)
   (define files