diff --git a/decode.rkt b/decode.rkt index 0b7b190..c2ef829 100644 --- a/decode.rkt +++ b/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 '()] - #:xexpr-tag-proc [xexpr-tag-proc (λ(x)x)] - #:xexpr-attrs-proc [xexpr-attrs-proc (λ(x)x)] - #:xexpr-elements-proc [xexpr-elements-proc (λ(x)x)] - #:block-xexpr-proc [block-xexpr-proc (λ(x)x)] - #:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)] - #:string-proc [string-proc (λ(x)x)]) + #:exclude-xexpr-tags [excluded-xexpr-tags '()] + #:xexpr-tag-proc [xexpr-tag-proc (λ(x)x)] + #:xexpr-attrs-proc [xexpr-attrs-proc (λ(x)x)] + #:xexpr-elements-proc [xexpr-elements-proc (λ(x)x)] + #:block-xexpr-proc [block-xexpr-proc (λ(x)x)] + #:inline-xexpr-proc [inline-xexpr-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? - ;; e.g., string-proc should be restricted to procs that accept a string as input - ;; and return a string as output - (#:exclude-xexpr-tags list? - #:xexpr-tag-proc procedure? - #:xexpr-attrs-proc procedure? - #:xexpr-elements-proc procedure? - #:block-xexpr-proc procedure? - #:inline-xexpr-proc procedure? - #:string-proc procedure?) - . ->* . txexpr?) + + ;; 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 + ;; and return a string as output + (#:exclude-xexpr-tags list? + #:xexpr-tag-proc procedure? + #:xexpr-attrs-proc procedure? + #:xexpr-elements-proc procedure? + #:block-xexpr-proc procedure? + #:inline-xexpr-proc procedure? + #:string-proc procedure?) + . ->* . 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) - x ; let x pass through untouched - (let ([decoded-xexpr (apply make-txexpr - (map &decode (list tag attr elements)))]) - ((if (block-xexpr? decoded-xexpr) - block-xexpr-proc - inline-xexpr-proc) decoded-xexpr))))] + (if (tag . in? . excluded-xexpr-tags) + x ; let x pass through untouched + (let ([decoded-xexpr (apply make-txexpr + (map &decode (list tag attr elements)))]) + ((if (block-xexpr? decoded-xexpr) + block-xexpr-proc + 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))) - (let ([new-car-elements (match (car elements) - [(? two-or-more-char-string? tcs) - (define str-first (get tcs 0)) - (define str-rest (get tcs 1 'end)) - (cond - [(str-first . in? . '("\"" "“")) - ;; can wrap with any inline tag - ;; so that linebreak detection etc still works - `(,@double-pp ,(->string #\“) ,str-rest)] - [(str-first . in? . '("\'" "‘")) - `(,@single-pp ,(->string #\‘) ,str-rest)] - [else tcs])] - [(? txexpr? nx) (wrap-hanging-quotes nx)] - [else (car elements)])]) - (cons new-car-elements (cdr elements))) - elements))) + (if (and (list? elements) (not (empty? elements))) + (let ([new-car-elements (match (car elements) + [(? two-or-more-char-string? tcs) + (define str-first (get tcs 0)) + (define str-rest (get tcs 1 'end)) + (cond + [(str-first . in? . '("\"" "“")) + ;; can wrap with any inline tag + ;; so that linebreak detection etc still works + `(,@double-pp ,(->string #\“) ,str-rest)] + [(str-first . in? . '("\'" "‘")) + `(,@single-pp ,(->string #\‘) ,str-rest)] + [else tcs])] + [(? txexpr? nx) (wrap-hanging-quotes nx)] + [else (car elements)])]) + (cons new-car-elements (cdr elements))) + elements))) diff --git a/lang/lang-helper.rkt b/lang/lang-helper.rkt index e846296..820f943 100644 --- a/lang/lang-helper.rkt +++ b/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))) diff --git a/main.rkt b/main.rkt index 8e7839c..dedb943 100644 --- a/main.rkt +++ b/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. - [else (λ xs (apply string-append (map (dynamic-require 'xml 'xexpr->string) xs)))]) -(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) -(define here (hash-ref metas "here")) -(define here-path (hash-ref metas "here-path")) - -(provide metas main here here-path - ;; hide the exports that were only for internal use. - (except-out (all-from-out 'inner) inner-here inner-here-path main-raw #%top)) - -;; for output in DrRacket -(module+ main - (if wants-decoder? - (print main) - (display main))))) + ;; for preprocessor output, just make a string. + [else (λ xs (apply string-append (map to-string xs)))]) + (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) + (define here (hash-ref metas "here")) + (define here-path (hash-ref metas "here-path")) + + (provide metas main here here-path + ;; hide the exports that were only for internal use. + (except-out (all-from-out 'inner) inner-here inner-here-path main-raw #%top)) + + ;; for output in DrRacket + (module+ main + (if wants-decoder? + (print main) + (display main))))) diff --git a/render.rkt b/render.rkt index c685bb0..2f5cd69 100644 --- a/render.rkt +++ b/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 - (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 based on metas. Need to parameterize a source file for it to find pollen-requires. + ;; If you want standard behavior, requires can be declared explicitly. + (parameterize ([current-directory PROJECT_ROOT]) + (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