serve: Catch exceptions when rebuilding site.
Now 'haunt serve --watch' won't crash when you put some bad code in a post! * haunt/ui/server.scm (call-with-error-handling): New procedure. (watch): Wrap build-site call in call-with-error-handling form.
This commit is contained in:
		@@ -70,6 +70,19 @@ Start an HTTP server for the current site.~%")
 | 
				
			|||||||
  (cons '(port . 8080)
 | 
					  (cons '(port . 8080)
 | 
				
			||||||
        %default-common-options))
 | 
					        %default-common-options))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (call-with-error-handling thunk)
 | 
				
			||||||
 | 
					  (catch #t
 | 
				
			||||||
 | 
					    thunk
 | 
				
			||||||
 | 
					    (lambda (key . args)
 | 
				
			||||||
 | 
					      (let ((cep (current-error-port))
 | 
				
			||||||
 | 
					            (stack (make-stack #t 1)))
 | 
				
			||||||
 | 
					        (display "ERROR: site rebuild failed\n\n" cep)
 | 
				
			||||||
 | 
					        (display "Backtrace:\n" cep)
 | 
				
			||||||
 | 
					        (display-backtrace stack cep)
 | 
				
			||||||
 | 
					        (newline cep)
 | 
				
			||||||
 | 
					        (apply display-error (stack-ref stack 0) cep args)
 | 
				
			||||||
 | 
					        (newline cep)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
;; XXX: Make this less naive.
 | 
					;; XXX: Make this less naive.
 | 
				
			||||||
(define (watch config-file check-dir? check-file?)
 | 
					(define (watch config-file check-dir? check-file?)
 | 
				
			||||||
  "Watch the current working directory for changes to any of its files
 | 
					  "Watch the current working directory for changes to any of its files
 | 
				
			||||||
@@ -100,7 +113,9 @@ site."
 | 
				
			|||||||
  (let loop ((time (current-time)))
 | 
					  (let loop ((time (current-time)))
 | 
				
			||||||
    (when (any-files-changed? time)
 | 
					    (when (any-files-changed? time)
 | 
				
			||||||
      (display "rebuilding...\n")
 | 
					      (display "rebuilding...\n")
 | 
				
			||||||
      (build-site (load-config config-file)))
 | 
					      (call-with-error-handling
 | 
				
			||||||
 | 
					        (lambda ()
 | 
				
			||||||
 | 
					          (build-site (load-config config-file)))))
 | 
				
			||||||
    (let ((next-time (current-time)))
 | 
					    (let ((next-time (current-time)))
 | 
				
			||||||
      (sleep 1)
 | 
					      (sleep 1)
 | 
				
			||||||
      (loop next-time))))
 | 
					      (loop next-time))))
 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user