#lang racket/base

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

(define server-entry-name #f)
(define server-entry-type #f)

(command-line #:program "plain-racket-server-evt.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 'plain-racket-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)

(void (thread
       (lambda ()
	 (let loop ()
	   (sleep (/ statistics-poll-interval 1000.0))
	   (printf "~a connections\n" connection-count)
	   (flush-output)
	   (define now (current-inexact-milliseconds))
	   (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))
             (close-logbook L)
	     (exit 0))
	   (loop)))))

(define (connection in out)
  (set! connection-count (+ connection-count 1))
  (set! first-connection-seen? #t)
  (define reader-evt
    (handle-evt (read-line-evt in 'any)
                (lambda (item)
                  (match item
                    [(? eof-object?)
                     (close-input-port in)
                     (close-output-port out)
                     (set! connection-count (- connection-count 1))
                     (lambda (events) (remq reader-evt events))]
                    [line
                     (fprintf out "~a\n" line)
                     (flush-output out)
                     values]))))
  (lambda (events) (cons reader-evt events)))

(define (listener port-number)
  (define s (tcp-listen port-number 128 #t))
  (let loop ((events (list (handle-evt (tcp-accept-evt s)
                                       (lambda (ports)
                                         (match-define (list in out) ports)
                                         (connection in out))))))
    (loop ((or (apply sync/timeout 1.0 events) values) events))))

(listener 5999)