#lang racket/base

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

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

;;---------------------------------------------------------------------------

(define listener-proc
 (transition 'no-state
  (at-meta-level
   (role/anon (tcp-listener 5999)
    #:topic t
    #:on-presence
     (spawn (connection-handler t))))))

(define (connection-handler t)
  (define me (gensym 'user))
  (define-values (cin cout in-topic out-topic) (tcp-accept t))
  (transition 'no-state
    (peer-to-peer-roles me cout)
    (relay-to-tcp-roles me cin cout in-topic out-topic)))

(define (peer-to-peer-roles me cout)
  (define (announce t did-what)
    (unless (equal? (speaker t) me)
      (at-meta-level (cout (term->bytes `(,(speaker t) ,did-what))))))
  (list (role/anon (topic-publisher `(,me says ,(wild))))
	(role/anon (topic-subscriber `(,(wild) says ,(wild)))
	  #:topic t
	  #:on-presence (announce t 'arrived)
	  #:on-absence  (announce t 'departed)
	  [message (at-meta-level (cout (term->bytes message)))])))

(define (speaker t)
  (first (topic-pattern t)))

(define (relay-to-tcp-roles me cin cout in-topic out-topic)
  (at-meta-level
    (cout (term->bytes `(you-are ,me)))
     (cin (tcp-mode 'lines))
     (cin (tcp-credit 1))
     (role/anon out-topic)
     (role/anon in-topic
       #:on-absence (kill)
       [(tcp-channel _ _ (? bytes? line))
        (list (at-meta-level (cin (tcp-credit 1)))
              (send-message
                `(,me says ,line)))])))

(ground-vm
 (transition 'no-state
   (spawn tcp-driver)
   (spawn (nested-vm 'app-vm listener-proc))))