dan/haunt
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui: serve: Fix auto-rebuilding logic.

Browse Source 
* haunt/ui/serve.scm (watch): Remove 'ignore-dirs' argument.  Add
  'check-file?' and 'check-dir?' arguments.
  (haunt-serve): Use new 'watch' procedure.
This commit is contained in:
David Thompson
2015-08-08 09:11:31 -04:00
parent 9942e1d97c
commit 884ab20250
1 changed files with 25 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
haunt/ui/serve.scm
View File

@@ -71,36 +71,39 @@ Start an HTTP server for the current site.~%")
%default-common-options)) %default-common-options))
;; XXX: Make this less naive. ;; 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 "Watch the current working directory for changes to any of its files
sans the files within IGNORE-DIRS, a list of subdirectories. When a that match CHECK-FILE? and any subdirectories that match CHECK-DIR?.
file has been changed, reload CONFIG-FILE and rebuild the site." When a file has been changed, reload CONFIG-FILE and rebuild the
site."
(define cwd (getcwd))
(define (any-files-changed? time) (define (any-files-changed? time)
(define (enter? name stat result) (define (enter? name stat result)
(cond ;; Don't bother descending if we already know that a file has
;; Don't bother descending if we already know that a file has ;; changed.
;; changed. (and (not result) (check-dir? name)))
(result #f)
;; Skip ignored directories, such as the site build directory.
((any (lambda (dir) (string-prefix? dir name)) ignore-dirs)
#f)
(else #t)))
(define (leaf name stat result) (define (leaf name stat result)
;; Test if file has been modified since the last time we ;; Test if file has been modified since the last time we
;; checked. ;; 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) (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))) (let loop ((time (current-time)))
(sleep 1)
(when (any-files-changed? time) (when (any-files-changed? time)
(display "rebuilding...\n") (display "rebuilding...\n")
(build-site (load-config config-file))) (build-site (load-config config-file)))
(loop (current-time)))) (let ((next-time (current-time)))
(sleep 1)
(loop next-time))))
(define (haunt-serve . args) (define (haunt-serve . args)
(let* ((opts (simple-args-fold args %options %default-options)) (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? (when watch?
(call-with-new-thread (call-with-new-thread
(lambda () (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))) (serve doc-root)))