#lang racket/base

(require racket/port)
(require racket/match)
(require "os2.rkt")
(require "fake-tcp.rkt")

(define (main)
  (ground-vm
   (spawn tcp-driver)
   (spawn (nested-vm #:debug-name 'chat-vm
		     (at-meta-level
		      (role (tcp-listener 5999)
			#:topic t
			#:on-presence (spawn (connection-handler t))))))))

(define (connection-handler t)
  (match-define (topic _ (tcp-channel connection-id _ _) _) t)
  (define-values (cin cout in-topic out-topic) (topic->tcp-connection t))
  (transition 'no-state
    (role (topic-publisher `(,connection-id says ,?)))
    (role (topic-subscriber `(,? says ,?))
      #:topic t
      #:on-presence (match t [(topic _ (list who _ _) _)
			      (unless (equal? who connection-id)
				(at-meta-level (cout (term->bytes `(,who arrived)))))])
      #:on-absence  (match t [(topic _ (list who _ _) _)
			      (unless (equal? who connection-id)
				(at-meta-level (cout (term->bytes `(,who departed)))))])
      [message (at-meta-level (cout (term->bytes message)))])
    (at-meta-level (cout (term->bytes `(you-are ,connection-id)))
		   (cin (tcp-mode 'lines))
		   (cin (tcp-credit 1))
		   (role out-topic)
		   (role in-topic
		     #:on-absence (quit)
		     [(tcp-channel _ _ (? bytes? line))
		      (list (at-meta-level (cin (tcp-credit 1)))
			    (send-message `(,connection-id says ,line)))]))))

(define (term->bytes v)
  (with-output-to-bytes (lambda () (write v) (newline))))

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

(main)