#lang racket/base

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

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

(define pool (make-room 'everybody))

(struct groupchat (utterance) #:prefab)

(define (session inbound-stream quit-proc)
  (define h (join-room pool 'SESSION))
  (define outbound-stream (flip-stream inbound-stream))
  (send h assert! (topic-publisher outbound-stream))
  (send h assert! (topic-subscriber inbound-stream))
  (send h assert! (topic-publisher groupchat))
  (send h assert! (topic-subscriber groupchat))
  (define (send-text s) (send h say (topic-publisher outbound-stream) (tcp-data s)))
  (define (issue-credit) (send h say (topic-subscriber inbound-stream) (tcp-credit 1)))
  (issue-credit)
  (let loop ((prompt? #t))
    (when prompt? (send-text "Ready>> "))
    (match (send h listen)
      [(says (topic 'publisher (== inbound-stream) _) (tcp-eof))
       (send-text "OK, bye\n")]
      [(says (topic 'publisher (== inbound-stream) _) (tcp-data "quit"))
       (issue-credit)
       (quit-proc)
       (send-text "OK, will quit accepting\n")
       (loop #t)]
      [(says (topic 'publisher (== inbound-stream) _) (tcp-data what))
       (write `(someone said ,what))
       (newline)
       (issue-credit)
       (send-text "Carry on\n")
       (send h say (topic-publisher groupchat) (groupchat what))
       (loop #t)]
      [(says (topic 'publisher (== groupchat) _) (groupchat what))
       (send-text (string-append "CHAT: " what "\n"))
       (loop #t)]
      [(departed _ _)
       (void)]
      [_
       (loop #f)])))

(define (listen port-no)
  (standard-thread
   (lambda ()
     (define h (join-room pool 'LISTEN-THREAD))
     (define server-address (tcp-address #f port-no))
     (send h assert! (topic-subscriber (tcp-stream (wild-address) server-address)
				       #:virtual? #t))
     (define (quit-proc) (send h depart))
     (let loop ()
       (match (send h listen)
	 [(arrived (topic 'publisher (and inbound-stream (tcp-stream _ (== server-address))) #f))
	  (write `(starting session for ,inbound-stream)) (newline)
	  (standard-thread (lambda () (session inbound-stream quit-proc)))
	  (loop)]
	 [_
	  (loop)])))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(tcp-driver pool)

(define port-number 5001)
(display "Listening on port ")
(display port-number)
(newline)

(listen port-number)

(define (wait-until-pool-empty)
  (define h (join-room pool 'POOL-WAITER))
  (send h assert! (topic-publisher (wild) #:virtual? #t))
  (send h assert! (topic-subscriber (wild) #:virtual? #t))
  (let loop ((show-count #t) (count 0))
    (when show-count
      (write `(pool has ,count members)) (newline))
    (match (send h listen)
      [(arrived (and x (topic _ _ #t)))
       (write `(ignoring arrival of ,x)) (newline)
       (loop #f count)]
      [(arrived x)
       (write `(,x arrived in pool)) (newline)
       (loop #t (+ count 1))]
      [(departed (topic _ _ #f) _) (if (= count 1)
				       'done
				       (loop #t (- count 1)))]
      [_ (loop #f count)])))
(wait-until-pool-empty)