#lang imperative-syndicate

(provide generic-client-session-facet)

(require "wire-protocol.rkt")
(require "internal-protocol.rkt")
(require "protocol.rkt")
(require imperative-syndicate/term)

(define-logger syndicate/distributed)

(spawn #:name 'client-factory
       (during (to-server $a _) (assert (server-connection a)))
       (during (observe (from-server $a _)) (assert (server-connection a)))
       (during (observe (server-connected $a)) (assert (server-connection a))))

(define (generic-client-session-facet address scope w)
  (on-start (log-syndicate/distributed-info "Connected to ~v" address))
  (on-stop (log-syndicate/distributed-info "Disconnected from ~v" address))
  (assert (server-connected address))

  (when (log-level? syndicate/distributed-logger 'debug)
    (set! w (let ((w* w))
              (lambda (p)
                (log-syndicate/distributed-debug "C OUT ~v ~v" address p)
                (w* p)))))

  (on-start (w (Connect scope)))

  (define next-ep
    (let ((counter 0))
      (lambda ()
        (begin0 counter
          (set! counter (+ counter 1))))))

  (during (to-server address $a)
    (define ep (next-ep))
    (on-start (w (Assert ep a)))
    (on-stop (w (Clear ep))))

  (on (message (to-server address $a))
      (w (Message a)))

  (on (message (server-packet address (Ping)))
      (w (Pong)))

  (on (message (server-packet address (Err $detail)))
      (log-syndicate/distributed-error "Error from ~a: ~v" address detail)
      (stop-current-facet))

  (during (observe ($ pat (from-server address $spec)))
    (define ep (next-ep))
    (on-start (w (Assert ep (observe spec))))
    (on-stop (w (Clear ep)))
    (on (message (server-packet address (Add ep $vs)))
        (react (assert (instantiate-term->value pat vs))
               (stop-when (message (server-packet address (Del ep vs))))))
    (on (message (server-packet address (Msg ep $vs)))
        (send! (instantiate-term->value pat vs)))))