mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

report the exception message when an error occurs

Browse Source 
When a cache preheat or render fails, print the exception message that arose, which might be more helpful than the current policy of silence
dev-gang-render
Matthew Butterick 3 years ago
parent 39cfc2ed54
commit 00a96f4fda
3 changed files with 35 additions and 26 deletions
Show Stats Download Patch File Download Diff File

12
pollen/private/preheat-cache.rkt
Unescape Escape View File

@ -53,7 +53,7 @@
(let loop () (let loop ()
(define path (place-channel-put/get ch (list 'want-job))) (define path (place-channel-put/get ch (list 'want-job)))
(place-channel-put ch (list 'job-finished path (place-channel-put ch (list 'job-finished path
(with-handlers ([exn:fail? (λ (e) #f)]) (with-handlers ([exn:fail? (λ (e) (cons #false (exn-message e)))])
(path->hash path)))) (path->hash path))))
(loop)))) (loop))))
(handle-evt wp (λ (val) (list* wpidx wp val))))) (handle-evt wp (λ (val) (list* wpidx wp val)))))
@ -69,12 +69,12 @@
(message (format "caching @ job ~a: ~a" (~r (add1 wpidx) #:min-width (string-length (~r job-count)) #:pad-string " ") (find-relative-path starting-dir path))) (message (format "caching @ job ~a: ~a" (~r (add1 wpidx) #:min-width (string-length (~r job-count)) #:pad-string " ") (find-relative-path starting-dir path)))
(loop rest (cons wpidx actives))])] (loop rest (cons wpidx actives))])]
[(list wpidx wp 'job-finished path result) [(list wpidx wp 'job-finished path result)
(if result (match result
(cache-ref! (paths->key 'source path) (λ () result)) [(cons #false exn-msg) (message (format "caching failed on job ~a: ~a\n because ~a" (add1 wpidx) (find-relative-path starting-dir path) exn-msg))]
(message (format "caching failed on job ~a: ~a" (add1 wpidx) (find-relative-path starting-dir path)))) [_ (cache-ref! (paths->key 'source path) (λ () result))])
(loop paths (remq wpidx actives))])))] (loop paths (remq wpidx actives))])))]
[else (for ([path (in-list uncached-paths)]) [else (for ([path (in-list uncached-paths)])
(message (format "caching: ~a" (find-relative-path starting-dir path))) (message (format "caching: ~a" (find-relative-path starting-dir path)))
(match (with-handlers ([exn:fail? (λ (e) #f)]) (path->hash path)) (match (with-handlers ([exn:fail? (λ (e) (cons #false (exn-message e)))]) (path->hash path))
[#false (message (format "caching failed: ~a" (find-relative-path starting-dir path)))] [(cons #false exn-msg) (message (format "caching failed: ~a\n because ~a" (find-relative-path starting-dir path) exn-msg))]
[result (cache-ref! (paths->key 'source path) (λ () result))]))])) [result (cache-ref! (paths->key 'source path) (λ () result))]))]))

2
pollen/private/ts.rktd
Unescape Escape View File

@ -1 +1 @@
1642030652 1644451419

47
pollen/render.rkt
Unescape Escape View File

@ -90,12 +90,17 @@
(place-channel-put/get ch (list 'wants-lock output-path)) (place-channel-put/get ch (list 'wants-lock output-path))
;; trap any exceptions and pass them back as crashed jobs. ;; trap any exceptions and pass them back as crashed jobs.
;; otherwise, a crashed rendering place can't recover, and the parallel job will be stuck. ;; 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 source-path output-path #f)))]) (place-channel-put ch
(match-define-values (_ _ ms _) (cons
;; we don't use `render-to-file-if-needed` because we've already checked the render cache ;; when rendering fails, first argument is the exception message
;; if we reached this point, we know we need a render (with-handlers ([exn:fail? (λ (e) (exn-message e))])
(time-apply render-to-file (list source-path #f output-path))) (match-define-values (_ _ ms _)
(place-channel-put ch (list 'finished-job source-path output-path ms)))) ;; we don't use `render-to-file-if-needed` because we've already checked the render cache
;; if we reached this point, we know we need a render
(time-apply render-to-file (list source-path #f output-path)))
;; when rendering succeeds, first argument is rendering time in ms
ms)
(list source-path output-path))))
(loop)))) (loop))))
(handle-evt wp (λ (val) (list* wpidx wp val))))) (handle-evt wp (λ (val) (list* wpidx wp val)))))
@ -144,26 +149,30 @@
[(cons ($job source-path output-path) rest) [(cons ($job source-path output-path) rest)
(place-channel-put wp (list (current-project-root) source-path output-path poly-target)) (place-channel-put wp (list (current-project-root) source-path output-path poly-target))
(loop rest locks blocks completed-job-results completed-job-count)])] (loop rest locks blocks completed-job-results completed-job-count)])]
[(list wpidx wp (and (or 'finished-job 'crashed-job) tag) source-path output-path ms) [(list wpidx wp status-arg source-path output-path)
(match tag ;; if the render was successful, the status arg is a number representing milliseconds spent rendering.
['finished-job ;; if not, the status argument is the exception message.
(define job-finished? (exact-nonnegative-integer? status-arg))
(match status-arg
[ms #:when job-finished?
(message
(format "rendered @ job ~a /~a ~a"
(~r (add1 wpidx) #:min-width (string-length (~r worker-count)) #:pad-string " ")
(find-relative-path (current-project-root) output-path)
(if (< ms 1000) (format "(~a ms)" ms) (format "(~a s)" (/ ms 1000.0)))))]
[(? string? exn-msg)
(message (message
(format "rendered @ job ~a /~a ~a" (format "render crash @ job ~a /~a (retry pending)\n because ~a"
(~r (add1 wpidx) #:min-width (string-length (~r worker-count)) #:pad-string " ")
(find-relative-path (current-project-root) output-path)
(if (< ms 1000) (format "(~a ms)" ms) (format "(~a s)" (/ ms 1000.0)))))]
[_
(message
(format "render crash @ job ~a /~a (retry pending)"
(add1 wpidx) (add1 wpidx)
(find-relative-path (current-project-root) output-path)))]) (find-relative-path (current-project-root) output-path)
exn-msg))]
[_ (raise-result-error 'render "exact-nonnegative-integer or string" status-arg)])
(loop jobs (loop jobs
(match (findf (λ (lock) (equal? ($lock-worker lock) wp)) locks) (match (findf (λ (lock) (equal? ($lock-worker lock) wp)) locks)
[#false locks] [#false locks]
[lock (remove lock locks)]) [lock (remove lock locks)])
blocks blocks
(let* ([job-finished? (eq? tag 'finished-job)] (let ([jr ($jobresult ($job source-path output-path) job-finished?)])
[jr ($jobresult ($job source-path output-path) job-finished?)])
(cons jr completed-job-results)) (cons jr completed-job-results))
(add1 completed-job-count))] (add1 completed-job-count))]
[(list wpidx wp 'wants-lock output-path) [(list wpidx wp 'wants-lock output-path)

Write Preview
Loading…
Cancel
Save