#lang imperative-syndicate

(require racket/port)
(require logbook)
(require racket/cmdline)

(require/activate imperative-syndicate/drivers/timer)
(require/activate imperative-syndicate/drivers/tcp)

(begin-for-declarations
  (define server-entry-name #f)
  (define server-entry-type #f)

  (command-line #:program "echo-server-imperative-syndicate-tcp-driver.rkt"
                #:once-each
                ["--logbook-entry-name" name
                 "set logbook entry name to use when recording run statistics"
                 (set! server-entry-name name)]
                ["--logbook-entry-type" type
                 "set logbook entry type to use"
                 (set! server-entry-type type)])

  (when (not server-entry-type)
    (error 'echo-server "Please supply the --logbook-entry-type command-line argument."))

  (define L (default-logbook))
  (define E (logbook-entry L "minimart" server-entry-name server-entry-type))
  (define Tmem (logbook-table E "server-memory-use" #:column-spec '(time-seconds memory-use)))
  (define Tconn (logbook-table E "server-connections" #:column-spec '(time-seconds connection-count)))

  (define connection-count 0)
  (define first-connection-seen? #f)

  (define statistics-poll-interval 2000))

(define (statistician)
  (spawn #:name 'statistician
         (field [sample-deadline (+ (current-inexact-milliseconds) statistics-poll-interval)])
         (on (asserted (later-than (sample-deadline)))
             ;; (collect-garbage)
             ;; (collect-garbage)
             ;; (collect-garbage)
             (define now (sample-deadline))
             (write-logbook-datum! Tmem (list (/ now 1000.0) (current-memory-use)))
             (write-logbook-datum! Tconn (list (/ now 1000.0) connection-count))
             (when (and first-connection-seen? (zero? connection-count))
               (exit 0))
             (sample-deadline (+ (sample-deadline) statistics-poll-interval)))))

(define (listener port-number)
  (spawn #:name 'listener
         (during/spawn (tcp-connection $id (tcp-listener port-number))
           #:name (list 'connection id)
           (assert (tcp-accepted id))
           (on-start
            (issue-credit! (tcp-listener port-number))
            (issue-unbounded-credit! tcp-in id)
            (set! connection-count (+ connection-count 1))
            (set! first-connection-seen? #t))
           (on-stop
            (set! connection-count (- connection-count 1)))
           (on (message (tcp-in id $bs))
               (send! (tcp-out id bs))))))

(listener 5999)
(statistician)