[racket] Playing with module resolvers

I thought the following example might tickle people:




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#lang racket/base

(require net/url
         net/uri-codec
         json)

;; Experiments with module-name-resolvers.
(define old-module-name-resolver (current-module-name-resolver))



(struct module-provider-record (name     ;; symbol
                                src      ;; string
                                provides ;; (listof string)
                                )
        #:transparent)

;; wescheme-module-provider: symbol -> (U module-provider-record #f)
;;
;; A module provider using WeScheme.  Uses the getModuleProviderRecord servlet,
;; which generates JSON output that we parse into a module provider
;; record.
(define (make-wescheme-module-provider
         #:servlet-path [servlet-path "http://www.wescheme.org/loadProject"])
  (define (module-provider name)
    (define maybe-match
      (regexp-match #px"wescheme/([-\\w]+)$" (symbol->string name)))
    (cond
     [maybe-match
      (define publicId (cadr maybe-match))
      (define url
        (string->url
         (string-append servlet-path "?"
                        (alist->form-urlencoded `((publicId . ,publicId))))))
      (define cust (make-custodian))
      (define a-module-provider-record
        (parameterize ([current-custodian cust])
          (with-handlers ([exn:fail? (lambda (exn) #f)])
            (define port (get-pure-port url))
            (define ht (read-json port))
            (cond [(hash? ht)
                   (module-provider-record
                    name
                    (hash-ref (hash-ref ht 'source (make-hash))
                              'src
                              #f)
                    (hash-ref ht 'provides '()))]
                  [else #f]))))
      (custodian-shutdown-all cust)
      a-module-provider-record]
     [else
      #f]))
  module-provider)


(define wescheme-module-provider (make-wescheme-module-provider))



;; matches-wescheme-path?: module-path -> (U #f stx)
;; Returns source of the program if this is a path that we care about
for wescheme.
(define (matches-wescheme-path? module-path)
  (cond
    [(and (symbol? module-path)
          (regexp-match #px"^wescheme/[-\\w]+$" (symbol->string module-path)))
     (define record (wescheme-module-provider module-path))
     (cond
       [(and record (module-provider-record-src record))
        (parameterize ([read-accept-reader #t])
          (define stx (read-syntax module-path (open-input-string
                                                (string-append "#lang racket\n"

(module-provider-record-src record)))))
          (syntax-case stx ()
            [(m _ l body ...)
             #`(m #,(datum->syntax #f module-path) l body ...)]))]
       [else
        #f])]
    [else
     #f]))


(define wescheme-module-name-resolver
  (case-lambda [(resolved-path ns)
                (old-module-name-resolver resolved-path ns)]
               [(module-path source-resolved-path stx load?)
                (cond
                  [(matches-wescheme-path? module-path)
                   => (lambda (src)
                        (when load?
                          (eval src))
                        (make-resolved-module-path module-path))]
                  [else
                   (old-module-name-resolver module-path
source-resolved-path stx load?)])]))




;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;
;; Showing Racket how to evaluate WeScheme code:
(parameterize ([current-namespace (make-base-namespace)]
               [current-module-name-resolver wescheme-module-name-resolver])
  ;; http://www.wescheme.org/openEditor?publicId=0X8C8Np156
  (eval '(require wescheme/0X8C8Np156))
  ;; http://www.wescheme.org/openEditor?publicId=juicy-fever-plain-depth-relax
  (eval '(require wescheme/juicy-fever-plain-depth-relax)))