From 00a96f4fdab8bae78ad7c049f6402c6f775c087e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 9 Feb 2022 16:03:39 -0800 Subject: [PATCH] report the exception message when an error occurs When a cache preheat or render fails, print the exception message that arose, which might be more helpful than the current policy of silence --- pollen/private/preheat-cache.rkt | 12 ++++---- pollen/private/ts.rktd | 2 +- pollen/render.rkt | 47 +++++++++++++++++++------------- 3 files changed, 35 insertions(+), 26 deletions(-) diff --git a/pollen/private/preheat-cache.rkt b/pollen/private/preheat-cache.rkt index d669e0d..e5aa790 100644 --- a/pollen/private/preheat-cache.rkt +++ b/pollen/private/preheat-cache.rkt @@ -53,7 +53,7 @@ (let loop () (define path (place-channel-put/get ch (list 'want-job))) (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)))) (loop)))) (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))) (loop rest (cons wpidx actives))])] [(list wpidx wp 'job-finished path result) - (if result - (cache-ref! (paths->key 'source path) (λ () result)) - (message (format "caching failed on job ~a: ~a" (add1 wpidx) (find-relative-path starting-dir path)))) + (match 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))] + [_ (cache-ref! (paths->key 'source path) (λ () result))]) (loop paths (remq wpidx actives))])))] [else (for ([path (in-list uncached-paths)]) (message (format "caching: ~a" (find-relative-path starting-dir path))) - (match (with-handlers ([exn:fail? (λ (e) #f)]) (path->hash path)) - [#false (message (format "caching failed: ~a" (find-relative-path starting-dir path)))] + (match (with-handlers ([exn:fail? (λ (e) (cons #false (exn-message e)))]) (path->hash 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))]))])) \ No newline at end of file diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index 4fa9734..5164fa4 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1642030652 +1644451419 diff --git a/pollen/render.rkt b/pollen/render.rkt index b3743e4..1f94049 100644 --- a/pollen/render.rkt +++ b/pollen/render.rkt @@ -90,12 +90,17 @@ (place-channel-put/get ch (list 'wants-lock output-path)) ;; 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. - (with-handlers ([exn:fail? (λ (e) (place-channel-put ch (list 'crashed-job source-path output-path #f)))]) - (match-define-values (_ _ 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))) - (place-channel-put ch (list 'finished-job source-path output-path ms)))) + (place-channel-put ch + (cons + ;; when rendering fails, first argument is the exception message + (with-handlers ([exn:fail? (λ (e) (exn-message e))]) + (match-define-values (_ _ 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)))) (handle-evt wp (λ (val) (list* wpidx wp val))))) @@ -144,26 +149,30 @@ [(cons ($job source-path output-path) rest) (place-channel-put wp (list (current-project-root) source-path output-path poly-target)) (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) - (match tag - ['finished-job + [(list wpidx wp status-arg source-path output-path) + ;; if the render was successful, the status arg is a number representing milliseconds spent rendering. + ;; 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 - (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)))))] - [_ - (message - (format "render crash @ job ~a /~a (retry pending)" + (format "render crash @ job ~a /~a (retry pending)\n because ~a" (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 (match (findf (λ (lock) (equal? ($lock-worker lock) wp)) locks) [#false locks] [lock (remove lock locks)]) blocks - (let* ([job-finished? (eq? tag 'finished-job)] - [jr ($jobresult ($job source-path output-path) job-finished?)]) + (let ([jr ($jobresult ($job source-path output-path) job-finished?)]) (cons jr completed-job-results)) (add1 completed-job-count))] [(list wpidx wp 'wants-lock output-path)