#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
  (action (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
                                         (action (observer)
                                           (log-info "observer ~v" observer)
                                           (at (embedded-value observer) (assert (value)))))))
                          'setter
                          (embedded
                           (ref (entity #:name 'update-handler
                                        #:message
                                        (action (new-value)
                                          (reporter new-value)
                                          (when (= new-value LIMIT) (stop-facet root-facet))
                                          (value new-value))))))))))

(define client
  (action (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
                                   (action (_value _handle)
                                     (set! count (+ count 1)))
                                   #:retract
                                   (action (_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
                                   (action (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 this-turn
         (ref (entity #:name 'box-boot-handler
                      #:message
                      (action (refs)
                        (log-info "refs ~v" refs)
                        (match-define (hash-table ('getter (embedded g))
                                                  ('setter (embedded s))) refs)
                        (client this-turn g s)
                        (stop-facet root-facet))))
         500000
         100000))))