From 1135abad7e7be3001d3e9612940a26baa866316a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 13 Oct 2013 21:43:43 -0700 Subject: [PATCH] updates --- debug.rkt | 17 ++++++++++++++--- render.rkt | 49 +++++++++++++++++++++++++++++-------------------- 2 files changed, 43 insertions(+), 23 deletions(-) diff --git a/debug.rkt b/debug.rkt index a843e92..92c552d 100644 --- a/debug.rkt +++ b/debug.rkt @@ -17,6 +17,16 @@ ; debug utilities (define months (list "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) +(define last-message-time #f) +(define (seconds-since-last-message) + (define now (current-seconds)) + (define then last-message-time) + (set! last-message-time now) + (if then + (- now then) + "--")) + + (define (message . items) (define (zero-fill str count) (set! str (~a str)) @@ -28,16 +38,17 @@ (define date (current-date)) (define date-fields (map (λ(x) (zero-fill x 2)) (list - (date-day date) - (list-ref months (sub1 (date-month date))) + ; (date-day date) + ; (list-ref months (sub1 (date-month date))) (if (<= (date-hour date) 12) (date-hour date) ; am hours + noon hour (modulo (date-hour date) 12)) ; pm hours after noon hour (date-minute date) (date-second date) ; (if (< (date-hour date) 12) "am" "pm") + (seconds-since-last-message) ))) - (apply format "[~a-~a ~a:~a:~a]" date-fields)) + (apply format "[~a:~a:~a ~as]" date-fields)) (displayln (string-join `(,(make-date-string) ,@(map (λ(x)(if (string? x) x (~v x))) items))) (current-error-port))) diff --git a/render.rkt b/render.rkt index 17247d5..b9bf5d4 100644 --- a/render.rkt +++ b/render.rkt @@ -7,6 +7,11 @@ (provide render render-with-session) + +;; for shared use by eval & system +(define nowhere-port (open-output-nowhere)) + + ;; mod-dates is a hash that takes lists of paths as keys, ;; and lists of modification times as values. ;; Reason: a templated page is a combination of two source files. @@ -104,7 +109,8 @@ (define/contract (render #:force [force #f] . xs) (() (#:force boolean?) #:rest (listof pathish?) . ->* . void?) (define (&render x) - (let ([path (->complete-path (->path x))]) + (let ([path (->complete-path (->path x))]) + ; (message "Dispatching render for" (->string (file-name-from-path path))) (cond ;; this will catch preprocessor files [(needs-preproc? path) (render-with-preproc path #:force force)] @@ -116,7 +122,7 @@ (render-ptree-files ptree #:force force))] [(equal? FALLBACK_TEMPLATE_NAME (->string (file-name-from-path path))) (message "Render: using fallback template")] - [(file-exists? path) 'pass-through] + [(file-exists? path) (message "Serving static file" (->string (file-name-from-path path)))] [else (error "Render couldn't find" (->string (file-name-from-path path)))]))) (for-each &render xs)) @@ -135,7 +141,7 @@ (define/contract (up-to-date-message path) (any/c . -> . void?) - (message "File is up to date:" (->string (file-name-from-path path)))) + (message (->string (file-name-from-path path)) "is up to date, using cached copy")) (define/contract (render-with-preproc x #:force [force #f]) @@ -161,12 +167,12 @@ ;; use single quotes to escape spaces in pathnames (let ([command (format "~a '~a' > '~a'" RACKET_PATH source-path output-path)]) (rendering-message (format "~a from ~a" - (file-name-from-path output-path) - (file-name-from-path source-path))) + (file-name-from-path output-path) + (file-name-from-path source-path))) (store-refresh-in-mod-dates source-path) ;; discard output using open-output-nowhere (parameterize ([current-directory source-dir] - [current-output-port (open-output-nowhere)]) + [current-output-port nowhere-port]) (system command)) (rendered-message output-path)) ;; otherwise, skip file because there's no trigger for refresh @@ -241,10 +247,10 @@ ;; 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))) + ;; if none of these work, make fallback template file + (let ([ft-path (build-path source-dir FALLBACK_TEMPLATE_NAME)]) + (display-to-file #:exists 'replace fallback-template-data ft-path) + ft-path))) ;; refresh template (it might have its own preprocessor file) (render template-path #:force force) @@ -252,8 +258,8 @@ ;; calculate new path for generated file (define output-path (->output-path source-path)) - ;; 2) render the source file with template, if needed. - ;; render is expensive, so we avoid it when we can. + ;; 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 @@ -291,15 +297,18 @@ ;; that represents the output of the operation. (parameterize ([current-namespace (make-base-empty-namespace)] [current-directory source-dir] - [current-output-port (open-output-nowhere)]) + [current-output-port nowhere-port] + [current-error-port nowhere-port]) ; silent evaluation; exceptions still thrown (namespace-require 'racket) ; use namespace-require for FIRST require, then eval after - ;; for include-template (used below) - (eval '(require web-server/templates) (current-namespace)) - ;; for ptree navigation functions, and template commands - (eval '(require (planet mb/pollen/debug)(planet mb/pollen/ptree)(planet mb/pollen/template)) (current-namespace)) - ;; import source into eval space. This sets up main & metas - (eval `(require ,(path->string source-name)) (current-namespace)) - (eval `(include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name)) (current-namespace)))) + (eval `(begin + ;; for include-template (used below) + (require web-server/templates) + ;; for ptree navigation functions, and template commands + (require (planet mb/pollen/debug) (planet mb/pollen/ptree) (planet mb/pollen/template)) + ;; import source into eval space. This sets up main & metas + (require ,(->string source-name)) + (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name))) + (current-namespace)))) ;; render files listed in a ptree file (define/contract (render-ptree-files ptree #:force [force #f])