summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2022-02-05 19:38:05 -0500
committerDavid Thompson <dthompson2@worcester.edu>2022-02-05 19:38:05 -0500
commit270751357be257ae5ddff21e802201435ca7bf9b (patch)
tree2aeb9c5357b55266e500eec0b37480ca5cd7ec89
parent1ca9fc90fedc718fbaa425f2a96ffccd40950e7f (diff)
ui: serve: Reload user modules when they change.
-rw-r--r--haunt/ui/serve.scm17
1 files changed, 17 insertions, 0 deletions
diff --git a/haunt/ui/serve.scm b/haunt/ui/serve.scm
index 7e27aa8..62fbc6b 100644
--- a/haunt/ui/serve.scm
+++ b/haunt/ui/serve.scm
@@ -97,6 +97,15 @@ Start an HTTP server for the current site.~%")
(inotify-add-watch! inotify name
'(create delete close-write moved-to moved-from))
#t))
+ ;; Drop .scm extension, remove working directory,
+ ;; and transform into a symbolic module name.
+ (define (file-name->module-name file-name)
+ (map string->symbol
+ (string-split (string-drop (string-take file-name
+ (- (string-length file-name)
+ 4))
+ (+ (string-length (getcwd)) 1))
+ #\/)))
(file-system-fold watch-directory no-op no-op no-op no-op no-op #t (getcwd))
(let loop ((processed-event? #f))
(cond
@@ -114,6 +123,14 @@ Start an HTTP server for the current site.~%")
((close-write) "write")
((moved-to moved-from) "move"))))
(format #t "watch: observed ~a '~a'~%" action file-name)
+ ;; Reload Scheme modules when they are changed.
+ (when (%search-load-path file-name)
+ (let ((module (resolve-module
+ (file-name->module-name file-name))))
+ (when (module-filename module)
+ (format #t "watch: reload module ~s~%"
+ (module-name module))
+ (reload-module module))))
(loop #t))
(loop processed-event?))))
(processed-event?