#lang syndicate

(require/activate syndicate/drivers/tcp)
(require racket/format)

(message-struct speak (who what))
(assertion-struct present (who))

(dataspace
 (spawn #:name 'chat-server
        (during/spawn (inbound (tcp-connection $id (tcp-listener 5999)))
          #:name (list 'chat-connection id)
          (assert (outbound (tcp-accepted id)))
          (on-start (send! (outbound (credit (tcp-listener 5999) 1)))
                    (send! (outbound (credit tcp-in id 1))))
          (let ((me (gensym 'user)))
            (assert (present me))
            (on (message (inbound (tcp-in-line id $bs)))
                (match bs
                  [#"/quit" (stop-current-facet)]
                  [#"/stop-server" (quit-dataspace!)]
                  [_ (send! (speak me (bytes->string/utf-8 bs)))
                     (send! (outbound (credit tcp-in id 1)))])))
          (during (present $user)
            (on-start (send! (outbound (tcp-out id (string->bytes/utf-8 (~a user " arrived\n"))))))
            (on-stop  (send! (outbound (tcp-out id (string->bytes/utf-8 (~a user " left\n"))))))
            (on (message (speak user $text))
                (send!
                 (outbound (tcp-out id (string->bytes/utf-8 (~a user " says '" text "'\n"))))))))))