force render inside pagetrees

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

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)

pollen/private/ts.rktd

@@ -1 +1 @@
-1588547974
+1588697216

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)))