autodoc.rkt

#lang racket/base

(require (for-syntax racket/base
                     scribble/manual
                     syntax/modread
                     syntax/modresolve
                     syntax/parse)
         scribble/manual)

(provide
 autodoc)

(define-syntax (autodoc stx)
  (define-syntax-class def
    #:datum-literals (define)
    (pattern (define (id:id arg:id ...)
               body-e ...)
             #:with (e ...) #'(defproc (id [arg any/c] ...) any/c))
    (pattern _
             #:with id #'#f
             #:with (e ...) #'()))

  (syntax-parse stx
    [(_ mod id:id pre-flow ...)
     (define mod-path
       (resolve-module-path (syntax->datum #'mod)))
     (define mod-stx
       (with-module-reading-parameterization
         (lambda ()
           (call-with-input-file mod-path
             (lambda (in)
               (port-count-lines! in)
               (read-syntax mod-path in))))))
     (syntax-parse mod-stx
       #:datum-literals (module #%module-begin)
       [(module _ _
          (#%module-begin d:def ...))
        (define the-id
          (syntax->datum #'id))
        (define the-def
          (for/first ([d-id (in-list (syntax-e #'(d.id ...)))]
                      [e (in-list (syntax-e #'((d.e ...) ...)))]
                      #:when (equal? (syntax->datum d-id) the-id))
            e))
        (unless the-def
          (raise-syntax-error 'autodoc (format "could not find definition for ~s" the-id)))

        (define augmented-def
          (datum->syntax #'stx
                         (append (syntax->list the-def)
                                 (syntax->list #'(pre-flow ...)))))

        augmented-def])]))