filesystem driver

racket/syndicate/drivers/filesystem.rkt

@@ -0,0 +1,63 @@
+#lang syndicate/actor
+;; Filesystem change monitor driver
+
+(provide (struct-out file-content)
+         spawn-filesystem-driver)
+
+(require syndicate/protocol/standard-relay)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(struct file-content (name reader-proc content) #:prefab) ;; ASSERTION
+
+(struct file-changed (name) #:prefab) ;; MESSAGE
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (spawn-filesystem-driver)
+  (actor #:name 'filesystem-driver
+         (during/actor (observe (file-content $name $reader-proc _))
+           #:name (list 'file-content name reader-proc)
+           (track-file name reader-proc))))
+
+(define (read-file name reader-proc)
+  (and (file-exists? name)
+       (reader-proc name)))
+
+(define (track-file name reader-proc)
+  (define control-ch (make-channel))
+  (thread (lambda () (track-file-changes name control-ch)))
+
+  (field [content (read-file name reader-proc)])
+
+  (assert (file-content name reader-proc (content)))
+
+  (on (message (inbound (file-changed name)))
+      (content (read-file name reader-proc)))
+
+  (on-stop (channel-put control-ch 'quit)))
+
+(define (track-file-changes name control-ch)
+  (let loop ()
+    (sync (handle-evt control-ch
+                      (lambda (msg)
+                        ;; (log-info "track-file-changes ~v: ~v" name msg)
+                        (match msg
+                          ['quit (void)])))
+          (if (file-exists? name) ;; TODO: TOCTTOU :-(
+              (handle-evt (filesystem-change-evt name)
+                          (lambda (_dummy)
+                            ;; (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))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(spawn-filesystem-driver)

racket/syndicate/examples/actor/example-filesystem.rkt

@@ -0,0 +1,21 @@
+#lang syndicate/actor
+
+(require/activate syndicate/drivers/filesystem)
+(require racket/file)
+
+(require (only-in racket/port read-bytes-line-evt))
+(require (only-in racket/string string-trim string-split))
+
+(let ((e (read-bytes-line-evt (current-input-port) 'any)))
+  (actor #:name 'monitor-shell
+         (stop-when (message (inbound (external-event e (list (? eof-object? _)))))
+                    (send! (list "close" ?)))
+         (on (message (inbound (external-event e (list (? bytes? $command-bytes)))))
+             (send! (string-split (string-trim (bytes->string/utf-8 command-bytes)))))))
+
+(actor #:name 'monitor-opener
+       (on (message (list "open" $name))
+           (actor #:name (list 'monitor name)
+                  (stop-when (message (list "close" name)))
+                  (on (asserted (file-content name file->bytes $bs))
+                      (log-info "~a: ~v" name bs)))))