diff options
| -rw-r--r-- | haunt/ui/serve.scm | 41 |
1 files changed, 25 insertions, 16 deletions
diff --git a/haunt/ui/serve.scm b/haunt/ui/serve.scm index f7e4dce..b6fd01b 100644 --- a/haunt/ui/serve.scm +++ b/haunt/ui/serve.scm @@ -71,36 +71,39 @@ Start an HTTP server for the current site.~%") %default-common-options)) ;; XXX: Make this less naive. -(define (watch config-file ignore-dirs) +(define (watch config-file check-dir? check-file?) "Watch the current working directory for changes to any of its files -sans the files within IGNORE-DIRS, a list of subdirectories. When a -file has been changed, reload CONFIG-FILE and rebuild the site." +that match CHECK-FILE? and any subdirectories that match CHECK-DIR?. +When a file has been changed, reload CONFIG-FILE and rebuild the +site." + + (define cwd (getcwd)) + (define (any-files-changed? time) (define (enter? name stat result) - (cond - ;; Don't bother descending if we already know that a file has - ;; changed. - (result #f) - ;; Skip ignored directories, such as the site build directory. - ((any (lambda (dir) (string-prefix? dir name)) ignore-dirs) - #f) - (else #t))) + ;; Don't bother descending if we already know that a file has + ;; changed. + (and (not result) (check-dir? name))) (define (leaf name stat result) ;; Test if file has been modified since the last time we ;; checked. - (>= (stat:mtime stat) time)) + (or result + (and (check-file? name) + (or (>= (stat:mtime stat) time) + (>= (stat:ctime stat) time))))) (define (no-op name stat result) result) - (file-system-fold enter? leaf no-op no-op no-op no-op #f (getcwd))) + (file-system-fold enter? leaf no-op no-op no-op no-op #f cwd)) (let loop ((time (current-time))) - (sleep 1) (when (any-files-changed? time) (display "rebuilding...\n") (build-site (load-config config-file))) - (loop (current-time)))) + (let ((next-time (current-time))) + (sleep 1) + (loop next-time)))) (define (haunt-serve . args) (let* ((opts (simple-args-fold args %options %default-options)) @@ -114,6 +117,12 @@ file has been changed, reload CONFIG-FILE and rebuild the site." (when watch? (call-with-new-thread (lambda () - (watch config (list (site-build-directory site)))))) + (watch config + (let ((cwd (getcwd)) + (build-dir (site-build-directory site))) + (lambda (dir) + (not + (string-prefix? (string-append cwd "/" build-dir) dir)))) + (site-file-filter site))))) (serve doc-root))) |