#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-semi-threaded.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)
  (thread
   (lambda ()
     (let loop ()
       (sync (handle-evt (read-line-evt in 'any)
                         (match-lambda
                           [(? eof-object?)
                            (close-input-port in)
                            (close-output-port out)
                            (set! connection-count (- connection-count 1))]
                           [line
                            (fprintf out "~a\n" line)
                            (flush-output out)
                            (loop)])))))))

(define (listener port-number)
  (define s (tcp-listen port-number 128 #t))
  (let loop ()
    (sync (handle-evt (tcp-accept-evt s)
                      (lambda (item)
                        (match-define (list in out) item)
                        (connection in out)
                        (loop))))))

(listener 5999)