Created
April 9, 2013 22:30
-
-
Save dyoo/5349990 to your computer and use it in GitHub Desktop.
Requiring WeScheme code for Racket. Preliminary.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#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))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment