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

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

pollen/private/ts.rktd

@@ -1 +1 @@
-1642030652
+1644451419

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)))])
+                           (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)))
-                             (place-channel-put ch (list 'finished-job source-path output-path ms))))
+                                                 ;; 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 "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)