#lang scheme/base

;; Wrap files as properly GC-able reactive values.

(provide rv-file)


(require
 scheme/foreign  ;; finalizer
 scheme/dict
 "rv.ss"
 (planet jao/mzfam:2:1/fam-task)
 ;; (file "/home/tom/mzfam/fam-task.ss")
 )

(define *fam-task* (fam-task-create))
(unless (fam-task-start *fam-task*)
  (error "Could not start monitoring task"))


;; For proper GC behaviour, a level of indirection (refcounting) is
;; needed between file names unique to the FAM, and wrapped file
;; objects, which are distinct to the GC.

;; To make this work care needs to be taken to eliminate all
;; references to the rv object that might keep it alive.  This
;; includes the rv finalizer and the fam-handler.  The finalizer can
;; be "closed" by the object it is passed as an argument.


(define *paths* (make-hasheq))
(define (path->key p)
  (cond
   ((string? p) (string->symbol p))
   ((path? p)   (string->symbol (path->string p)))
   ((symbol? p) p)
   (else (error p))))

(define (fam-handler rv-set)
  (lambda (event)
    (printf "fam: ~a\n" (fam-event-monitored-path event))
    (for ((rv (in-hash-keys rv-set)))
      (rv-erase rv))))

(define (add-path! key path rv)
  (hash-update! *paths* key
                ;; Already registered: stash rv.
                (lambda (rv-set)
                  (hash-set! rv-set rv #t)
                  rv-set)
                ;; New path: register handler + create rv stash.
                (lambda ()
                  (let ((rv-set (make-weak-hasheq)))
                    (fam-task-add-path *fam-task* path (fam-handler rv-set))
                    rv-set))))


(define (remove-path! key path rv)
  (let* ((rv-set  (hash-ref *paths* key)))
    (hash-remove! rv-set rv)
    ;; No more refs, unregister fam handler.
    (when (zero? (hash-count rv-set))
      (fam-task-remove-path *fam-task* path)
      (hash-remove! *paths* key))))


;; Wrap a filename in an rp value.
(define (rv-file path)
  (let* ((key (path->key path))
         (fin (lambda (rv) (remove-path! key path rv))))
    (let ((rv (rv-delay path)))
      (add-path! key path rv)
      (register-finalizer rv fin)
      rv)))


;; (define foo (rv-app (lambda (filename)
;;                       (with-input-from-file filename read))
;;                     (rv-file "/tmp/foo")))