#lang racket/base

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

(define (main)
  (ground-vm
   (transition 'none
     (spawn tcp-driver)
     (spawn (nested-vm 'chat-vm
		       (transition 'no-state
			 (at-meta-level
			  (role/anon (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) (tcp-accept t))
  (transition 'no-state
    (at-meta-level (cout (term->bytes `(you-are ,connection-id))))
    (at-meta-level (cin (tcp-mode 'lines)))
    (at-meta-level (cin (tcp-credit 1)))
    (at-meta-level (role/anon out-topic))
    (at-meta-level (role/anon in-topic
		     #:on-absence (kill)
		     [(tcp-channel _ _ (? bytes? line))
		      (list (at-meta-level (cin (tcp-credit 1)))
			    (send-message `(,connection-id says ,line)))]))
    (role/anon (topic-publisher `(,connection-id says ,(wild))))
    (role/anon (topic-subscriber `(,(wild) says ,(wild)))
      #:topic t
      #:on-presence (match t [(topic _ `(,who ,_ ,_) _)
			      (when (not (equal? who connection-id))
				(at-meta-level (cout (term->bytes `(,who arrived)))))])
      #:on-absence (match t [(topic _ `(,who ,_ ,_) _)
			     (when (not (equal? who connection-id))
			       (at-meta-level (cout (term->bytes `(,who departed)))))])
      [message (at-meta-level (cout (term->bytes message)))])))

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

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

(main)