diff --git a/racket/typed/examples/roles/chat-tcp2.rkt b/racket/typed/examples/roles/chat-tcp2.rkt new file mode 100644 index 0000000..1e0d73d --- /dev/null +++ b/racket/typed/examples/roles/chat-tcp2.rkt @@ -0,0 +1,46 @@ +#lang typed/syndicate/roles + +(require "../../drivers/tcp.rkt") + +;; 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)) + +;; without this line, there's no check on what type of actors `activate!` +;; spawns. However, putting these actors in a dataspace interferes with the +;; ground activity performed by the tcp driver (by making all activity one level +;; removed) +;; (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"))))))))))