From 3b7c03f95090d0307dbbf5d6cb0593e16e99402d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 5 May 2020 09:46:56 -0700 Subject: [PATCH] force render inside pagetrees --- pollen/pagetree.rkt | 24 ++++++++++++++++-------- pollen/private/command.rkt | 28 ++++++++++++++++------------ pollen/private/ts.rktd | 2 +- pollen/render.rkt | 6 ------ 4 files changed, 33 insertions(+), 27 deletions(-) diff --git a/pollen/pagetree.rkt b/pollen/pagetree.rkt index 4848627..1354f61 100644 --- a/pollen/pagetree.rkt +++ b/pollen/pagetree.rkt @@ -48,9 +48,9 @@ (define pt-root-tag (setup:pagetree-root-node)) (define (splice-nested-pagetree xs) (apply append (for/list ([x (in-list xs)]) - (if (and (txexpr? x) (eq? (get-tag x) pt-root-tag)) - (get-elements x) - (list x))))) + (if (and (txexpr? x) (eq? (get-tag x) pt-root-tag)) + (get-elements x) + (list x))))) (validate-pagetree (decode (cons pt-root-tag xs) #:txexpr-elements-proc (compose1 splice-nested-pagetree (λ (xs) (filter-not whitespace? xs))) @@ -63,7 +63,7 @@ (define pagenodes (pagetree-strict->list x)) (for ([p (in-list pagenodes)] #:unless (pagenode? p)) - (raise-argument-error 'validate-pagetree "valid pagenodes" p)) + (raise-argument-error 'validate-pagetree "valid pagenodes" p)) (with-handlers ([exn:fail? (λ (e) (error 'validate-pagetree "~a" (exn-message e)))]) (members-unique?/error pagenodes)) x))) @@ -137,7 +137,7 @@ (if (memq pagenode (map topmost-node current-children)) current-parent (for/or ([st (in-list (filter list? current-children))]) - (loop pagenode st)))))) + (loop pagenode st)))))) (if (eq? result (first pt)) (and allow-root? result) result)) @@ -159,7 +159,7 @@ (match pagenode [(== (first pt) eq?) (map topmost-node (rest pt))] [_ (for/or ([subtree (in-list (filter pair? pt))]) - (loop pagenode subtree))])))) + (loop pagenode subtree))])))) (module-test-external @@ -190,7 +190,7 @@ (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?)) (match (for/list ([sib (in-list (or (siblings pnish pt-or-path) empty))] #:unless (eq? sib (->pagenode pnish))) - sib) + sib) [(? pair? sibs) sibs] [_ #false])) @@ -215,7 +215,15 @@ (define+provide/contract (pagetree->list pt-or-path) ((or/c pagetree? pathish?) . -> . pagenodes?) ; use rest to get rid of root tag at front - (pagetree-strict->list (get-pagetree pt-or-path))) + (pagetree-strict->list (get-pagetree pt-or-path))) + + +(define+provide/contract (pagetree->paths pt-or-path) + ((or/c pagetree? pathish?) . -> . (listof complete-path?)) + (parameterize ([current-directory (current-project-root)]) + (map ->complete-path (pagetree->list (match pt-or-path + [(? pagetree? pt) pt] + [_ (cached-doc pt-or-path)]))))) (module-test-external diff --git a/pollen/private/command.rkt b/pollen/private/command.rkt index 82d20f2..1dd70e1 100644 --- a/pollen/private/command.rkt +++ b/pollen/private/command.rkt @@ -7,7 +7,8 @@ sugar/coerce "file-utils.rkt" "log.rkt" - "../setup.rkt") + "../setup.rkt" + "../pagetree.rkt") ;; The use of dynamic-require throughout this file is intentional: ;; this way, low-dependency raco commands (like "version") are faster. @@ -44,11 +45,11 @@ [(let ([str (getenv "PLTSTDERR")]) (and str (regexp-match "@pollen" str))) (dispatch-thunk)] [else (with-logging-to-port - (current-error-port) - dispatch-thunk - #:logger pollen-logger - 'info - 'pollen)])) + (current-error-port) + dispatch-thunk + #:logger pollen-logger + 'info + 'pollen)])) (define (very-nice-path x) (path->complete-path (simplify-path (cleanse-path (->path x))))) @@ -129,10 +130,13 @@ version print the version" (current-server-port) (make-publish-di (when (force-render?) ;; forcing works like `touch`: updates the mod date of the files, ;; which invalidates any cached results. - (for* ([path (in-list paths)] - [sp (in-value (get-source path))] - #:when sp) - (file-or-directory-modify-seconds sp timestamp))) + (let force-paths ([paths paths]) + (for* ([path (in-list paths)] + [sp (in-value (if (pagetree-source? path) path (get-source path)))] + #:when sp) + (file-or-directory-modify-seconds sp timestamp) + (when (pagetree-source? sp) + (force-paths (pagetree->paths sp)))))) (apply render-batch (map very-nice-path paths) #:parallel (render-parallel?) #:special (special-output?))) (parameterize ([current-poly-target (render-target-wanted)]) ;; applies to both cases @@ -163,7 +167,7 @@ version print the version" (current-server-port) (make-publish-di (when (render-with-subdirs?) (for ([path (in-list dirlist)] #:when (directory-exists? path)) - (render-one-dir (->complete-path path)))))))] + (render-one-dir (->complete-path path)))))))] [path-args ;; path mode (message (format "rendering ~a" (string-join (map ->string path-args) " "))) (handle-batch-render path-args)])))) @@ -215,7 +219,7 @@ version print the version" (current-server-port) (make-publish-di (and (>= (length xs) (length prefix)) (andmap equal? prefix (for/list ([(x idx) (in-indexed xs)] #:break (= idx (length prefix))) - x)))) + x)))) ((explode-path possible-subdir) . has-prefix? . (explode-path possible-superdir))) (define (handle-publish) diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index 2149336..f3f2aae 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1588547974 +1588697216 diff --git a/pollen/render.rkt b/pollen/render.rkt index 08eeda8..b5d06c2 100644 --- a/pollen/render.rkt +++ b/pollen/render.rkt @@ -189,12 +189,6 @@ [#false expanded-source-paths] [jobs-arg (parallel-render expanded-source-paths jobs-arg)])))])) -(define (pagetree->paths pagetree-or-path) - (parameterize ([current-directory (current-project-root)]) - (map ->complete-path (pagetree->list (match pagetree-or-path - [(? pagetree? pt) pt] - [_ (cached-doc pagetree-or-path)]))))) - (define+provide/contract (render-pagenodes pagetree-or-path) ((or/c pagetree? pathish?) . -> . void?) (apply render-batch (pagetree->paths pagetree-or-path)))