43 lines
1.3 KiB
Racket
43 lines
1.3 KiB
Racket
#lang typed/syndicate
|
|
|
|
(require typed/syndicate/drivers/tcp)
|
|
|
|
;; message
|
|
(define-constructor (speak who what)
|
|
#:type-constructor SpeakT
|
|
#:with Speak (SpeakT Symbol String))
|
|
|
|
(define-constructor (present who)
|
|
#:type-constructor PresentT
|
|
#:with Present (PresentT Symbol))
|
|
|
|
(define-type-alias chat-comm
|
|
(U Present
|
|
(Message Speak)
|
|
(Observe (PresentT ★/t))
|
|
(Observe (SpeakT Symbol ★/t))))
|
|
|
|
(define-type-alias chat-ds
|
|
(U chat-comm
|
|
Tcp2Driver))
|
|
|
|
(run-ground-dataspace chat-ds
|
|
(activate!)
|
|
|
|
(spawn chat-ds
|
|
(start-facet chat-server
|
|
;; TODO - should be during/spawn
|
|
(during (tcp-connection (bind id Symbol) (tcp-listener 5999))
|
|
(assert (tcp-accepted id))
|
|
(let ([me (gensym 'user)])
|
|
(assert (present me))
|
|
(on (message (tcp-in-line id (bind bs ByteString)))
|
|
(send! (speak me (bytes->string/utf-8 bs))))
|
|
(during (present (bind user Symbol))
|
|
(on start
|
|
(send! (tcp-out id (string->bytes/utf-8 (~a user " arrived\n")))))
|
|
(on stop
|
|
(send! (tcp-out id (string->bytes/utf-8 (~a user " left\n")))))
|
|
(on (message (speak user (bind text String)))
|
|
(send! (tcp-out id (string->bytes/utf-8 (~a user " says '" text "'\n")))))))))))
|