resources keep a simple string key

resource/compile-time.rkt

@@ -2,7 +2,9 @@
 ;; Macros for recording the definition of resources in a program.
 (require (for-syntax racket/base
                      racket/path
-                     syntax/parse))
+                     syntax/parse
+                     "munge-path.rkt"
+                     "record.rkt"))
                      
 (provide define-resource)
 
@@ -14,13 +16,24 @@
 (define-syntax (define-resource stx)
   (syntax-parse stx 
     [(_ name:id path:str)
-     (with-syntax ([normal-path 
-                    (normalize-path (build-path
-                                     (or (current-load-relative-directory)
-                                         (current-directory))
-                                     (syntax-e #'path)))])
-       (syntax/loc stx
-         (begin (begin-for-syntax
-                  (printf "compile time code executing; we need to save ~s\n"
-                          normal-path))
-                (define name (resource path)))))]))
+     (let* ([normal-path 
+             (normalize-path (build-path
+                              (or (current-load-relative-directory)
+                                  (current-directory))
+                              (syntax-e #'path)))]
+            [munged-path (munge-path normal-path)])
+       (with-syntax ([normal-path normal-path]
+                     [munged-path munged-path])
+         (syntax/loc stx
+           (begin 
+             ;; Compile time code:
+             (begin-for-syntax
+               (let* ([this-module 
+                       (variable-reference->resolved-module-path
+                        (#%variable-reference))]
+                      [key (resolved-module-path-name this-module)])
+                 ;(printf "Recording the resource ~a\n" normal-path)
+                 (record-resource munged-path normal-path)))
+             
+             ;; Run time code
+             (define name (resource path munged-path))))))]))

resource/munge-path.rkt

@@ -0,0 +1,18 @@
+#lang racket/base
+(require net/base64
+         file/md5)
+
+(provide munge-path)
+
+;; munge-path: path -> string
+;;
+;; Given a path, gives a munged base path string.
+(define (munge-path a-path)  
+  (define encoding-prefix (let ([op (open-output-string)])
+                            (base64-encode-stream (open-input-bytes
+                                                   (md5 (path->string (build-path a-path))))
+                                                  op
+                                                  "")
+                            (get-output-string op)))
+  (define-values (base path dir?) (split-path a-path))
+  (string-append encoding-prefix "_" (path->string path)))

resource/query.rkt

@@ -0,0 +1,70 @@
+#lang racket/base
+
+(require racket/contract
+         racket/runtime-path
+         syntax/modresolve)
+
+
+(provide/contract [query (module-path? . -> . string?)]
+                  [has-javascript-implementation? (module-path? . -> . boolean?)]
+                  
+                  [redirected? (path? . -> . boolean?)]
+                  [follow-redirection (path? . -> . path?)]
+                  [collect-redirections-to (path? . -> . (listof path?))]
+
+                  [lookup-module-requires (path? . -> . (listof path?))])
+
+(define-runtime-path record.rkt "record.rkt")
+(define ns (make-base-empty-namespace))
+
+;; query: module-path -> string?
+;; Given a module, see if it's implemented via Javascript.
+(define (query a-module-path)
+  (let ([resolved-path (resolve-module-path a-module-path #f)])
+    (parameterize ([current-namespace ns])
+      (dynamic-require a-module-path (void)) ;; get the compile-time code running.
+      ((dynamic-require-for-syntax record.rkt 'lookup-javascript-implementation) resolved-path))))
+
+
+;; has-javascript-implementation?:  module-path -> boolean
+(define (has-javascript-implementation? a-module-path)  
+  (let ([resolved-path (resolve-module-path a-module-path #f)])
+    (parameterize ([current-namespace ns])
+      (dynamic-require a-module-path (void)) ;; get the compile-time code running.
+      ((dynamic-require-for-syntax record.rkt 'has-javascript-implementation?) resolved-path))))
+  
+
+
+;; redirected? path -> boolean
+(define (redirected? a-module-path)
+  (let ([resolved-path (resolve-module-path a-module-path #f)])
+    (parameterize ([current-namespace ns])
+      (dynamic-require a-module-path (void)) ;; get the compile-time code running.
+      (path? ((dynamic-require-for-syntax record.rkt 'follow-redirection)
+              resolved-path)))))
+
+
+;; follow-redirection: module-path -> path
+(define (follow-redirection a-module-path)
+  (let ([resolved-path (resolve-module-path a-module-path #f)])
+    (parameterize ([current-namespace ns])
+      (dynamic-require a-module-path (void)) ;; get the compile-time code running.
+      ((dynamic-require-for-syntax record.rkt 'follow-redirection)
+       resolved-path))))
+
+
+
+;; collect-redirections-to: module-path -> (listof path)
+(define (collect-redirections-to a-module-path)
+  (let ([resolved-path (resolve-module-path a-module-path #f)])
+    (parameterize ([current-namespace ns])
+      (dynamic-require a-module-path (void)) ;; get the compile-time code running.
+      ((dynamic-require-for-syntax record.rkt 'collect-redirections-to)
+       resolved-path))))
+
+
+(define (lookup-module-requires a-module-path)
+  (let ([resolved-path (resolve-module-path a-module-path #f)])
+    (parameterize ([current-namespace ns])
+      (dynamic-require a-module-path (void)) ;; get the compile-time code running.
+      ((dynamic-require-for-syntax record.rkt 'lookup-module-requires) resolved-path))))

resource/record.rkt

@@ -0,0 +1,15 @@
+#lang racket/base
+(require racket/port)
+(provide record-resource)
+
+
+(define-struct record (key resource-path bytes))
+(define records '())
+
+
+;; record-javascript-implementation!: path a-resource-path -> void
+(define (record-resource a-key a-resource-path)
+  (set! records (cons (make-record a-key 
+                                   a-resource-path 
+                                   (call-with-input-file a-resource-path port->bytes))
+                      records)))

resource/structs.rkt

@@ -3,4 +3,4 @@
 (provide (all-defined-out))
 
 
-(struct resource (path))
+(struct resource (path key))