From 6ee62db96310753a6d9c0db2028bff8b8c44178c Mon Sep 17 00:00:00 2001 From: moritz Date: Sat, 28 Jan 2012 21:57:31 +0100 Subject: pass condition message to download-release-error and add read-release-info-file-error-hook. --- henrietta-cache.scm | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'henrietta-cache.scm') diff --git a/henrietta-cache.scm b/henrietta-cache.scm index f7914fe..ff132b0 100644 --- a/henrietta-cache.scm +++ b/henrietta-cache.scm @@ -26,9 +26,13 @@ EOF (define download-release-error-hook (make-parameter #f)) +(define read-release-info-file-error-hook + (make-parameter #f)) + (define hooks `((download-release-success . ,download-release-success-hook) - (download-release-error . ,download-release-error-hook))) + (download-release-error . ,download-release-error-hook) + (read-release-info-file-error . ,read-release-info-file-error-hook))) (define (run-hook hook-name . args) (and-let* ((hook (or (alist-ref hook-name hooks) @@ -199,7 +203,10 @@ EOF egg-name egg-release) (print-error-message exn (current-error-port)) (flush-output (current-error-port)) - (run-hook 'download-release-error egg-name egg-release)) + (run-hook 'download-release-error + egg-name + egg-release + (get-condition-property exn 'exn 'message))) (create-directory cache-dir #t) (download-release type uri cache-dir) (run-hook 'download-release-success egg-name egg-release)))))) @@ -211,10 +218,11 @@ EOF (define (read-release-info-file uri egg-name) (handle-exceptions exn - (begin + (let ((message (get-condition-property exn 'exn 'message))) (fprintf (current-error-port) "Could not fetch release-info file for egg ~A from ~A -- ~A\n" - egg-name uri (get-condition-property exn 'exn 'message)) + egg-name uri message) + (run-hook 'read-release-info-file-error egg-name uri message) (flush-output (current-error-port)) '()) (with-input-from-request uri #f read-file))) -- cgit v1.2.3