diff --git a/racket/syndicate/drivers/filesystem.rkt b/racket/syndicate/drivers/filesystem.rkt new file mode 100644 index 0000000..c6d6641 --- /dev/null +++ b/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) diff --git a/racket/syndicate/examples/actor/example-filesystem.rkt b/racket/syndicate/examples/actor/example-filesystem.rkt new file mode 100644 index 0000000..6c4e6e7 --- /dev/null +++ b/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)))))