syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Work around limitations in the way the OS supports filesystem-change-evt

This commit is contained in:
Tony Garnock-Jones 2016-12-06 05:54:17 +13:00
parent 51a28b9349
commit 64cfce2472
1 changed files with 31 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
racket/syndicate/drivers/filesystem.rkt
View File

@ -10,7 +10,9 @@
(struct file-content (name reader-proc content) #:prefab) ;; ASSERTION
;; Internal driver ground-level protocol
(struct file-changed (name) #:prefab) ;; MESSAGE
(struct file-container-changed (parent-path) #:prefab) ;; MESSAGE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -26,7 +28,13 @@
(define (track-file name reader-proc)
(define control-ch (make-channel))
(thread (lambda () (track-file-changes name control-ch)))
(define parent-path
(let-values (((parent-path _leaf _syntactically-dir?)
(split-path (path->complete-path name))))
parent-path))
(thread (lambda () (track-file-changes name parent-path control-ch)))
(field [content (read-file name reader-proc)])
@ -35,9 +43,25 @@
(on (message (inbound (file-changed name)))
(content (read-file name reader-proc)))
;; This horrible hack is required to work around limitations in the
;; OS's file-change reporting. It seems (?) as if, monitoring both
;; "a/b" and "a/", that only the event for "a/" will be fired when
;; "a/b" changes. This manifests as follows: if I monitor "a/b" and
;; "a/nonexistent", then when "a/b" changes, only "a/nonexistent"'s
;; event will fire. Therefore, I've kludged in the
;; `file-container-changed` message, which copes with one level of
;; directory hierarchy of this problem.
;;
;; TODO: Consider whether it will actually be required to listen for
;; file-container-changed events for ALL recursive parents of the
;; path of interest up to the root.
;;
(on (message (inbound (file-container-changed parent-path)))
(content (read-file name reader-proc)))
(on-stop (channel-put control-ch 'quit)))
(define (track-file-changes name control-ch)
(define (track-file-changes name parent-path control-ch)
(let loop ()
(sync (handle-evt control-ch
(lambda (msg)
@ -50,13 +74,11 @@
;; (log-info "track-file-changes ~v: changed" name)
(send-ground-message (file-changed name))
(loop)))
(let-values (((parent-path _leaf _syntactically-dir?)
(split-path (path->complete-path name))))
(handle-evt (filesystem-change-evt parent-path)
(lambda (_dummy)
;; (log-info "track-file-changes ~v: directory changed" name)
(send-ground-message (file-changed name))
(loop))))))))
(handle-evt (filesystem-change-evt parent-path)
(lambda (_dummy)
;; (log-info "track-file-changes ~v: directory changed" name)
(send-ground-message (file-container-changed parent-path))
(loop)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;