From 7caab48bba4852399423bfe8607d71c828cfcc6e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 13 Oct 2013 18:21:16 -0700 Subject: [PATCH] updates --- command.rkt | 14 +-- pollen-file-tools.rkt => file-tools.rkt | 128 ++++++++++++----------- lang/reader.rkt | 2 +- main.rkt | 3 +- predicates.rkt | 4 +- ptree.rkt | 6 +- regenerate.rkt => render.rkt | 129 +++++++++++------------- server-routes.rkt | 34 +++---- server.rkt | 6 +- start.rkt => startup.rkt | 0 template.rkt | 6 +- tools.rkt | 2 +- world.rkt | 2 +- 13 files changed, 161 insertions(+), 175 deletions(-) rename pollen-file-tools.rkt => file-tools.rkt (65%) rename regenerate.rkt => render.rkt (74%) rename start.rkt => startup.rkt (100%) diff --git a/command.rkt b/command.rkt index bb4a56d..b47d620 100644 --- a/command.rkt +++ b/command.rkt @@ -10,11 +10,11 @@ [arg (if (> (len args) 0) (get args 0) "")]) (case arg [("start") `(require "server.rkt")] - [("regenerate") `(begin + [("render") `(begin ;; todo: take extensions off the comand line - (displayln "Regenerate preproc & ptree files ...") - (require "regenerate.rkt" "pollen-file-tools.rkt" "world.rkt") - (apply regenerate-with-session (append-map project-files-with-ext (list POLLEN_PREPROC_EXT POLLEN_TREE_EXT))))] + (displayln "Render preproc & ptree files ...") + (require "render.rkt" "file-tools.rkt" "world.rkt") + (apply render-with-session (append-map project-files-with-ext (list POLLEN_PREPROC_EXT POLLEN_TREE_EXT))))] [("clone") (let ([target-path (if (> (len args) 1) (->path (get args 1)) @@ -49,12 +49,12 @@ (displayln (format "Completed to ~a" ,target-path)) )))] [("") `(displayln "No command given")] - ;; treat other input as a possible file name for regeneration + ;; treat other input as a possible file name for rendering [else (let ([possible-file (->path arg)]) (if (file-exists? possible-file) `(begin - (require (planet mb/pollen/regenerate)) - (regenerate ,possible-file)) + (require (planet mb/pollen/render)) + (render ,possible-file)) `(displayln (format "No command defined for ~a" ,arg))))])))) (handle-pollen-command) diff --git a/pollen-file-tools.rkt b/file-tools.rkt similarity index 65% rename from pollen-file-tools.rkt rename to file-tools.rkt index 35876f6..e7b8e81 100644 --- a/pollen-file-tools.rkt +++ b/file-tools.rkt @@ -9,12 +9,21 @@ ; helper functions for regenerate functions -(define pollen-file-root (current-directory)) +(define pollen-project-directory (current-directory)) + +;; this is for regenerate module. +;; when we want to be friendly with inputs for functions that require a path. +;; Strings & symbols often result from xexpr parsing +;; and are trivially converted to paths. +;; so let's say close enough. +(define/contract (pathish? x) + (any/c . -> . boolean?) + (->boolean (or path? string? symbol?))) ;; does path have a certain extension -(define/contract (has-ext? path ext) - (path? symbol? . -> . boolean?) - (define ext-of-path (filename-extension path)) +(define/contract (has-ext? x ext) + (pathish? stringish? . -> . boolean?) + (define ext-of-path (filename-extension (->path x))) (and ext-of-path (equal? (bytes->string/utf-8 ext-of-path) (->string ext)))) (module+ test @@ -23,20 +32,20 @@ (apply values (map string->path foo-path-strings))) ;; test the sample paths before using them for other tests (define foo-paths (list foo-path foo.txt-path foo.bar-path foo.bar.txt-path)) - (for-each check-equal? (map path->string foo-paths) foo-path-strings)) + (for-each check-equal? (map ->string foo-paths) foo-path-strings)) (module+ test (check-false (has-ext? foo-path 'txt)) - (check-true (has-ext? foo.txt-path 'txt)) + (check-true (foo.txt-path . has-ext? . 'txt)) (check-true (has-ext? foo.bar.txt-path 'txt)) - (check-false (has-ext? foo.bar.txt-path 'doc))) ; wrong extension + (check-false (foo.bar.txt-path . has-ext? . 'doc))) ; wrong extension ;; get file extension as a string -(define/contract (get-ext path) - (path? . -> . string?) - (bytes->string/utf-8 (filename-extension path))) +(define/contract (get-ext x) + (pathish? . -> . string?) + (bytes->string/utf-8 (filename-extension (->path x)))) (module+ test (check-equal? (get-ext (->path "foo.txt")) "txt") @@ -46,17 +55,17 @@ ;; put extension on path -(define/contract (add-ext path ext) - (path? (or/c symbol? string?) . -> . path?) - (string->path (string-append (->string path) "." (->string ext)))) +(define/contract (add-ext x ext) + (pathish? stringish? . -> . path?) + (->path (string-append (->string x) "." (->string ext)))) (module+ test (check-equal? (add-ext (string->path "foo") "txt") (string->path "foo.txt"))) ;; take one extension off path -(define/contract (remove-ext path) - (path? . -> . path?) - (path-replace-suffix path "")) +(define/contract (remove-ext x) + (pathish? . -> . path?) + (path-replace-suffix (->path x) "")) (module+ test (check-equal? (remove-ext foo-path) foo-path) @@ -66,8 +75,9 @@ ;; take all extensions off path -(define/contract (remove-all-ext path) - (path? . -> . path?) +(define/contract (remove-all-ext x) + (pathish? . -> . path?) + (define path (->path x)) (define path-with-removed-ext (remove-ext path)) (if (equal? path path-with-removed-ext) path @@ -79,16 +89,6 @@ (check-not-equal? (remove-all-ext foo.bar.txt-path) foo.bar-path) ; removes more than one ext (check-equal? (remove-all-ext foo.bar.txt-path) foo-path)) -;; superfluous: use file-name-from-path in racket/path - -#|(define/contract (filename-of path) - (complete-path? . -> . path?) - (define-values (dir filename ignored) (split-path path)) - filename) - -(module+ test - (check-equal? (filename-of (build-path (current-directory) "pollen-file-tools.rkt")) (->path "pollen-file-tools.rkt")))|# - ;; todo: tests for these predicates @@ -102,11 +102,11 @@ (define/contract (has-preproc-source? x) (any/c . -> . boolean?) - (file-exists? (make-preproc-source-path (->path x)))) + (file-exists? (->preproc-source-path (->path x)))) (define/contract (has-pollen-source? x) (any/c . -> . boolean?) - (file-exists? (make-pollen-source-path (->path x)))) + (file-exists? (->pollen-source-path (->path x)))) (define/contract (needs-preproc? x) (any/c . -> . boolean?) @@ -121,7 +121,7 @@ (define/contract (ptree-source? x) (any/c . -> . boolean?) - (has-ext? (->path x) POLLEN_TREE_EXT)) + (has-ext? x POLLEN_TREE_EXT)) (module+ test (check-true (ptree-source? "foo.ptree")) @@ -130,7 +130,7 @@ (define/contract (pollen-source? x) (any/c . -> . boolean?) - (has-ext? (->path x) POLLEN_SOURCE_EXT)) + (has-ext? x POLLEN_SOURCE_EXT)) (module+ test (check-true (pollen-source? "foo.p")) @@ -152,7 +152,7 @@ ;; todo: extend this beyond just racket files? (define/contract (project-require-file? x) (any/c . -> . boolean?) - (has-ext? (->path x) 'rkt)) + (has-ext? x 'rkt)) (module+ test (check-true (project-require-file? "foo.rkt")) @@ -160,55 +160,53 @@ -;; this is for regenerate module. -;; when we want to be friendly with inputs for functions that require a path. -;; Strings & symbols often result from xexpr parsing -;; and are trivially converted to paths. -;; so let's say close enough. -(define/contract (pathish? x) - (any/c . -> . boolean?) - (->boolean (or path? string? symbol?))) - - ;; todo: tighten these input contracts ;; so that, say, a source-path cannot be input for make-preproc-source-path -(define/contract (make-preproc-source-path path) - (path? . -> . path?) - (add-ext path POLLEN_PREPROC_EXT)) +(define/contract (->preproc-source-path x) + (pathish? . -> . path?) + (->path (if (preproc-source? x) + x + (add-ext x POLLEN_PREPROC_EXT)))) -(define/contract (make-preproc-output-path path) - (path? . -> . path?) - (remove-ext path)) +(module+ test + (check-equal? (->preproc-source-path (->path "foo.pp")) (->path "foo.pp")) + (check-equal? (->preproc-source-path (->path "foo.html")) (->path "foo.html.pp")) + (check-equal? (->preproc-source-path "foo") (->path "foo.pp")) + (check-equal? (->preproc-source-path 'foo) (->path "foo.pp"))) -(define/contract (make-pollen-output-path thing) +(define/contract (->output-path x) (pathish? . -> . path?) - (remove-ext (->path thing))) + (->path + (if (or (pollen-source? x) (preproc-source? x)) + (remove-ext x) + x))) (module+ test - (check-equal? (make-pollen-output-path (->path "foo.html.p")) (->path "foo.html")) - (check-equal? (make-pollen-output-path (->path "/Users/mb/git/foo.html.p")) (->path "/Users/mb/git/foo.html")) - (check-equal? (make-pollen-output-path "foo.xml.p") (->path "foo.xml")) - (check-equal? (make-pollen-output-path 'foo.barml.p) (->path "foo.barml"))) + (check-equal? (->output-path (->path "foo.ptree")) (->path "foo.ptree")) + (check-equal? (->output-path "foo.html") (->path "foo.html")) + (check-equal? (->output-path 'foo.html.p) (->path "foo.html")) + (check-equal? (->output-path (->path "/Users/mb/git/foo.html.p")) (->path "/Users/mb/git/foo.html")) + (check-equal? (->output-path "foo.xml.p") (->path "foo.xml")) + (check-equal? (->output-path 'foo.barml.p) (->path "foo.barml"))) ;; turns input into corresponding pollen source path ;; does not, however, validate that new path exists ;; todo: should it? I don't think so, sometimes handy to make the name for later use ;; OK to use pollen source as input (comes out the same way) -(define/contract (make-pollen-source-path thing) +(define/contract (->pollen-source-path x) (pathish? . -> . path?) - (define path (->path thing)) - (if (pollen-source? path) - path - (add-ext path POLLEN_SOURCE_EXT))) + (->path (if (pollen-source? x) + x + (add-ext x POLLEN_SOURCE_EXT)))) (module+ test - (check-equal? (make-pollen-source-path (->path "foo.p")) (->path "foo.p")) - (check-equal? (make-pollen-source-path (->path "foo.html")) (->path "foo.html.p")) - (check-equal? (make-pollen-source-path "foo") (->path "foo.p")) - (check-equal? (make-pollen-source-path 'foo) (->path "foo.p"))) + (check-equal? (->pollen-source-path (->path "foo.p")) (->path "foo.p")) + (check-equal? (->pollen-source-path (->path "foo.html")) (->path "foo.html.p")) + (check-equal? (->pollen-source-path "foo") (->path "foo.p")) + (check-equal? (->pollen-source-path 'foo) (->path "foo.p"))) (define/contract (project-files-with-ext ext) (symbol? . -> . (listof complete-path?)) - (map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list pollen-file-root)))) + (map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list pollen-project-directory)))) ;; todo: write tests for project-files-with-ext diff --git a/lang/reader.rkt b/lang/reader.rkt index 914cb31..f90a72a 100644 --- a/lang/reader.rkt +++ b/lang/reader.rkt @@ -1,7 +1,7 @@ #lang racket/base (require (only-in scribble/reader make-at-reader) (only-in "../world.rkt" POLLEN_EXPRESSION_DELIMITER) - (only-in "../pollen-file-tools.rkt" preproc-source?)) + (only-in "../file-tools.rkt" preproc-source?)) (provide (rename-out [mb-read read] [mb-read-syntax read-syntax]) diff --git a/main.rkt b/main.rkt index e98a5a3..05affc1 100644 --- a/main.rkt +++ b/main.rkt @@ -3,7 +3,7 @@ (require (planet mb/pollen/tools) (planet mb/pollen/main-helper)) (require (only-in (planet mb/pollen/ptree-decode) ptree-source-decode)) (require (only-in (planet mb/pollen/predicates) ptree?)) -(require (only-in (planet mb/pollen/pollen-file-tools) has-ext?)) +(require (only-in (planet mb/pollen/file-tools) has-ext?)) (require (only-in (planet mb/pollen/world) POLLEN_TREE_EXT)) (provide (except-out (all-from-out racket/base) #%module-begin) (rename-out [module-begin #%module-begin])) @@ -40,6 +40,7 @@ ;; but it makes debugging tricky, because an undefined (symbol item ...) ;; is just treated as a valid tagged-xexpr, not an undefined function. (define-syntax-rule (#%top . id) + ;; todo: can #%top emit a debug message when a function hits it? (λ x `(id ,@x))) expr ... ; body of module diff --git a/predicates.rkt b/predicates.rkt index 9ed1499..af29e58 100644 --- a/predicates.rkt +++ b/predicates.rkt @@ -1,13 +1,13 @@ #lang racket/base (require racket/contract racket/match racket/list xml racket/set) (require (prefix-in html: "library/html.rkt")) -(require "world.rkt" "readability.rkt" "pollen-file-tools.rkt") +(require "world.rkt" "readability.rkt" "file-tools.rkt") (module+ test (require rackunit)) (provide (all-defined-out) - (all-from-out "pollen-file-tools.rkt")) + (all-from-out "file-tools.rkt")) ;; add a block tag to the list diff --git a/ptree.rkt b/ptree.rkt index 201ff04..997fa89 100644 --- a/ptree.rkt +++ b/ptree.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require xml xml/path racket/list racket/string racket/contract racket/match racket/set) +(require xml xml/path racket/list racket/string racket/contract racket/match racket/set racket/path) (require "tools.rkt" "world.rkt" "ptree-decode.rkt" "debug.rkt") (module+ test (require rackunit)) @@ -19,7 +19,7 @@ ;; Load it from default path. ;; dynamic require of a ptree source file gets you a full ptree. (begin - (message "Loading ptree file" (->string ptree-source)) + (message "Using ptree file" (->string (file-name-from-path ptree-source))) (dynamic-require ptree-source POLLEN_ROOT)) ;; ... or else synthesize it (let* ([files (directory-list START_DIR)] @@ -238,7 +238,7 @@ (define file-matches (filter source-matches-pnode? files)) (if ((length file-matches) . > . 1) (error "Duplicate source files for pnode" pnode) - (->string (make-pollen-output-path (car file-matches))))) + (->string (->output-path (car file-matches))))) ;; todo: make tests diff --git a/regenerate.rkt b/render.rkt similarity index 74% rename from regenerate.rkt rename to render.rkt index ae03be2..17247d5 100644 --- a/regenerate.rkt +++ b/render.rkt @@ -1,11 +1,11 @@ #lang racket/base (require racket/list racket/path racket/port racket/system racket/file racket/rerequire racket/contract racket/bool) -(require "world.rkt" "tools.rkt" "ptree.rkt" "readability.rkt" "template.rkt") +(require "world.rkt" "tools.rkt" "readability.rkt" "template.rkt") (module+ test (require rackunit)) -(provide regenerate regenerate-with-session) +(provide render render-with-session) ;; mod-dates is a hash that takes lists of paths as keys, ;; and lists of modification times as values. @@ -31,7 +31,7 @@ (module+ test (check-false (path->mod-date-value (->path "foobarfoo.rkt"))) - (check-true (exact-integer? (path->mod-date-value (build-path (current-directory) (->path "regenerate.rkt")))))) + (check-true (exact-integer? (path->mod-date-value (build-path (current-directory) (->path "render.rkt")))))) ;; put list of paths into mod-dates ;; need list as input (rather than individual path) @@ -53,20 +53,20 @@ (module+ test (reset-mod-dates) - (store-refresh-in-mod-dates (build-path (current-directory) (->path "regenerate.rkt"))) + (store-refresh-in-mod-dates (build-path (current-directory) (->path "render.rkt"))) (check-true (= (len mod-dates) 1)) (reset-mod-dates)) ;; when you want to generate everything fresh, ;; but without having to #:force everything. -;; Regenerate functions will always go when no mod-date is found. +;; render functions will always go when no mod-date is found. (define/contract (reset-mod-dates) (-> void?) (set! mod-dates (make-hash))) (module+ test (reset-mod-dates) - (store-refresh-in-mod-dates (build-path (current-directory) (->path "regenerate.rkt"))) + (store-refresh-in-mod-dates (build-path (current-directory) (->path "render.rkt"))) (reset-mod-dates) (check-true (= (len mod-dates) 0))) @@ -80,7 +80,7 @@ (module+ test (reset-mod-dates) - (let ([path (build-path (current-directory) (->path "regenerate.rkt"))]) + (let ([path (build-path (current-directory) (->path "render.rkt"))]) (store-refresh-in-mod-dates path) (check-false (mod-date-expired? path)) (reset-mod-dates) @@ -88,80 +88,65 @@ ;; convenience function for external modules to use -(define/contract (regenerate-with-session . xs) +(define/contract (render-with-session . xs) (() #:rest (listof pathish?) . ->* . void?) - ;; This will trigger regeneration of all files. - ;; Why not pass #:force #t through with regenerate? + ;; This will trigger rendering of all files. + ;; Why not pass #:force #t through with render? ;; Because certain files will pass through multiple times (e.g., templates) - ;; And with #:force, they would be regenerated repeatedly. + ;; And with #:force, they would be rendered repeatedly. ;; Using reset-mod-dates is sort of like session control: ;; setting a state that persists through the whole operation. (reset-mod-dates) - (for-each regenerate xs)) + (for-each render xs)) -;; dispatches path to the right regeneration function +;; dispatches path to the right rendering function ;; use #:force to refresh regardless of cached state -(define/contract (regenerate #:force [force #f] . xs) +(define/contract (render #:force [force #f] . xs) (() (#:force boolean?) #:rest (listof pathish?) . ->* . void?) - (define (®enerate x) + (define (&render x) (let ([path (->complete-path (->path x))]) - ; (message "Regenerating" (->string path)) (cond - ;; this will catch pp (preprocessor) files - [(needs-preproc? path) (regenerate-with-preproc path #:force force)] - ;; this will catch p files, + ;; this will catch preprocessor files + [(needs-preproc? path) (render-with-preproc path #:force force)] + ;; this will catch pollen source files, ;; and files without extension that correspond to p files - [(needs-template? path) (regenerate-with-template path #:force force)] + [(needs-template? path) (render-with-template path #:force force)] ;; this will catch ptree files [(ptree-source? path) (let ([ptree (dynamic-require path 'main)]) - (regenerate-with-ptree ptree #:force force))] + (render-ptree-files ptree #:force force))] [(equal? FALLBACK_TEMPLATE_NAME (->string (file-name-from-path path))) - (message "Regenerate: using fallback template")] + (message "Render: using fallback template")] [(file-exists? path) 'pass-through] - [else (error "Regenerate couldn't find" (->string (file-name-from-path path)))]))) - (for-each ®enerate xs)) + [else (error "Render couldn't find" (->string (file-name-from-path path)))]))) + (for-each &render xs)) ;; todo: write tests -(define/contract (regenerating-message path) +(define/contract (rendering-message path) (any/c . -> . void?) ;; you can actually stuff whatever string you want into path — ;; if it's not really a path, file-name-from-path won't choke - (message "Regenerating:" (->string (file-name-from-path path)))) + (message "Rendering" (->string (file-name-from-path path)))) -(define/contract (regenerated-message path) +(define/contract (rendered-message path) (any/c . -> . void?) - (message "Regenerated:" (->string (file-name-from-path path)))) + (message "Rendered" (->string (file-name-from-path path)))) - -(define/contract (complete-preproc-source-path x) - (pathish? . -> . complete-path?) - (let ([path (->path x)]) - (->complete-path (if (preproc-source? path) - path - (make-preproc-source-path path))))) - -;; todo: tests - -(define/contract (complete-preproc-output-path x) - (pathish? . -> . complete-path?) - (let ([path (->path x)]) - (->complete-path (if (preproc-source? path) - (make-preproc-output-path path) - path)))) -;; todo: tests +(define/contract (up-to-date-message path) + (any/c . -> . void?) + (message "File is up to date:" (->string (file-name-from-path path)))) -(define/contract (regenerate-with-preproc x #:force [force #f]) +(define/contract (render-with-preproc x #:force [force #f]) (((and/c pathish? (flat-named-contract 'file-exists - (λ(x) (file-exists? (complete-preproc-source-path x)))))) (#:force boolean?) . ->* . void?) + (λ(x) (file-exists? (->complete-path (->preproc-source-path x))))))) (#:force boolean?) . ->* . void?) ;; x might be either a preproc-source path or preproc-output path - (define source-path (complete-preproc-source-path x)) + (define source-path (->complete-path (->preproc-source-path x))) (define-values (source-dir source-name _) (split-path source-path)) - (define output-path (complete-preproc-output-path x)) + (define output-path (->complete-path (->output-path x))) ;; Three conditions under which we refresh: (if (or @@ -175,7 +160,7 @@ (mod-date-expired? source-path)) ;; use single quotes to escape spaces in pathnames (let ([command (format "~a '~a' > '~a'" RACKET_PATH source-path output-path)]) - (regenerating-message (format "~a from ~a" + (rendering-message (format "~a from ~a" (file-name-from-path output-path) (file-name-from-path source-path))) (store-refresh-in-mod-dates source-path) @@ -183,14 +168,14 @@ (parameterize ([current-directory source-dir] [current-output-port (open-output-nowhere)]) (system command)) - (regenerated-message output-path)) + (rendered-message output-path)) ;; otherwise, skip file because there's no trigger for refresh - (message "File is up to date:" (->string (file-name-from-path output-path))))) + (up-to-date-message output-path))) ;; todo: write tests -;; utility function for regenerate-with-template +;; utility function for render-with-template (define/contract (handle-source-rerequire source-path) ((and/c path? file-exists?) . -> . boolean?) @@ -219,10 +204,10 @@ (->boolean (> (len (get-output-string port-for-catching-file-info)) 0))) (define (complete-pollen-source-path x) - (->complete-path (make-pollen-source-path (->path x)))) + (->complete-path (->pollen-source-path (->path x)))) ;; apply template -(define/contract (regenerate-with-template x [template-name #f] #:force [force #f]) +(define/contract (render-with-template x [template-name #f] #:force [force #f]) (((and/c pathish? (flat-named-contract 'file-exists (λ(x) (file-exists? (complete-pollen-source-path x)))))) @@ -237,13 +222,13 @@ (define source-reloaded? (handle-source-rerequire source-path)) ;; Then the rest: - ;; set the template, regenerate the source file with template, and catch the output. + ;; set the template, render the source file with template, and catch the output. ;; 1) Set the template. (define template-path (or ;; Build the possible paths and use the first one ;; that either exists, or has a preproc source that exists. - (ormap (λ(p) (if (ormap file-exists? (list p (make-preproc-source-path p))) p #f)) + (ormap (λ(p) (if (ormap file-exists? (list p (->preproc-source-path p))) p #f)) (filter-not false? (list ;; path based on template-name @@ -253,22 +238,23 @@ (and (TEMPLATE_META_KEY . in? . source-metas) (build-path source-dir (get source-metas TEMPLATE_META_KEY)))) - ;; path using default template name - (build-path source-dir DEFAULT_TEMPLATE)))) + ;; 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))))))) ;; if none of these work, make temporary template file (let ([tp (build-path source-dir FALLBACK_TEMPLATE_NAME)]) (display-to-file #:exists 'replace fallback-template-data tp) tp))) ;; refresh template (it might have its own preprocessor file) - (regenerate template-path #:force force) + (render template-path #:force force) ;; calculate new path for generated file - (define output-path (make-pollen-output-path source-path)) + (define output-path (->output-path source-path)) - ;; 2) Regenerate the source file with template, if needed. - ;; Regenerate is expensive, so we avoid it when we can. - ;; Four conditions where we regenerate: + ;; 2) render the source file with template, if needed. + ;; render is expensive, so we avoid it when we can. + ;; Four conditions where we render: (if (or force ; a) it's explicitly demanded (not (file-exists? output-path)) ; b) output file does not exist ;; c) mod-dates indicates refresh is needed @@ -277,12 +263,11 @@ source-reloaded?) (begin (store-refresh-in-mod-dates source-path template-path) - (message "Rendering source" (->string source-path) - "with template" (->string template-path)) + (message "Rendering source" (->string (file-name-from-path source-path)) "with template" (->string (file-name-from-path template-path))) (let ([page-result (render-source-with-template source-path template-path)]) (display-to-file #:exists 'replace page-result output-path) - (regenerated-message (file-name-from-path output-path)))) - (message "Regenerate with template: file is up to date:" (->string (file-name-from-path output-path)))) + (rendered-message output-path))) + (up-to-date-message output-path)) ;; delete fallback template if needed (let ([tp (build-path source-dir FALLBACK_TEMPLATE_NAME)]) @@ -316,11 +301,13 @@ (eval `(require ,(path->string source-name)) (current-namespace)) (eval `(include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name)) (current-namespace)))) -;; regenerate files listed in a ptree file -(define/contract (regenerate-with-ptree ptree #:force [force #f]) +;; render files listed in a ptree file +(define/contract (render-ptree-files ptree #:force [force #f]) ((ptree?) (#:force boolean?) . ->* . void?) ;; pass force parameter through - (for-each (λ(i) (regenerate i #:force force)) (all-pages ptree))) + (for-each (λ(i) (render i #:force force)) + ;; use dynamic-require to avoid requiring ptree.rkt every time render.rkt is required + ((dynamic-require "ptree.rkt" 'all-pages) ptree))) diff --git a/server-routes.rkt b/server-routes.rkt index 2cd241a..bc021aa 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -2,7 +2,7 @@ (require racket/list racket/contract racket/rerequire racket/file racket/format xml) (require (only-in net/url url-query url->path url->string)) (require (only-in web-server/http/request-structs request-uri request-client-ip)) -(require "world.rkt" "regenerate.rkt" "readability.rkt" "predicates.rkt" "debug.rkt") +(require "world.rkt" "render.rkt" "readability.rkt" "predicates.rkt" "debug.rkt") (module+ test (require rackunit)) @@ -13,24 +13,24 @@ (provide (all-defined-out)) ;; extract main xexpr from a path -(define/contract (file->xexpr path #:regen [regen #t]) - ((complete-path?) (#:regen boolean?) . ->* . tagged-xexpr?) - (when regen (regenerate path)) ; refresh path +(define/contract (file->xexpr path #:render [wants-render #t]) + ((complete-path?) (#:render boolean?) . ->* . tagged-xexpr?) + (when wants-render (render path)) (dynamic-rerequire path) ; stores module mod date; reloads if it's changed (dynamic-require path 'main)) (module+ test - (check-equal? (file->xexpr (build-path (current-directory) "tests/server-routes/foo.p") #:regen #f) '(root "\n" "foo"))) + (check-equal? (file->xexpr (build-path (current-directory) "tests/server-routes/foo.p") #:render #f) '(root "\n" "foo"))) ;; read contents of file to string -;; just file->string with a regenerate option -(define/contract (slurp path #:regen [regen #t]) - ((complete-path?) (#:regen boolean?) . ->* . string?) - (when regen (regenerate path)) +;; just file->string with a render option +(define/contract (slurp path #:render [wants-render #t]) + ((complete-path?) (#:render boolean?) . ->* . string?) + (when wants-render (render path)) (file->string path)) (module+ test - (check-equal? (slurp (build-path (current-directory) "tests/server-routes/bar.html") #:regen #f) "

bar

")) + (check-equal? (slurp (build-path (current-directory) "tests/server-routes/bar.html") #:render #f) "

bar

")) ;; add a wrapper to tagged-xexpr that displays it as monospaced text @@ -56,7 +56,7 @@ ;; for viewing source without using "view source" (define/contract (route-raw-html path) (complete-path? . -> . xexpr?) - (format-as-code (slurp path #:regen #f))) + (format-as-code (slurp path #:render #f))) ;; todo: consolidate with function above, they're the same. ;; server route that shows contents of file on disk @@ -80,14 +80,14 @@ ;; get lists of files by mapping a filter function for each file type (define-values (pollen-files preproc-files ptree-files template-files) - (let ([all-files-in-project-directory (directory-list pollen-file-root)]) + (let ([all-files-in-project-directory (directory-list pollen-project-directory)]) (apply values (map (λ(test) (filter test all-files-in-project-directory)) (list pollen-source? preproc-source? ptree-source? template-source?))))) ;; The actual post-preproc files may not have been generated yet ;; so calculate their names (rather than rely on directory list) - (define post-preproc-files (map make-preproc-output-path preproc-files)) + (define post-preproc-files (map ->output-path preproc-files)) ;; Make a combined list of preproc files and post-preproc file, in alphabetical order (define all-preproc-files (sort (append preproc-files post-preproc-files) @@ -98,7 +98,7 @@ ;; not necessarily true (it will assume the extension of its template.) ;; But pulling out all the template extensions requires parsing all the files, ;; which is slow and superfluous, since we're trying to be lazy about rendering. - (define post-pollen-files (map make-pollen-output-path pollen-files)) + (define post-pollen-files (map ->output-path pollen-files)) ;; Make a combined list of pollen files and post-pollen files, in alphabetical order (define all-pollen-files (sort (append pollen-files post-pollen-files) #:key path->string stringpath request-url) pollen-file-root)) + (define path (reroot-path (url->path request-url) pollen-project-directory)) (define force (equal? (get-query-value request-url 'force) "true")) - (with-handlers ([exn:fail? (λ(e) (message "Regenerate is skipping" (url->string request-url) "because of error\n" (exn-message e)))]) - (regenerate path #:force force))) \ No newline at end of file + (with-handlers ([exn:fail? (λ(e) (message "Render is skipping" (url->string request-url) "because of error\n" (exn-message e)))]) + (render path #:force force))) \ No newline at end of file diff --git a/server.rkt b/server.rkt index 339ceaa..7efada8 100755 --- a/server.rkt +++ b/server.rkt @@ -1,5 +1,5 @@ #lang web-server -(require "start.rkt") +(require "startup.rkt") (require web-server/servlet-env) (require web-server/dispatch web-server/dispatchers/dispatch) (require xml) @@ -18,7 +18,7 @@ (λ(req string-arg) (logger req) (define filename string-arg) - (response/xexpr (route-proc (build-path pollen-file-root filename))))) + (response/xexpr (route-proc (build-path pollen-project-directory filename))))) (define-values (start url) (dispatch-rules @@ -42,4 +42,4 @@ #:listen-ip #f #:servlet-regexp #rx"" ; respond to top level #:command-line? #t - #:extra-files-paths (list (build-path pollen-file-root))) \ No newline at end of file + #:extra-files-paths (list (build-path pollen-project-directory))) \ No newline at end of file diff --git a/start.rkt b/startup.rkt similarity index 100% rename from start.rkt rename to startup.rkt diff --git a/template.rkt b/template.rkt index 11f7fb3..32cd1e0 100644 --- a/template.rkt +++ b/template.rkt @@ -26,7 +26,7 @@ (cond ;; Using put has no effect on tagged-xexprs. It's here to make the idiom smooth. [(tagged-xexpr? x) x] - [(has-pollen-source? x) (dynamic-require (make-pollen-source-path x) 'main)])) + [(has-pollen-source? x) (dynamic-require (->pollen-source-path x) 'main)])) (module+ test (check-equal? (put '(foo "bar")) '(foo "bar")) @@ -48,14 +48,14 @@ (define/contract (find-in-metas px key) (puttable-item? query-key? . -> . (or/c xexpr-elements? false?)) (and (has-pollen-source? px) - (let ([metas (dynamic-require (make-pollen-source-path px) 'metas)] + (let ([metas (dynamic-require (->pollen-source-path px) 'metas)] [key (->string key)]) (and (key . in? . metas ) (->list (get metas key)))))) (module+ test (parameterize ([current-directory "tests/template"]) (check-equal? (find-in-metas "put" "foo") (list "bar")) - (let* ([metas (dynamic-require (make-pollen-source-path 'put) 'metas)] + (let* ([metas (dynamic-require (->pollen-source-path 'put) 'metas)] [here (find-in-metas 'put 'here)] [here-relative (list (->string (find-relative-path (current-directory) (car here))))]) (check-equal? here-relative (list "put.p"))))) diff --git a/tools.rkt b/tools.rkt index 48c9cad..ccf4c79 100644 --- a/tools.rkt +++ b/tools.rkt @@ -16,7 +16,7 @@ ;; list of all eligible requires in project require directory (define/contract (get-project-require-files) (-> (or/c (listof complete-path?) boolean?)) - (define extras-directory (build-path pollen-file-root EXTRAS_DIR)) + (define extras-directory (build-path pollen-project-directory EXTRAS_DIR)) (and (directory-exists? extras-directory) ;; #:build? option returns complete paths (instead of just file names) (let ([files (filter project-require-file? (directory-list extras-directory #:build? #t))]) diff --git a/world.rkt b/world.rkt index ae1a9d8..749e200 100644 --- a/world.rkt +++ b/world.rkt @@ -8,7 +8,7 @@ (define POLLEN_EXPRESSION_DELIMITER #\◊) (define TEMPLATE_FIELD_DELIMITER POLLEN_EXPRESSION_DELIMITER) -(define DEFAULT_TEMPLATE "-main.html") +(define DEFAULT_TEMPLATE_PREFIX "-main") (define FALLBACK_TEMPLATE_NAME "-temp-fallback-template.html") (define TEMPLATE_META_KEY "template")