working mostly

decode.rkt

@@ -7,6 +7,19 @@
 
 (provide (except-out (all-defined-out) decode register-block-tag))
 
+;; general way of coercing to string
+(define (to-string x)
+  (if (string? x)
+      x ; fast exit for strings
+      (with-handlers  ([exn:fail? (λ(exn) (error "Can't convert ~a to ~a" x 'string))])
+        (cond
+          [(equal? '() x) ""]
+          [(symbol? x) (symbol->string x)]
+          [(number? x) (number->string x)]
+          [(path? x) (path->string x)]
+          [(char? x) (format "~a" x)]
+          [else (error)])))) ; put this last so other xexprish things don't get caught
+
 
 ;; add a block tag to the list
 ;; this function is among the predicates because it alters a predicate globally.
@@ -20,26 +33,26 @@
 
 ;; decoder wireframe
 (define+provide/contract (decode nx
-                #:exclude-xexpr-tags [excluded-xexpr-tags '()]
+                                 #:exclude-xexpr-tags [excluded-xexpr-tags '()]
-                #:xexpr-tag-proc [xexpr-tag-proc (λ(x)x)]
+                                 #:xexpr-tag-proc [xexpr-tag-proc (λ(x)x)]
-                #:xexpr-attrs-proc [xexpr-attrs-proc (λ(x)x)]
+                                 #:xexpr-attrs-proc [xexpr-attrs-proc (λ(x)x)]
-                #:xexpr-elements-proc [xexpr-elements-proc (λ(x)x)]
+                                 #:xexpr-elements-proc [xexpr-elements-proc (λ(x)x)]
-                #:block-xexpr-proc [block-xexpr-proc (λ(x)x)]
+                                 #:block-xexpr-proc [block-xexpr-proc (λ(x)x)]
-                #:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)]
+                                 #:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)]
-                #:string-proc [string-proc (λ(x)x)])
+                                 #:string-proc [string-proc (λ(x)x)])
   ((xexpr/c) ;; use xexpr/c for contract on nx because it gives better error messages
-                   
+   
-                   ;; todo: how to write more specific contracts for these procedures?
+   ;; todo: how to write more specific contracts for these procedures?
-                   ;; e.g., string-proc should be restricted to procs that accept a string as input
+   ;; e.g., string-proc should be restricted to procs that accept a string as input
-                   ;; and return a string as output
+   ;; and return a string as output
-                   (#:exclude-xexpr-tags list?
+   (#:exclude-xexpr-tags list?
-                                         #:xexpr-tag-proc procedure?
+                         #:xexpr-tag-proc procedure?
-                                         #:xexpr-attrs-proc procedure?
+                         #:xexpr-attrs-proc procedure?
-                                         #:xexpr-elements-proc procedure?
+                         #:xexpr-elements-proc procedure?
-                                         #:block-xexpr-proc procedure?
+                         #:block-xexpr-proc procedure?
-                                         #:inline-xexpr-proc procedure?
+                         #:inline-xexpr-proc procedure?
-                                         #:string-proc procedure?)
+                         #:string-proc procedure?)
-                   . ->* . txexpr?)
+   . ->* . txexpr?)
   (when (not (txexpr? nx))
     (error (format "decode: ~v not a full txexpr" nx)))
   
@@ -47,13 +60,13 @@
   (define (&decode x)
     (cond
       [(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)]) 
-                           (if (tag . in? . excluded-xexpr-tags)    
+                     (if (tag . in? . excluded-xexpr-tags)    
-                               x ; let x pass through untouched
+                         x ; let x pass through untouched
-                               (let ([decoded-xexpr (apply make-txexpr 
+                         (let ([decoded-xexpr (apply make-txexpr 
-                                                           (map &decode (list tag attr elements)))])
+                                                     (map &decode (list tag attr elements)))])
-                                 ((if (block-xexpr? decoded-xexpr)
+                           ((if (block-xexpr? decoded-xexpr)
-                                      block-xexpr-proc
+                                block-xexpr-proc
-                                      inline-xexpr-proc) decoded-xexpr))))]
+                                inline-xexpr-proc) decoded-xexpr))))]
       [(txexpr-tag? x) (xexpr-tag-proc x)]
       [(txexpr-attrs? x) (xexpr-attrs-proc x)]
       ;; need this for operations that may depend on context in list
@@ -171,23 +184,23 @@
   (define two-or-more-char-string? (λ(i) (and (string? i) (>= (len i) 2))))
   (define-values (tag attr elements) (txexpr->values nx))
   (make-txexpr tag attr
-                     (if (and (list? elements) (not (empty? elements)))
+               (if (and (list? elements) (not (empty? elements)))
-                         (let ([new-car-elements  (match (car elements)
+                   (let ([new-car-elements  (match (car elements)
-                                                    [(? two-or-more-char-string? tcs)
+                                              [(? two-or-more-char-string? tcs)
-                                                     (define str-first (get tcs 0))
+                                               (define str-first (get tcs 0))
-                                                     (define str-rest (get tcs 1 'end))
+                                               (define str-rest (get tcs 1 'end))
-                                                     (cond
+                                               (cond
-                                                       [(str-first . in? . '("\"" "“"))
+                                                 [(str-first . in? . '("\"" "“"))
-                                                        ;; can wrap with any inline tag
+                                                  ;; can wrap with any inline tag
-                                                        ;; so that linebreak detection etc still works
+                                                  ;; so that linebreak detection etc still works
-                                                        `(,@double-pp ,(->string #\“) ,str-rest)]
+                                                  `(,@double-pp ,(->string #\“) ,str-rest)]
-                                                       [(str-first . in? . '("\'" "‘")) 
+                                                 [(str-first . in? . '("\'" "‘")) 
-                                                        `(,@single-pp ,(->string #\‘) ,str-rest)]
+                                                  `(,@single-pp ,(->string #\‘) ,str-rest)]
-                                                       [else tcs])]
+                                                 [else tcs])]
-                                                    [(? txexpr? nx) (wrap-hanging-quotes nx)]
+                                              [(? txexpr? nx) (wrap-hanging-quotes nx)]
-                                                    [else (car elements)])])
+                                              [else (car elements)])])
-                           (cons new-car-elements (cdr elements)))
+                     (cons new-car-elements (cdr elements)))
-                         elements)))
+                   elements)))
 
 
 

lang/lang-helper.rkt

@@ -5,6 +5,8 @@
 
 (provide (all-defined-out) (all-from-out racket/contract/region))
 
+     
+
 (define-for-syntax (put-file-in-require-form file)
   `(file ,(path->string file)))
 

main.rkt

@@ -43,8 +43,7 @@
                                                            (cons `(meta "here" ,inner-here) meta-elements)))))
    
    
-   
+     
-   
    ;; set up the 'main export
    (require pollen/decode)
    (require (only-in racket/list filter-not))
@@ -53,25 +52,25 @@
    ;(print (cdr main-without-metas))
    (define main (apply (cond
                          [(equal? here-ext "ptree") (λ xs (decode (cons 'ptree-root xs)
-                                                      #:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))))]
+                                                                  #:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))))]
                          ;; 'root is the hook for the decoder function.
                          ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
                          [wants-decoder? root]
-                         ;; for preprocessor output, just make a string. Converts x-expressions to HTML.
+                         ;; for preprocessor output, just make a string.
-                         [else (λ xs (apply string-append (map (dynamic-require 'xml 'xexpr->string) xs)))])
+                         [else (λ xs (apply string-append (map to-string xs)))])
-(cdr main-without-metas))) ;; cdr strips placeholder-root tag
+                       (cdr main-without-metas))) ;; cdr strips placeholder-root tag
-
+   
-
+   
-;; derive 'here & 'here-path from the hash (because they might have been overridden in the source) 
+   ;; derive 'here & 'here-path from the hash (because they might have been overridden in the source) 
-(define here (hash-ref metas "here"))
+   (define here (hash-ref metas "here"))
-(define here-path (hash-ref metas "here-path"))
+   (define here-path (hash-ref metas "here-path"))
-
+   
-(provide metas main here here-path
+   (provide metas main here here-path
-         ;; hide the exports that were only for internal use.
+            ;; hide the exports that were only for internal use.
-         (except-out (all-from-out 'inner) inner-here inner-here-path main-raw #%top))
+            (except-out (all-from-out 'inner) inner-here inner-here-path main-raw #%top))
-
+   
-;; for output in DrRacket
+   ;; for output in DrRacket
-(module+ main
+   (module+ main
-  (if wants-decoder? 
+     (if wants-decoder? 
-      (print main) 
+         (print main) 
-      (display main)))))
+         (display main)))))

render.rkt

@@ -233,10 +233,12 @@
                     (list
                      ;; path based on template-name
                      (and template-name (build-path source-dir template-name))
-                     ;; path based on metas
+                     ;; path based on metas. Need to parameterize a source file for it to find pollen-requires.
-                     (let ([source-metas (dynamic-require source-path 'metas)])
+                     ;; If you want standard behavior, requires can be declared explicitly.
-                       (and (TEMPLATE_META_KEY . in? . source-metas)
+                     (parameterize ([current-directory PROJECT_ROOT])
-                            (build-path source-dir (get source-metas TEMPLATE_META_KEY))))
+                       (let ([source-metas (dynamic-require source-path 'metas)])
+                         (and (TEMPLATE_META_KEY . in? . source-metas)
+                              (build-path source-dir (get source-metas TEMPLATE_META_KEY)))))
                      ;; path using default template name =
                      ;; "-main" + extension from output path (e.g. foo.xml.p -> -main.xml)
                      (build-path source-dir (add-ext DEFAULT_TEMPLATE_PREFIX (get-ext (->output-path source-path)))))))
@@ -277,15 +279,17 @@
 
 ;; cache some modules inside this namespace so they can be shared by namespace for eval
 ;; todo: macrofy this to avoid repeating names
-(require web-server/templates  
+(require web-server/templates 
+         xml/path
+         racket/port 
+         racket/file 
+         racket/rerequire 
+         racket/contract 
          racket/list
          xml/path
          pollen/debug
          pollen/decode
          pollen/file-tools
-         ;; commented out so we don't get #%top in this file
-         ;      pollen/main-imports
-         ;     pollen/main-preproc-imports
          pollen/predicates
          pollen/ptree
          sugar
@@ -315,15 +319,15 @@
                 pollen/debug
                 pollen/decode
                 pollen/file-tools
-                ;         pollen/main-imports
-                ;        pollen/main-preproc-imports
                 pollen/predicates
                 pollen/ptree
                 sugar
                 pollen/template
                 pollen/tools
-                pollen/world))
+                pollen/world
+                pollen/project-requires))
     (namespace-require 'racket/base) ; use namespace-require for FIRST require, then eval after
+    
     (eval eval-string (current-namespace))))
 
 (define/contract (render-source-with-template source-path template-path)
@@ -340,6 +344,8 @@
   
   (define string-to-eval 
     `(begin 
+       ;; enables macrofication
+       (require (for-syntax racket/base))
        ;; for include-template (used below)
        (require web-server/templates)
        ;; for ptree navigation functions, and template commands