better

pollen/markup-helper.rkt

@@ -1,37 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base
-                     syntax/strip-context
-                     pollen/private/project
-                     pollen/setup)
-         pollen/private/external/include-template
-         pollen/cache
-         pollen/pagetree
-         pollen/core
-         pollen/template
-         pollen/top)
-
-(provide (rename-out [mb #%module-begin])
-         (except-out (all-from-out racket/base) #%module-begin))
-(define-syntax (mb stx)
-  (syntax-case stx ()
-    [(_ SOURCE-PATH-STRING TEMPLATE-PATH-STRING)
-     (let ([source-path (syntax->datum #'SOURCE-PATH-STRING)])
-       (with-syntax ([DIRECTORY-REQUIRE-FILES
-                      (replace-context #'here (require-directory-require-files source-path))]
-                     [DOC-ID (setup:main-export source-path)]
-                     [META-ID (setup:meta-export source-path)]
-                     [CPR (current-project-root)]
-                     [HERE-PATH-KEY (setup:here-path-key source-path)]
-                     [COMMAND-CHAR (setup:command-char source-path)])
-         #'(#%module-begin 
-            DIRECTORY-REQUIRE-FILES
-            (define result
-              (parameterize ([current-pagetree (make-project-pagetree CPR)]
-                             [current-metas (cached-metas SOURCE-PATH-STRING)])
-                (define DOC-ID (cached-doc SOURCE-PATH-STRING))
-                (define META-ID (current-metas))
-                (define here (path->pagenode (or (select-from-metas 'HERE-PATH-KEY META-ID) 'unknown)))
-                (if (bytes? DOC-ID) ; if main export is binary, just pass it through
-                    DOC-ID
-                    (include-template #:command-char COMMAND-CHAR (file TEMPLATE-PATH-STRING)))))
-            (provide result))))]))

pollen/private/render-helper.rkt

@@ -0,0 +1,58 @@
+#lang racket/base
+(require (for-syntax racket/base
+                     syntax/strip-context
+                     "project.rkt"
+                     "../setup.rkt")
+         racket/stxparam
+         racket/splicing
+         "external/include-template.rkt"
+         "../cache.rkt"
+         "../pagetree.rkt"
+         "../core.rkt"
+         "../setup.rkt"
+         "../template.rkt"
+         "../top.rkt")
+
+(provide (rename-out [mb #%module-begin])
+         (except-out (all-from-out racket/base) #%module-begin))
+
+(define-syntax-parameter doc (λ (stx) (error 'doc-not-parameterized)))
+(define-syntax-parameter metas (λ (stx) (error 'metas-not-parameterized)))
+(define-syntax-parameter result (λ (stx) (error 'result-not-parameterized)))
+
+(define-syntax (mb stx)
+  (syntax-case stx ()
+    ;; preproc branch
+    [(_ #:source SOURCE-PATH-STRING
+        #:result-id RESULT-ID)
+     #'(#%module-begin
+        (splicing-syntax-parameterize ([result (make-rename-transformer #'RESULT-ID)])
+          (define result (cached-doc SOURCE-PATH-STRING))
+          (provide result)))]
+    ;; markup / markdown branch
+    [(_ #:source SOURCE-PATH-STRING
+        #:template TEMPLATE-PATH-STRING
+        #:result-id RESULT-ID)
+     (let ([source-path (syntax->datum #'SOURCE-PATH-STRING)])
+       (with-syntax ([DIRECTORY-REQUIRE-FILES
+                      (replace-context #'here (require-directory-require-files source-path))]
+                     [DOC-ID (setup:main-export source-path)]
+                     [METAS-ID (setup:meta-export source-path)]
+                     [COMMAND-CHAR (setup:command-char source-path)])
+         #'(#%module-begin 
+            DIRECTORY-REQUIRE-FILES
+            (splicing-syntax-parameterize
+                ([doc (make-rename-transformer #'DOC-ID)]
+                 [metas (make-rename-transformer #'METAS-ID)]
+                 [result (make-rename-transformer #'RESULT-ID)])
+              (define result
+                (parameterize ([current-pagetree (make-project-pagetree (current-project-root))]
+                               [current-metas (cached-metas SOURCE-PATH-STRING)])
+                  (define doc (cached-doc SOURCE-PATH-STRING))
+                  (define metas (current-metas))
+                  (define here (path->pagenode
+                                (or (select-from-metas (setup:here-path-key SOURCE-PATH-STRING) metas) 'unknown)))
+                  (if (bytes? doc) ; if main export is binary, just pass it through
+                      doc
+                      (include-template #:command-char COMMAND-CHAR (file TEMPLATE-PATH-STRING)))))
+              (provide result)))))]))

pollen/render.rkt

@@ -197,10 +197,9 @@
     (render-through-eval (with-syntax ([MODNAME (gensym)]
                                        [SOURCE-PATH-STRING (->string source-path)])
                            #'(begin
-                               (module MODNAME racket/base
+                               (module MODNAME pollen/private/render-helper
-                                 (require pollen/cache)
+                                 #:source SOURCE-PATH-STRING
-                                 (define result (cached-doc SOURCE-PATH-STRING))
+                                 #:result-id result)
-                                 (provide result))
                                (require 'MODNAME)
                                result)))))
 
@@ -219,9 +218,10 @@
                     [SOURCE-PATH-STRING (->string source-path)]
                     [TEMPLATE-PATH-STRING (->string template-path)])
         #'(begin
-            (module MODNAME pollen/markup-helper
+            (module MODNAME pollen/private/render-helper
-              SOURCE-PATH-STRING
+              #:source SOURCE-PATH-STRING
-              TEMPLATE-PATH-STRING)
+              #:template TEMPLATE-PATH-STRING
+              #:result-id result)
             (require 'MODNAME)
             result)))
     (render-through-eval stx-to-eval)))
@@ -285,7 +285,7 @@
    (check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html)))
 
 (define-namespace-anchor render-module-ns)
-(define (render-through-eval datum-to-eval)
+(define (render-through-eval stx-to-eval)
   ;; render a datum, not a syntax object, so that it can have fresh bindings.
   (parameterize ([current-output-port (current-error-port)])
-    (eval datum-to-eval)))
+    (eval stx-to-eval)))