raco.rkt (4209B)
1 #lang racket 2 3 (require raco/command-name 4 racket/cmdline 5 rackunit/docs-complete 6 "main.rkt") 7 8 (module+ test 9 (require rackunit 10 rackunit/text-ui 11 compiler/find-exe)) 12 13 ; do-ignore! : (U string symbol) regex -> boolean 14 (define (do-ignore! mod ignore) 15 (define undoc 16 (filter-not (λ (name) (regexp-match ignore (symbol->string name))) 17 (module->undocumented-exported-names 18 (if (symbol? mod) mod (string->symbol mod))))) 19 (cond [(set-empty? undoc) 20 (printf "Module ~a is completely documented~n" mod) 21 #f] 22 [else 23 (printf "Module ~a is missing documentation for: ~a~n" mod undoc) 24 #t])) 25 26 ; do-binding! : (U string symbol) symbol -> boolean 27 (define (do-binding! mod binding) 28 (cond [(set-member? (module->all-exported-names mod) binding) 29 (define b* (has-docs? mod binding)) 30 (cond [b* (printf "Module ~a has documentation for ~a~n" mod binding) 31 #t] 32 [else (printf "Module ~a is missing documentation for ~a~n" mod binding) 33 #f])] 34 [else 35 (fprintf (current-error-port) "Module ~a does not export ~a~n" mod binding) 36 #f])) 37 38 ; try-namespace-require : string -> (U string symbol #f) 39 (define (try-namespace-require mod) 40 (let/ec return 41 (with-handlers ([exn:fail? (lambda (e) 42 (set! mod (string->symbol mod)))]) 43 (namespace-require mod) 44 (return mod)) 45 (with-handlers ([exn:fail? (lambda (e) 46 (fprintf (current-error-port) "Module ~a can not be loaded~n" mod) 47 (return #f))]) 48 (namespace-require mod) 49 (return mod)))) 50 51 (module+ main 52 53 (define binding (make-parameter #f)) 54 (define ratio (make-parameter #f)) 55 (define ignore (make-parameter #f)) 56 (define error-on-exit? (make-parameter #f)) 57 58 (define args 59 (command-line 60 #:program (short-program+command-name) 61 #:once-any 62 [("-b" "--binding") b 63 "Check the documentation for a specific binding" 64 (binding (string->symbol b))] 65 [("-r" "--ratio") r 66 "Specify required documentation ratio" 67 (ratio (string->number r))] 68 [("-s" "--skip") s 69 "Specify regex of bindings to ignore" 70 (ignore (regexp s))] 71 #:args (file . files) 72 (cons file files))) 73 74 ; Loop over all found modules 75 (for ([a (in-list args)]) 76 77 ; Determin if module exists 78 (define mod (try-namespace-require a)) 79 80 ; If we succeeded in importing the module run the correct operation 81 (when mod 82 (cond [(binding) 83 (when (do-binding! mod (binding)) 84 (error-on-exit? #t))] 85 [(ratio) 86 (define r* (module-documentation-ratio mod)) 87 (printf "Module ~a document ratio: ~a~n" mod r*) 88 (when (r* . < . (ratio)) 89 (error-on-exit? #t))] 90 [(ignore) 91 (when (do-ignore! mod (ignore)) 92 (error-on-exit? #t))] 93 [else 94 (define undoc (module->undocumented-exported-names mod)) 95 (cond [(set-empty? undoc) 96 (printf "Module ~a is completely documented~n" mod)] 97 [else 98 (printf "Module ~a is missing documentation for: ~a~n" mod undoc) 99 (error-on-exit? #t)])]))) 100 101 (when (error-on-exit?) 102 (exit 1))) 103 104 (module+ test 105 (check-equal? 106 (with-output-to-string 107 (lambda () (system* (find-exe) "-l" "raco" "doc-coverage" "racket/base"))) 108 "Module racket/base is missing documentation for: (expand-for-clause for-clause-syntax-protect syntax-pattern-variable?)\n") 109 (check-equal? 110 (with-output-to-string 111 (lambda () (system* (find-exe) "-l" "raco" "doc-coverage" "-r" "0.5" "racket/match"))) 112 (format "Module racket/match document ratio: ~a/~a\n" 113 (length (module->documented-exported-names 'racket/match)) 114 (length (module->all-exported-names 'racket/match)))) 115 (check-equal? 116 (with-output-to-string 117 (lambda () (system* (find-exe) "-l" "raco" "doc-coverage" "-b" "match" "racket"))) 118 "Module racket has documentation for match\n")) 119