|
|
|
@ -48,7 +48,7 @@
|
|
|
|
|
|
|
|
|
|
(define (list-of-pathish? x) (and (list? x) (andmap pathish? x)))
|
|
|
|
|
|
|
|
|
|
(define+provide/contract (render-batch #:parallel [wants-parallel-render #false] . paths)
|
|
|
|
|
(define+provide/contract (render-batch #:parallel [wants-parallel-render #false] . paths-in)
|
|
|
|
|
((#:parallel any/c) #:rest list-of-pathish? . ->* . void?)
|
|
|
|
|
;; Why not just (for-each render ...)?
|
|
|
|
|
;; Because certain files will pass through multiple times (e.g., templates)
|
|
|
|
@ -59,22 +59,19 @@
|
|
|
|
|
[wants-parallel-render
|
|
|
|
|
|
|
|
|
|
(define source-paths
|
|
|
|
|
(let ()
|
|
|
|
|
(define flattened-paths
|
|
|
|
|
(remove-duplicates
|
|
|
|
|
(sort
|
|
|
|
|
(let loop ([paths paths])
|
|
|
|
|
(if (null? paths)
|
|
|
|
|
null
|
|
|
|
|
(match (->complete-path (car paths))
|
|
|
|
|
[(? pagetree-source? pt) (append (loop (pagetree->paths pt)) (loop (cdr paths)))]
|
|
|
|
|
[path (cons path (loop (cdr paths)))])))
|
|
|
|
|
string<?
|
|
|
|
|
#:key path->string)))
|
|
|
|
|
(for*/list ([p (in-list flattened-paths)]
|
|
|
|
|
[maybe-source-path (in-value (->source-path p))]
|
|
|
|
|
#:when (and maybe-source-path (file-exists? maybe-source-path)))
|
|
|
|
|
maybe-source-path)))
|
|
|
|
|
(let loop ([paths paths-in])
|
|
|
|
|
(match paths
|
|
|
|
|
[(cons path0 rest)
|
|
|
|
|
(define paths-to-append
|
|
|
|
|
(match (->complete-path path0)
|
|
|
|
|
[(? pagetree-source? pt) (loop (pagetree->paths pt))]
|
|
|
|
|
[path (define sp (->source-path path))
|
|
|
|
|
(cond
|
|
|
|
|
[(and sp (file-exists? sp)) (list sp)]
|
|
|
|
|
[else null])]))
|
|
|
|
|
(append paths-to-append rest)]
|
|
|
|
|
[_ null]))))
|
|
|
|
|
|
|
|
|
|
(define job-count
|
|
|
|
|
(match wants-parallel-render
|
|
|
|
@ -100,7 +97,7 @@
|
|
|
|
|
(define poly-target (current-poly-target))
|
|
|
|
|
|
|
|
|
|
;; `locks` and `blocks` are (listof (cons/c evt? path?))
|
|
|
|
|
(let loop ([source-paths source-paths][locks-in null][blocks-in null])
|
|
|
|
|
(let loop ([source-paths (sort source-paths string<? #:key path->string)][locks-in null][blocks-in null])
|
|
|
|
|
;; try to unblock blocked workers
|
|
|
|
|
(define-values (locks blocks)
|
|
|
|
|
(for/fold ([locks locks-in]
|
|
|
|
@ -135,7 +132,7 @@
|
|
|
|
|
[lock (remove lock locks)]) blocks)]
|
|
|
|
|
[(list wpidx wp 'wants-lock path)
|
|
|
|
|
(loop source-paths locks (append blocks (list (cons wp path))))])))]
|
|
|
|
|
[else (for-each render-from-source-or-output-path paths)]))
|
|
|
|
|
[else (for-each render-from-source-or-output-path paths-in)]))
|
|
|
|
|
|
|
|
|
|
(define (pagetree->paths pagetree-or-path)
|
|
|
|
|
(define pagetree (if (pagetree? pagetree-or-path)
|
|
|
|
|