2d4f3e2ac9
The layer is now redundant, since everything left in "pkgs" is in the "racket-pkgs" category.
90 lines
2.9 KiB
Racket
90 lines
2.9 KiB
Racket
#lang racket/base
|
|
|
|
(require setup/xref
|
|
scribble/xref
|
|
racket/pretty
|
|
racket/list
|
|
racket/contract/base
|
|
syntax/modcode)
|
|
|
|
;; checks to make sure that all of the exports of
|
|
;; the 'what' library are documented
|
|
(provide/contract [check-docs (->* (symbol?)
|
|
(#:skip (or/c regexp?
|
|
symbol?
|
|
#f
|
|
(-> symbol? any)
|
|
(listof (or/c regexp? symbol?))))
|
|
any)])
|
|
(define (check-docs what #:skip [skip #f])
|
|
(define (skip-proc f)
|
|
(cond
|
|
[(regexp? skip)
|
|
(regexp-match skip (symbol->string f))]
|
|
[(procedure? skip)
|
|
(skip f)]
|
|
[(not skip) #f]
|
|
[(list? skip)
|
|
(for/or ([x (in-list skip)])
|
|
(cond
|
|
[(regexp? x)
|
|
(regexp-match skip (symbol->string f))]
|
|
[(symbol? x)
|
|
(eq? x f)]))]))
|
|
|
|
(define-values (val-info stx-info)
|
|
(let/ec k
|
|
(module-compiled-exports
|
|
(parameterize ([read-accept-compiled #t])
|
|
(define resolve (current-module-name-resolver))
|
|
(define rmp (resolve what #f #f #f))
|
|
(define name (resolved-module-path-name rmp))
|
|
(cond
|
|
[(path? name) (get-module-code name)]
|
|
[(and (list? name) (path? (first name)))
|
|
(get-module-code (first name) #:submodule-path (rest name))]
|
|
[else
|
|
(eprintf "did not find compiled file for ~s\n" what)
|
|
(k '() '())])))))
|
|
|
|
(define (get n info)
|
|
(define a (assoc n info))
|
|
(if a (cdr a) '()))
|
|
|
|
(define exports
|
|
(map car
|
|
(append (get 0 val-info)
|
|
(get 0 stx-info))))
|
|
|
|
(define undocumented-exports
|
|
(for/list ([ex (in-list exports)]
|
|
#:unless (xref-binding->definition-tag xref (list what ex) #f)
|
|
#:unless (skip-proc ex))
|
|
ex))
|
|
|
|
(unless (null? undocumented-exports)
|
|
(cond
|
|
[(= (length exports) (length undocumented-exports))
|
|
(eprintf "~s has no documented exports\n" what)]
|
|
[else
|
|
(eprintf "~s has undocumented exports:\n" what)
|
|
(parameterize ([pretty-print-print-line
|
|
(λ (line-num port old-len dest-cols)
|
|
(cond
|
|
[(not line-num)
|
|
(newline port)
|
|
0]
|
|
[(equal? line-num 0)
|
|
(fprintf port " ")
|
|
2]
|
|
[else
|
|
(fprintf port "\n ")
|
|
2]))])
|
|
(pretty-write (sort undocumented-exports
|
|
string<?
|
|
#:key symbol->string)
|
|
(current-error-port)))])))
|
|
|
|
(define xref (load-collections-xref))
|
|
|