diff options
| -rw-r--r-- | haunt/ui/serve.scm | 77 |
1 files changed, 63 insertions, 14 deletions
diff --git a/haunt/ui/serve.scm b/haunt/ui/serve.scm index 2e8d7aa..7e27aa8 100644 --- a/haunt/ui/serve.scm +++ b/haunt/ui/serve.scm @@ -1,5 +1,5 @@ ;;; Haunt --- Static site generator for GNU Guile -;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; Copyright © 2015, 2022 David Thompson <davet@gnu.org> ;;; ;;; This file is part of Haunt. ;;; @@ -29,12 +29,16 @@ #:use-module (ice-9 format) #:use-module (ice-9 ftw) #:use-module (ice-9 threads) - #:use-module (haunt site) #:use-module (haunt config) - #:use-module (haunt ui) + #:use-module (haunt inotify) #:use-module (haunt serve web-server) + #:use-module (haunt site) + #:use-module (haunt ui) #:export (haunt-serve)) +(define %linux? + (string=? (utsname:sysname (uname)) "Linux")) + (define (show-help) (format #t "Usage: haunt serve [OPTION] Start an HTTP server for the current site.~%") @@ -84,8 +88,46 @@ Start an HTTP server for the current site.~%") (apply display-error (stack-ref stack 0) cep args) (newline cep))))) +;; TODO: Detect new directories and watch them, too. +(define (watch/linux config-file check-dir? check-file?) + (let ((inotify (make-inotify))) + (define (no-op name stat result) result) + (define (watch-directory name stat result) + (and (check-dir? name) + (inotify-add-watch! inotify name + '(create delete close-write moved-to moved-from)) + #t)) + (file-system-fold watch-directory no-op no-op no-op no-op no-op #t (getcwd)) + (let loop ((processed-event? #f)) + (cond + ((inotify-pending-events? inotify) + (let* ((event (inotify-read-event inotify)) + (type (inotify-event-type event)) + (file-name (string-append (inotify-watch-file-name + (inotify-event-watch event)) + "/" + (inotify-event-file-name event)))) + (if (and (check-dir? file-name) (check-file? file-name)) + (let ((action (case type + ((create) "create") + ((delete) "delete") + ((close-write) "write") + ((moved-to moved-from) "move")))) + (format #t "watch: observed ~a '~a'~%" action file-name) + (loop #t)) + (loop processed-event?)))) + (processed-event? + (display "rebuilding...\n") + (call-with-error-handling + (lambda () + (build-site (load-config config-file)))) + (loop #f)) + (else + (sleep 1) + (loop #f)))))) + ;; XXX: Make this less naive. -(define (watch config-file check-dir? check-file?) +(define (watch/fallback config-file check-dir? check-file?) "Watch the current working directory for changes to any of its files that match CHECK-FILE? and any subdirectories that match CHECK-DIR?. When a file has been changed, reload CONFIG-FILE and rebuild the @@ -113,6 +155,7 @@ site." (let loop ((time (current-time))) (when (any-files-changed? time) + (display "watch: file changes detected") (display "rebuilding...\n") (call-with-error-handling (lambda () @@ -131,14 +174,20 @@ site." (format #t "serving ~a on port ~d~%" doc-root port) (when watch? - (call-with-new-thread - (lambda () - (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))))) - + (let ((watch (if %linux? + (begin + (display "watch: using inotify mode\n") + watch/linux) + (begin + (display "watch: using fallback mode\n") + watch/fallback)))) + (call-with-new-thread + (lambda () + (watch config + (let ((build-dir (string-append (getcwd) "/" + (site-build-directory site)))) + (lambda (dir) + (not + (string-prefix? build-dir dir)))) + (site-file-filter site)))))) (serve doc-root #:open-params `(#:port ,port)))) |