[nongnu] elpa/geiser-racket 1c3ae9f 018/191: Racket: showing contracts in module documentation.

[Philip Kaludercic]

branch: elpa/geiser-racket
commit 1c3ae9f28f1495aca89968313702cfca04cc6831
Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
Commit: Jose Antonio Ortega Ruiz <jao@gnu.org>

    Racket: showing contracts in module documentation.
---
 geiser/modules.rkt | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/geiser/modules.rkt b/geiser/modules.rkt
index 0ab372a..6ed2ecc 100644
--- a/geiser/modules.rkt
+++ b/geiser/modules.rkt
@@ -138,24 +138,30 @@
   module-cache)
 
 (define (module-exports mod)
+  (define (value id) (dynamic-require mod id (const #f)))
+  (define (contracted id)
+    (let ([v (value id)])
+      (if (has-contract? v)
+          (cons id (contract-name (value-contract v)))
+          id)))
   (define (extract-ids ls)
     (append-map (lambda (idls)
                   (map car (cdr idls)))
                 ls))
-  (define (classify-ids ids ns)
+  (define (classify-ids ids)
     (let loop ([ids ids] [procs '()] [vars '()])
       (cond [(null? ids)
-             `((procs ,@(reverse procs)) (vars ,@(reverse vars)))]
-            [(procedure?
-              (namespace-variable-value (car ids) #t (const #f) ns))
+             `((procs ,@(map contracted (reverse procs)))
+               (vars ,@(map contracted (reverse vars))))]
+            [(procedure? (value (car ids)))
              (loop (cdr ids) (cons (car ids) procs) vars)]
             [else (loop (cdr ids) procs (cons (car ids) vars))])))
   (let-values (((reg syn)
                 (module-compiled-exports
                  (get-module-code (resolve-module-path mod #f)))))
-    (let ((syn (extract-ids syn))
-          (reg (extract-ids reg)))
-      `((syntax ,@syn) ,@(classify-ids reg (module-spec->namespace mod))))))
+    (let ([syn (map contracted (extract-ids syn))]
+          [reg (extract-ids reg)])
+      `((syntax ,@syn) ,@(classify-ids reg)))))
 
 (define (startup)
  (thread update-module-cache)