From f3fb15470400a921864ab0a401be6932ca071b7a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 2 Nov 2018 14:37:31 -0700 Subject: [PATCH] transitive loading message (closes #176) and other improvements --- pollen/cache.rkt | 28 +++++++----- pollen/private/cache-utils.rkt | 6 +-- pollen/private/file-utils.rkt | 16 +++---- pollen/private/main-base.rkt | 6 ++- pollen/private/render-helper.rkt | 51 +++++++++++++++++++++ pollen/private/ts.rktd | 2 +- pollen/render.rkt | 77 +++++++++++--------------------- pollen/setup.rkt | 2 + 8 files changed, 111 insertions(+), 77 deletions(-) create mode 100644 pollen/private/render-helper.rkt diff --git a/pollen/cache.rkt b/pollen/cache.rkt index 1bacd69..3e741fe 100644 --- a/pollen/cache.rkt +++ b/pollen/cache.rkt @@ -1,7 +1,7 @@ #lang racket/base (require racket/file racket/list - racket/fasl + racket/path sugar/define "private/cache-utils.rkt" "private/log.rkt" @@ -19,15 +19,20 @@ (raise-argument-error 'reset-cache "path-string to existing directory" starting-dir)) (for ([path (in-directory starting-dir)] #:when (cache-directory? path)) - (message (format "removing cache directory: ~a" path)) - (delete-directory/files path))) + (message (format "removing cache directory: ~a" path)) + (delete-directory/files path))) (define ((path-error-handler caller-name path-or-path-string) e) (raise-argument-error caller-name "valid path or path-string" path-or-path-string)) (define-namespace-anchor cache-module-ns) -(define use-fasl? #false) +(define (fetch-val path subkey) + (parameterize ([current-namespace (make-base-namespace)]) + ;; brings in currently instantiated params (unlike namespace-require) + (define outer-ns (namespace-anchor->namespace cache-module-ns)) + (namespace-attach-module outer-ns 'pollen/setup) + (dynamic-require path subkey))) (define cached-require-base (let ([ram-cache (make-hash)]) @@ -42,16 +47,15 @@ (cond [(setup:compile-cache-active path) (define key (paths->key path)) - (define (convert-path-to-cache-record) ((if use-fasl? s-exp->fasl values) (path->hash path))) - (define (get-cache-record) ((if use-fasl? fasl->s-exp values) (cache-ref! key convert-path-to-cache-record))) + (define (convert-path-to-cache-record) + (when (let ([crs (current-render-source)]) + (and crs (not (equal? crs path)))) + (message (format "transitively loading /~a" (find-relative-path (current-project-root) path)))) + (path->hash path)) + (define (get-cache-record) (cache-ref! key convert-path-to-cache-record)) (define ram-cache-record (hash-ref! ram-cache key get-cache-record)) (hash-ref ram-cache-record subkey)] - [else - (parameterize ([current-namespace (make-base-namespace)]) - ;; brings in currently instantiated params (unlike namespace-require) - (define outer-ns (namespace-anchor->namespace cache-module-ns)) - (namespace-attach-module outer-ns 'pollen/setup) - (dynamic-require path subkey))])))) + [else (fetch-val path subkey)])))) (define+provide (cached-require path-string subkey) (cached-require-base path-string subkey 'cached-require)) diff --git a/pollen/private/cache-utils.rkt b/pollen/private/cache-utils.rkt index 19e4398..4225cf1 100644 --- a/pollen/private/cache-utils.rkt +++ b/pollen/private/cache-utils.rkt @@ -93,19 +93,19 @@ (define-values (cache-dir private-cache-dir) (make-cache-dirs dest-path)) (define-values (dest-path-dir dest-path-filename _) (split-path dest-path)) (define dest-file (build-path cache-dir (format "~a.rktd" dest-path-filename))) - (define (fetch-dest-file) + (define (generate-dest-file) (write-to-file (path-hash-thunk) dest-file #:exists 'replace)) ;; `cache-file` looks for a file in private-cache-dir previously cached with key ;; (which in this case carries modification dates and POLLEN env). ;; If a cached file is found, copies it to dest-file (which must not exist already, unless exists-ok? is true) - ;; Otherwise, fetch-dest-file is called; if dest-file exists after calling fetch-dest-file, + ;; Otherwise, generate-dest-file is called; if dest-file exists after calling fetch-dest-file, ;; it is copied to private-cache-dir and recorded with key. (cache-file dest-file #:exists-ok? #true key private-cache-dir - fetch-dest-file + generate-dest-file #:notify-cache-use notify-proc #:max-cache-size (setup:compile-cache-max-size)) (file->value dest-file)) \ No newline at end of file diff --git a/pollen/private/file-utils.rkt b/pollen/private/file-utils.rkt index 845c5df..8112bc9 100644 --- a/pollen/private/file-utils.rkt +++ b/pollen/private/file-utils.rkt @@ -156,13 +156,13 @@ [->STEM-SOURCE+OUTPUT-PATHS (format-id stx "->~a-source+output-paths" #'STEM)]) #`(begin ;; does file have particular extension - (define+provide/contract (STEM-SOURCE? x) - (any/c . -> . boolean?) - (and (pathish? x) (has-ext? (->path x) (SETUP:STEM-SOURCE-EXT)) #t)) + (define+provide (STEM-SOURCE? x) + #;(any/c . -> . boolean?) + (and (pathish? x) (has-ext? (->path x) (SETUP:STEM-SOURCE-EXT)) #true)) ;; non-theoretical: want the first possible source that exists in the filesystem - (define+provide/contract (GET-STEM-SOURCE x) - (coerce/path? . -> . (or/c #f path?)) + (define+provide (GET-STEM-SOURCE x) + #;(coerce/path? . -> . (or/c #f path?)) (define source-paths (or (->STEM-SOURCE-PATHS x) null)) (for/first ([sp (in-list source-paths)] #:when (file-exists? sp)) @@ -173,8 +173,8 @@ (->boolean (and (pathish? x) (ormap (λ (proc) (proc (->path x))) (list STEM-SOURCE? GET-STEM-SOURCE))))) ;; get first possible source path (does not check filesystem) - (define+provide/contract (->STEM-SOURCE-PATH x) - (pathish? . -> . (or/c #f path?)) + (define+provide (->STEM-SOURCE-PATH x) + #;(pathish? . -> . (or/c #f path?)) (define paths (->STEM-SOURCE-PATHS x)) (and paths (car paths))) @@ -186,7 +186,7 @@ #,(if (eq? (syntax->datum #'STEM) 'scribble) #'(if (x . has-ext? . 'html) ; different logic for scribble sources (list (add-ext (remove-ext* x) (SETUP:STEM-SOURCE-EXT))) - #f) + #false) #'(let ([x-ext (get-ext x)] [source-ext (SETUP:STEM-SOURCE-EXT)]) (cons diff --git a/pollen/private/main-base.rkt b/pollen/private/main-base.rkt index 1cee0eb..9e0b353 100644 --- a/pollen/private/main-base.rkt +++ b/pollen/private/main-base.rkt @@ -28,7 +28,9 @@ (define (strip-leading-newlines doc) ;; drop leading newlines, as they're often the result of `defines` and `requires` - (dropf doc (λ (ln) (member ln (list (setup:newline) ""))))) + (if (setup:trim-whitespace?) + (dropf doc (λ (ln) (member ln (list (setup:newline) "")))) + doc)) (define-syntax (pollen-module-begin stx) (syntax-case stx () @@ -43,7 +45,7 @@ DOC-ID ; positional arg for doclang-raw: name of export (λ (xs) (define proc (make-parse-proc PARSER-MODE ROOT-ID)) - (define trimmed-xs ((if (setup:trim-whitespace?) strip-leading-newlines values) xs)) + (define trimmed-xs (strip-leading-newlines xs)) (define doc-elements (splice trimmed-xs (setup:splicing-tag))) (proc doc-elements)) ; positional arg for doclang-raw: post-processor (module META-MOD-ID racket/base diff --git a/pollen/private/render-helper.rkt b/pollen/private/render-helper.rkt new file mode 100644 index 0000000..af94d25 --- /dev/null +++ b/pollen/private/render-helper.rkt @@ -0,0 +1,51 @@ +#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 () + ;; 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)))))])) \ No newline at end of file diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index 0e7517a..2b7b447 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1541019731 +1541194651 diff --git a/pollen/render.rkt b/pollen/render.rkt index 434f812..2d30f48 100644 --- a/pollen/render.rkt +++ b/pollen/render.rkt @@ -6,6 +6,7 @@ sugar/define sugar/file sugar/coerce + version/utils "private/file-utils.rkt" "cache.rkt" "private/log.rkt" @@ -69,7 +70,7 @@ has/is-markup-source? has/is-scribble-source? has/is-markdown-source?))]) - (pred so-path)) + (pred so-path)) (define-values (source-path output-path) (->source+output-paths so-path)) (render-to-file-if-needed source-path #f output-path)] [(pagetree-source? so-path) (render-pagenodes so-path)]) @@ -140,19 +141,21 @@ (define render-proc (for/first ([test (in-list tests)] [render-proc (in-list render-procs)] #:when (test source-path)) - render-proc)) + render-proc)) (unless render-proc (raise-argument-error 'render (format "valid rendering function for ~a" source-path) render-proc)) (define template-path (or maybe-template-path (get-template-for source-path output-path))) ;; output-path and template-path may not have an extension, so check them in order with fallback - (message (format "rendering /~a" + (message (format "rendering /~a" (find-relative-path (current-project-root) source-path))) (match-define-values ((cons render-result _) _ real _) - (parameterize ([current-poly-target (->symbol (or (get-ext output-path) + (parameterize ([current-directory (->complete-path (dirname source-path))] + [current-poly-target (->symbol (or (get-ext output-path) (and template-path (get-ext template-path)) - (current-poly-target)))]) + (current-poly-target)))] + [current-render-source source-path]) (time-apply render-proc (list source-path template-path output-path)))) ;; wait till last possible moment to store mod dates, because render-proc may also trigger its own subrenders ;; e.g., of a template. @@ -170,13 +173,14 @@ ;; todo: add test to avoid copying if unnecessary (good idea in case the file is large) (file->bytes source-path)) +(define-namespace-anchor render-module-ns) + (define (render-scribble-source source-path . _) ;((complete-path?) #:rest any/c . ->* . string?) (local-require scribble/core scribble/manual (prefix-in scribble- scribble/render)) (define source-dir (dirname source-path)) ;; make fresh namespace for scribble rendering (avoids dep/zo caching) - (parameterize ([current-namespace (make-base-namespace)] - [current-directory (->complete-path source-dir)]) + (parameterize ([current-namespace (make-base-namespace)]) (define outer-ns (namespace-anchor->namespace render-module-ns)) (namespace-attach-module outer-ns 'scribble/core) (namespace-attach-module outer-ns 'scribble/manual) @@ -193,11 +197,7 @@ (delete-file (->output-path source-path)))) (define (render-preproc-source source-path . _) - (parameterize ([current-directory (->complete-path (dirname source-path))]) - (render-datum-through-eval (syntax->datum - (with-syntax ([SOURCE-PATH source-path]) - #'(begin (require pollen/cache) - (cached-doc SOURCE-PATH))))))) + (cached-doc (->string source-path))) (define (render-markup-or-markdown-source source-path [maybe-template-path #f] [maybe-output-path #f]) (define output-path (or maybe-output-path (->output-path source-path))) @@ -207,36 +207,18 @@ (unless template-path (raise-argument-error 'render-markup-or-markdown-source "valid template path" template-path)) (render-from-source-or-output-path template-path) ; because template might have its own preprocessor source - (define datum-to-eval - (syntax->datum - (with-syntax ([DIRECTORY-REQUIRE-FILES (require-directory-require-files source-path)] - [DOC-ID (setup:main-export source-path)] - [META-ID (setup:meta-export source-path)] - [SOURCE-PATH-STRING (path->string source-path)] - [CPR (current-project-root)] - [HERE-PATH-KEY (setup:here-path-key source-path)] - [COMMAND-CHAR (setup:command-char source-path)] - [TEMPLATE-PATH (->string template-path)]) - #'(begin - (require (for-syntax racket/base) - pollen/private/external/include-template - pollen/cache - pollen/private/log - pollen/pagetree - pollen/core) - DIRECTORY-REQUIRE-FILES - (parameterize ([current-pagetree (make-project-pagetree CPR)] - [current-metas (cached-metas SOURCE-PATH-STRING)]) - (local-require pollen/template pollen/top) - (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)))))))) - ;; set current-directory because include-template wants to work relative to source location - (parameterize ([current-directory (->complete-path (dirname source-path))]) - (render-datum-through-eval datum-to-eval))) + (parameterize ([current-output-port (current-error-port)]) + (eval (with-syntax ([MODNAME (gensym)] + [SOURCE-PATH-STRING (->string source-path)] + [TEMPLATE-PATH-STRING (->string template-path)] + [REQUIRE (if (versionpreproc-source-path ->null-source-path))] #:when (file-exists? (proc path))) - path))) + path))) (define (get-template-from-metas source-path output-path-ext) (with-handlers ([exn:fail:contract? (λ (e) #f)]) ; in case source-path doesn't work with cached-require @@ -275,7 +257,7 @@ ;; output-path may not have an extension (define output-path-ext (or (get-ext output-path) (current-poly-target))) (for/or ([proc (list get-template-from-metas get-default-template get-fallback-template)]) - (file-exists-or-has-source? (proc source-path output-path-ext)))))) + (file-exists-or-has-source? (proc source-path output-path-ext)))))) (module-test-external (require pollen/setup sugar/file sugar/coerce) @@ -296,10 +278,3 @@ (check-false (get-template-for (->complete-path "foo.poly.pm"))) (check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html))) -(define-namespace-anchor render-module-ns) -(define (render-datum-through-eval datum-to-eval) - ;; render a datum, not a syntax object, so that it can have fresh bindings. - (parameterize ([current-namespace (make-base-namespace)] - [current-output-port (current-error-port)]) - (namespace-attach-module (namespace-anchor->namespace render-module-ns) 'pollen/setup) ; brings in params - (eval datum-to-eval))) diff --git a/pollen/setup.rkt b/pollen/setup.rkt index 26c5a41..48b023c 100644 --- a/pollen/setup.rkt +++ b/pollen/setup.rkt @@ -101,6 +101,8 @@ (define+provide current-server-port (make-parameter (project-server-port))) (define+provide current-server-listen-ip (make-parameter #f)) +(define+provide current-render-source (make-parameter #f)) + (define-settable dashboard-css "poldash.css") (define-runtime-path server-extras-dir "private/server-extras")