diff options
| -rw-r--r-- | haunt/ui/serve.scm | 52 |
1 files changed, 49 insertions, 3 deletions
diff --git a/haunt/ui/serve.scm b/haunt/ui/serve.scm index 09bcfcc..f7e4dce 100644 --- a/haunt/ui/serve.scm +++ b/haunt/ui/serve.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:use-module (ice-9 format) + #:use-module (ice-9 ftw) #:use-module (haunt site) #:use-module (haunt config) #:use-module (haunt ui) @@ -38,6 +39,8 @@ Start an HTTP server for the current site.~%") (display " -p, --port port to listen on") + (display " + -w, --watch rebuild site when files change") (newline) (show-common-options-help) (newline) @@ -58,16 +61,59 @@ Start an HTTP server for the current site.~%") (option '(#\p "port") #t #f (lambda (opt name arg result) (alist-cons 'port (string->number* arg) result))) + (option '(#\w "watch") #f #f + (lambda (opt name arg result) + (alist-cons 'watch? #t result))) %common-options)) (define %default-options (cons '(port . 8080) %default-common-options)) +;; XXX: Make this less naive. +(define (watch config-file ignore-dirs) + "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." + (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))) + + (define (leaf name stat result) + ;; Test if file has been modified since the last time we + ;; checked. + (>= (stat:mtime stat) time)) + + (define (no-op name stat result) result) + + (file-system-fold enter? leaf no-op no-op no-op no-op #f (getcwd))) + + (let loop ((time (current-time))) + (sleep 1) + (when (any-files-changed? time) + (display "rebuilding...\n") + (build-site (load-config config-file))) + (loop (current-time)))) + (define (haunt-serve . args) - (let* ((opts (simple-args-fold args %options %default-options)) - (port (assq-ref opts 'port)) - (site (load-config (assq-ref opts 'config))) + (let* ((opts (simple-args-fold args %options %default-options)) + (port (assq-ref opts 'port)) + (watch? (assq-ref opts 'watch?)) + (config (assq-ref opts 'config)) + (site (load-config config)) (doc-root (site-build-directory site))) (format #t "serving ~a on port ~d~%" doc-root port) + + (when watch? + (call-with-new-thread + (lambda () + (watch config (list (site-build-directory site)))))) + (serve doc-root))) |