make parallel & non-parallel render accounting more consistent

pollen/private/command.rkt

@@ -116,9 +116,7 @@ version                print the version" (current-server-port) (make-publish-di
                   other-args))
 
   (define (handle-batch-render paths)
-    (if (dry-run?)
+    (apply render-batch (map very-nice-path paths) #:parallel (render-parallel?) #:dry-run (dry-run?)))
-        (for-each message paths)
-        (apply render-batch paths #:parallel (render-parallel?))))
   
   (parameterize ([current-poly-target (render-target-wanted)]) ;; applies to both cases
     (let loop ([args parsed-args])
@@ -134,19 +132,16 @@ version                print the version" (current-server-port) (make-publish-di
                                                     [(recursive) dir]
                                                     [else top-dir])])
                (define dirlist (directory-list dir))
-               (define preprocs (filter preproc-source? dirlist))
+               (define paths-to-render
-               (define static-pagetrees (filter pagetree-source? dirlist))
+                 (match (filter pagetree-source? dirlist)
                         ;; if there are no static pagetrees, use make-project-pagetree
                         ;; (which will synthesize a pagetree if needed, which includes all sources)
-               (define paths-to-render
-                 (map very-nice-path
-                      (match static-pagetrees
                         [(? null?)
                          (message (format "rendering generated pagetree for directory ~a" dir))
                          (cdr (make-project-pagetree dir))]
-                        [_
+                        [pagetree-sources
                          (message (format "rendering preproc & pagetree files in directory ~a" dir))
-                         (append preprocs static-pagetrees)])))
+                         (append (filter preproc-source? dirlist) pagetree-sources)]))
                (handle-batch-render paths-to-render)
                (when (render-with-subdirs?)
                  (for ([path (in-list dirlist)]
@@ -154,7 +149,7 @@ version                print the version" (current-server-port) (make-publish-di
                       (render-one-dir (->complete-path path)))))))]
         [path-args ;; path mode
          (message (format "rendering ~a" (string-join (map ->string path-args) " ")))
-         (handle-batch-render (map very-nice-path path-args))]))))
+         (handle-batch-render path-args)]))))
 
 (define (handle-start)
   (define launch-wanted #f)

pollen/private/ts.rktd

@@ -1 +1 @@
-1573240379
+1573244713

pollen/render.rkt

@@ -48,15 +48,7 @@
 
 (define (list-of-pathish? x) (and (list? x) (andmap pathish? x)))
 
-(define (parallel-render paths-in job-count-arg)
+(define (parallel-render source-paths job-count-arg)
-  (define source-paths
-    (let loop ([paths paths-in] [acc null])
-      (match (and (pair? paths) (->complete-path (car paths)))
-        [#false (remove-duplicates acc)]
-        [(? pagetree-source? pt) (loop (append (pagetree->paths pt) (cdr paths)) acc)]
-        [(app ->source-path (and (not #false) (? file-exists?) sp)) (loop (cdr paths) (cons sp acc))]
-        [_ (loop (cdr paths) acc)])))
-  
   (define job-count
     (min
      (length source-paths)
@@ -78,7 +70,7 @@
                                     ;; otherwise, a crashed rendering place can't recover, and the parallel job will be stuck.
                                     (with-handlers ([exn:fail? (λ (e) (place-channel-put ch (list 'crashed-job path #f)))])
                                       (match-define-values (_ _ ms _)
-                                        (time-apply render-from-source-or-output-path (list path)))
+                                        (time-apply render-to-file-if-needed (list path)))
                                       (place-channel-put ch (list 'finished-job path ms))))
                                   (loop))))
               (handle-evt wp (λ (val) (list* wpidx wp val)))))
@@ -86,8 +78,7 @@
   (define poly-target (current-poly-target))
 
   ;; `locks` and `blocks` are (listof (cons/c evt? path?))
-  (define starting-source-paths (sort source-paths string<? #:key path->string))
+  (let loop ([source-paths source-paths]
-  (let loop ([source-paths starting-source-paths]
              [locks-in null]
              [blocks-in null]
              ;; `completed-jobs` is (listof (cons/c path? boolean?))
@@ -106,7 +97,7 @@
            (place-channel-put wp 'lock-approved)
            (values (cons block locks) blocks)])))  
     (cond
-      [(eq? completed-job-count (length starting-source-paths))
+      [(eq? completed-job-count (length source-paths))
        ;; second bite at the apple for crashed jobs.
        ;; 1) many crashes that arise in parallel rendering are
        ;; a result of concurrency issues (e.g. shared files not being readable at the right moment).
@@ -152,17 +143,30 @@
          [(list wpidx wp 'wants-lock path)
           (loop source-paths locks (append blocks (list (cons wp path))) completed-jobs completed-job-count)])])))
 
-(define+provide/contract (render-batch #:parallel [wants-parallel-render #false] . paths-in)
+(define+provide/contract (render-batch #:parallel [wants-parallel-render? #false]
-  ((#:parallel any/c) #:rest list-of-pathish? . ->* . void?)
+                                       #:dry-run [wants-dry-run? #false] . paths-in)
+  ((#:parallel any/c) (#:dry-run boolean?) #:rest list-of-pathish? . ->* . void?)
   ;; Why not just (for-each render ...)?
   ;; Because certain files will pass through multiple times (e.g., templates)
   ;; And with render, they would be rendered repeatedly.
   ;; Using reset-modification-dates is sort of like session control.
   (reset-mod-date-hash!)
-  (for-each render-from-source-or-output-path (if wants-parallel-render
+  (define expanded-source-paths
+    (let loop ([paths paths-in] [acc null])
+      (match (and (pair? paths) (->complete-path (car paths)))
+        [#false (sort (remove-duplicates acc) string<? #:key path->string)]
+        [(? pagetree-source? pt) (loop (append (pagetree->paths pt) (cdr paths)) acc)]
+        [(app ->source-path (and (not #false) (? file-exists?) sp)) (loop (cdr paths) (cons sp acc))]
+        [_ (loop (cdr paths) acc)])))
+  (cond 
+    [wants-dry-run? (if (null? expanded-source-paths)
+                        (message "[no paths to render]")
+                        (for-each message expanded-source-paths))]
+    [else (for-each render-to-file-if-needed
+                    (match wants-parallel-render?
                       ;; returns crashed jobs for serial rendering
-                                                  (parallel-render paths-in wants-parallel-render)
+                      [#false expanded-source-paths]
-                                                  paths-in)))
+                      [jobs-arg (parallel-render expanded-source-paths jobs-arg)]))]))
 
 (define (pagetree->paths pagetree-or-path)
   (define pagetree (if (pagetree? pagetree-or-path)
@@ -177,18 +181,9 @@
 
 (define+provide/contract (render-from-source-or-output-path so-pathish)
   (pathish? . -> . void?)
-  (define so-path (->complete-path so-pathish)) ; so-path = source or output path (could be either) 
+  (match (->complete-path so-pathish)
-  (cond
+    [(app ->source-path (and (not #false) source-path)) (render-to-file-if-needed source-path)]
-    [(for/or ([pred (in-list (list has/is-null-source?
+    [(? pagetree-source? pt) (render-pagenodes pt)]))
-                                   has/is-preproc-source?
-                                   has/is-markup-source?
-                                   has/is-scribble-source?
-                                   has/is-markdown-source?))])
-             (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)])
-  (void))
 
 (define render-ram-cache (make-hash))