127 lines
4.3 KiB
Racket
127 lines
4.3 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/contract
|
|
racket/format
|
|
racket/match
|
|
racket/port
|
|
(only-in xml xexpr->string)
|
|
(only-in "../find.rkt" find-signature)
|
|
"../identifier.rkt"
|
|
"../scribble.rkt")
|
|
|
|
(provide type
|
|
describe)
|
|
|
|
(module+ test
|
|
(require rackunit))
|
|
|
|
;;; type
|
|
|
|
(define/contract (type how str)
|
|
(-> how/c string? (or/c #f string?))
|
|
(or (and (eq? how 'namespace)
|
|
(->identifier 'namespace str type-or-contract))
|
|
(->identifier how str identifier->bluebox)
|
|
(match (find-signature how str)
|
|
[#f #f]
|
|
[x (~a x)])))
|
|
|
|
(define (type-or-contract v) ;any/c -> (or/c #f string?)
|
|
(or
|
|
;; 1. Try using Typed Racket's REPL simplified type.
|
|
(with-handlers ([exn:fail? (λ _ #f)])
|
|
(match (with-output-to-string
|
|
(λ ()
|
|
((current-eval)
|
|
(cons '#%top-interaction v))))
|
|
[(pregexp "^- : (.*) \\.\\.\\..*\n" (list _ t)) t]
|
|
[(pregexp "^- : (.*)\n$" (list _ t)) t]))
|
|
;; 2. Try to find a contract.
|
|
(with-handlers ([exn:fail? (λ _ #f)])
|
|
(parameterize ([error-display-handler (λ _ (void))])
|
|
((current-eval)
|
|
(cons '#%top-interaction
|
|
`(if (has-contract? ,v)
|
|
(~a (contract-name (value-contract ,v)))
|
|
(error ""))))))))
|
|
|
|
;;; describe
|
|
|
|
;; If a symbol has installed documentation, display it.
|
|
;;
|
|
;; Otherwise, walk the source to find a function definition signature
|
|
;; (the argument names may have explanatory value). When using a
|
|
;; module->namespace, also look for Typed Racket type or a contract,
|
|
;; if any.
|
|
|
|
(define/contract (describe how str)
|
|
(-> (or/c how/c
|
|
(cons/c path-string? string?)
|
|
(list/c path-string?))
|
|
string?
|
|
string?)
|
|
(match how
|
|
[(list (? path-string? path))
|
|
(or (path+anchor->html (cons path #f))
|
|
"Documentation not found")]
|
|
[(cons (? path-string? path) (? string? anchor))
|
|
(or (path+anchor->html (cons path anchor))
|
|
"Documentation not found")]
|
|
[(and (or 'namespace (? path-string?)) how)
|
|
(->identifier how str
|
|
(λ (stx)
|
|
(or (path+anchor->html (binding->path+anchor stx))
|
|
(sig-and/or-type how stx))))]))
|
|
|
|
(define/contract (sig-and/or-type how stx)
|
|
(-> how/c identifier? string?)
|
|
(define dat (syntax->datum stx))
|
|
(define s (match (find-signature how (symbol->string dat))
|
|
[#f #f]
|
|
[x (~a x)]))
|
|
(define t (and (eq? how 'namespace)
|
|
(type-or-contract stx)))
|
|
(xexpr->string
|
|
`(div ()
|
|
(h1 () ,(or s (~a dat)))
|
|
,(cond [(not (or s t))
|
|
`(p ()
|
|
(em () ,(if (eq? how 'namespace)
|
|
"(Found no documentation, signature, type, or contract.)"
|
|
"(Found no documentation or signature.")))]
|
|
[t `(pre () ,t)]
|
|
[else ""])
|
|
(br ()))))
|
|
|
|
(module+ test
|
|
(require rackunit
|
|
(only-in xml string->xexpr)
|
|
"../syntax.rkt")
|
|
;; Check something that is in the namespace resulting from
|
|
;; module->namespace on, say, this source file.
|
|
(parameterize ([current-namespace (module->namespace (syntax-source #'this-file))])
|
|
(check-equal?
|
|
;; Convert back to an xexpr because easier to grok test and also
|
|
;; older xexpr->string probably used <br /> instead of <br/>.
|
|
(string->xexpr (describe 'namespace "describe"))
|
|
`(div ()
|
|
(h1 () "(describe how str)")
|
|
(pre () "(-" ">" " (or/c (or/c (quote namespace) path-string?) (cons/c path-string? string?) (list/c path-string?)) string? string?)")
|
|
(br ()))))
|
|
|
|
;; Check something that is not in the current namespace, but is an
|
|
;; identifier in the lexical context of an expanded module form --
|
|
;; including imported identifiers -- from the expanded syntax
|
|
;; cache.
|
|
(define path-str "/path/to/foobar.rkt")
|
|
(define code-str (~a '(module foobar racket/base
|
|
(define (fun a b c)
|
|
(void)))))
|
|
;; Get the expanded syntax in our cache
|
|
(string->expanded-syntax path-str code-str void)
|
|
;; Note that this doesn't find contracts, just sigs.
|
|
(check-equal?
|
|
(string->xexpr (describe path-str "fun"))
|
|
`(div ()
|
|
(h1 () "(fun a b c)")
|
|
(br ()))))
|