www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

commit 4d23e3618b7eee0fdc31c5aa8a86cc1edce9c26a
parent e4119aa0f2d44761eab77ce1b2f8ae2ccf748a72
Author: Leif Andersen <leif@leifandersen.net>
Date:   Tue, 29 Dec 2015 17:48:10 -0700

Add raco command.

Diffstat:
M.gitignore | 2++
Mdoc-coverage/info.rkt | 7++++---
Adoc-coverage/raco.rkt | 75+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 81 insertions(+), 3 deletions(-)

diff --git a/.gitignore b/.gitignore @@ -3,3 +3,5 @@ **/*.html **/*.css **/*.js +*~ +\#* diff --git a/doc-coverage/info.rkt b/doc-coverage/info.rkt @@ -1,4 +1,6 @@ #lang info -(define name "doc-coverage") -(define scribblings '(("doc-coverage.scrbl" ()))) -\ No newline at end of file +(define name "docs-coverage") +(define scribblings '(("doc-coverage.scrbl" ()))) +(define raco-commands + '(("cover-doc" (submod doc-coverage/raco main) "a code documentation coverage tool" 25))) diff --git a/doc-coverage/raco.rkt b/doc-coverage/raco.rkt @@ -0,0 +1,75 @@ +#lang racket + +(require raco/command-name + racket/cmdline + rackunit/docs-complete + "main.rkt") + +(module+ main + + (define binding (make-parameter #f)) + (define ratio (make-parameter #f)) + (define ignore (make-parameter #f)) + (define error-on-exit? (make-parameter #f)) + + (define args + (command-line + #:program (short-program+command-name) + #:once-any + [("-b" "--binding") b + "Check the documentation for a specific binding" + (binding (string->symbol b))] + [("-r" "--ratio") r + "Specify required documentation ratio" + (ratio (string->number r))] + [("-s" "--skip") s + "Specify regex of bindings to ignore" + (ignore (regexp s))] + #:args (file . files) + (cons file files))) + + (for ([a (in-list args)]) + (let/ec break + + (with-handlers ([exn:fail? (lambda (e) + (set! a (string->symbol a)))]) + (namespace-require a)) + (with-handlers ([exn:fail? (lambda (e) + (fprintf (current-error-port) "Module ~a can not be loaded~n" a) + (error-on-exit? #t) + (break))]) + (namespace-require a)) + + (cond [(binding) + (cond [(set-member? (module->all-exported-names a) (binding)) + (define b* (has-docs? a (binding))) + (cond [b* (printf "Module ~a has documentation for ~a~n" a (binding))] + [else (printf "Module ~a is missing documentation for ~a~n" a (binding)) + (error-on-exit? #t)])] + [else + (fprintf (current-error-port) "Module ~a does not export ~a~n" a (binding)) + (error-on-exit? #t)])] + [(ratio) + (define r* (module-documentation-ratio a)) + (printf "Module ~a document aatio: ~a~n" a r*) + (when (r* . < . (ratio)) + (error-on-exit? #t))] + [(ignore) + (define missing + (with-output-to-string + (lambda () + (parameterize ([current-error-port (current-output-port)]) + (check-docs a #:skip (ignore)))))) + (match missing + ["" (printf "Module ~a is documented~n" a)] + [else (printf "Module ~a is missing documentation for ~a~n" a missing)])] + [else + (define undoc (module->undocumented-exported-names a)) + (cond [(set-empty? undoc) + (printf "Module ~a is completely documented~n" a)] + [else + (printf "Module ~a is missing documentation for: ~a~n" a undoc) + (error-on-exit? #t)])]))) + + (when (error-on-exit?) + (exit 1)))