From 884ab2025089ed69c38dacdf91dded4aa3d587b5 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 8 Aug 2015 09:11:31 -0400
Subject: ui: serve: Fix auto-rebuilding logic.

* haunt/ui/serve.scm (watch): Remove 'ignore-dirs' argument.  Add
  'check-file?' and 'check-dir?' arguments.
  (haunt-serve): Use new 'watch' procedure.
---
 haunt/ui/serve.scm | 41 +++++++++++++++++++++++++----------------
 1 file 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)))
-- 
cgit v1.2.3