#lang racket/base

(require racket/class)
(require racket/match)

(require "conversation.rkt")
(require "conversation-socket.rkt")

(define pool (make-room 'everybody))

(define (handle-connection sock quit-proc)
  (join-room pool)
  (define h (join-room sock))
  (match (send h listen)
    ((arrived peer-name)
     (let loop ()
       (send h say "Ready>> ")
       (sync (handle-evt (send h listen-evt)
			 (match-lambda
			  ((says _ _ 'eof)
			   (send h say "OK, bye\n"))
			  ((says _ "quit" 'data)
			   (send h say (credit peer-name 1))
			   (quit-proc)
			   (send h say "OK, will quit accepting\n")
			   (loop))
			  ((says _ what 'data)
			   (write what)
			   (newline)
			   (send h say (credit #f 1))
			   (send h say "Carry on\n")
			   (loop))
			  ((departed _ _) (void))
			  (else (loop))))
	     (handle-evt (send h disconnected-evt) void))))))

(define (listen port-no)
  (define r (make-room))
  (tcp-server-actor r
		    `((initial-accept-credit 1)
		      (read-mode lines)
		      (initial-read-credit 1))
		    port-no)
  (define h (join-room r 'main))
  (match (send h listen)
    ((arrived listener-name)
     (let loop ()
       (match (send h listen)
	 ((says _ sock 'accepted)
	  (thread (lambda ()
		    (handle-connection sock
				       (lambda ()
					 (send h depart 'told-to-quit)))))
	  (send h say (credit listener-name 1)))
	 (unexpected
	  (write `(unexpected ,unexpected))
	  (newline)))
       (loop)))))

(thread (lambda ()
	  (join-room pool)
	  (listen 5001)))

(define (wait-until-pool-empty)
  (define h (join-room pool))
  (let loop ((count 0))
    (match (send h listen)
      ((arrived _) (loop (+ count 1)))
      ((departed _ _) (if (= count 1)
			  'done
			  (loop (- count 1))))
      (_ (loop count)))))
(wait-until-pool-empty)