#lang syndicate
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

(require "stats.rkt")

(define (box k LIMIT REPORT_EVERY)
  (spawn #:name 'box
         (define root-facet this-facet)
         (define disarm (facet-prevent-inert-check! this-facet))
         (define-field value 0)
         (define reporter (report-stats REPORT_EVERY))
         (send! k (hash 'getter
                        (embedded
                         (ref (during* #:name 'subscription-handler
                                       (lambda (observer)
                                         (log-info "observer ~v" observer)
                                         (at (embedded-value observer) (assert (value)))))))
                        'setter
                        (embedded
                         (ref (entity #:name 'update-handler
                                      #:message
                                      (lambda (new-value)
                                        (reporter new-value)
                                        (when (= new-value LIMIT) (stop-facet root-facet))
                                        (value new-value)))))))))

(define (client getter setter)
  (log-info "client start")
  (spawn #:name 'client
         (define root-facet this-facet)
         (define count 0)
         (at getter
           (assert (embedded
                    (ref (entity #:name 'termination-detector
                                 #:assert
                                 (lambda (_value _handle)
                                   (set! count (+ count 1)))
                                 #:retract
                                 (lambda (_handle)
                                   (set! count (- count 1))
                                   (when (zero? count)
                                     (log-info "Client detected box termination")
                                     (stop-facet root-facet)))))))
           (assert (embedded
                    (ref (entity #:name 'update-handler
                                 #:assert
                                 (lambda (value _handle) (send! setter (+ value 1))))))))))

(module+ main
  (time
   (actor-system
    (define root-facet this-facet)
    (define disarm (facet-prevent-inert-check! this-facet))
    (box (ref (entity #:name 'box-boot-handler
                      #:message
                      (lambda (refs)
                        (log-info "refs ~v" refs)
                        (match-define (hash-table ('getter (embedded g))
                                                  ('setter (embedded s))) refs)
                        (client g s)
                        (stop-facet root-facet))))
         500000
         100000))))
