syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Refactor other chat servers to match

This commit is contained in:
Tony Garnock-Jones 2017-03-14 18:29:45 -04:00
parent 689d410bda
commit 118cdef4c6
4 changed files with 80 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
racket/syndicate/examples/actor/chat-no-quit-world-no-nesting.rkt
View File

@ -7,30 +7,23 @@
(struct says (who what) #:prefab)
(struct present (who) #:prefab)
(define (spawn-session them us)
(spawn (define (send-to-remote fmt . vs)
(send! (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs)))))
(define (say who fmt . vs)
(unless (equal? who user)
(send-to-remote "~a ~a\n" who (apply format fmt vs))))
(define user (gensym 'user))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(stop-when (retracted (advertise (tcp-channel them us _))))
(assert (present user))
(on (asserted (present $who)) (say who "arrived."))
(on (retracted (present $who)) (say who "departed."))
(on (message (says $who $what)) (say who "says: ~a" what))
(assert (advertise (tcp-channel us them _)))
(on (message (tcp-channel them us $bs))
(send! (says user (string-trim (bytes->string/utf-8 bs)))))))
(define us (tcp-listener 5999))
(spawn (assert (advertise (observe (tcp-channel _ us _))))
(on (asserted (advertise (tcp-channel $them us _)))
(spawn-session them us)))
(during/spawn (advertise (tcp-channel $them us _))
(assert (advertise (tcp-channel us them _)))
(define (send-to-remote fmt . vs)
(send! (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs)))))
(define user (gensym 'user))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(assert (present user))
(on (message (tcp-channel them us $bs))
(send! (says user (string-trim (bytes->string/utf-8 bs)))))
(during (present $who)
(unless (equal? who user)
(on-start (send-to-remote "~a arrived.\n" who))
(on-stop (send-to-remote "~a departed.\n" who))
(on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what))))))

46
racket/syndicate/examples/actor/chat-no-quit-world.rkt
View File

@ -7,30 +7,24 @@
(struct says (who what) #:prefab)
(struct present (who) #:prefab)
(define (spawn-session them us)
(spawn (define (send-to-remote fmt . vs)
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
(define (say who fmt . vs)
(unless (equal? who user)
(send-to-remote "~a ~a\n" who (apply format fmt vs))))
(define user (gensym 'user))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(stop-when (retracted (inbound (advertise (tcp-channel them us _)))))
(assert (present user))
(on (asserted (present $who)) (say who "arrived."))
(on (retracted (present $who)) (say who "departed."))
(on (message (says $who $what)) (say who "says: ~a" what))
(assert (outbound (advertise (tcp-channel us them _))))
(on (message (inbound (tcp-channel them us $bs)))
(send! (says user (string-trim (bytes->string/utf-8 bs)))))))
(dataspace (define us (tcp-listener 5999))
(forever (assert (outbound (advertise (observe (tcp-channel _ us _)))))
(on (asserted (inbound (advertise (tcp-channel $them us _))))
(spawn-session them us))))
(forever
(assert (outbound (advertise (observe (tcp-channel _ us _)))))
(during/spawn (inbound (advertise (tcp-channel $them us _)))
(assert (outbound (advertise (tcp-channel us them _))))
(define (send-to-remote fmt . vs)
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
(define user (gensym 'user))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(assert (present user))
(on (message (inbound (tcp-channel them us $bs)))
(send! (says user (string-trim (bytes->string/utf-8 bs)))))
(during (present $who)
(unless (equal? who user)
(on-start (send-to-remote "~a arrived.\n" who))
(on-stop (send-to-remote "~a departed.\n" who))
(on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))

47
racket/syndicate/examples/actor/chat-simplified-internals.rkt
View File

@ -9,31 +9,6 @@
(struct tcp-incoming-data (id bytes) #:prefab)
(struct tcp-outgoing-data (id bytes) #:prefab)
(struct says (who what) #:prefab)
(struct present (who) #:prefab)
(define (spawn-session id)
(spawn (define (send-to-remote fmt . vs)
(send! (tcp-outgoing-data id (string->bytes/utf-8 (apply format fmt vs)))))
(define (say who fmt . vs)
(unless (equal? who user)
(send-to-remote "~a ~a\n" who (apply format fmt vs))))
(define user (gensym 'user))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(stop-when (retracted (tcp-remote-open id)))
(assert (tcp-local-open id))
(assert (present user))
(on (asserted (present $who)) (say who "arrived."))
(on (retracted (present $who)) (say who "departed."))
(on (message (says $who $what)) (say who "says: ~a" what))
(on (message (tcp-incoming-data id $bs))
(send! (says user (string-trim (bytes->string/utf-8 bs)))))))
(define us (tcp-listener 5999))
(spawn (assert (advertise (observe (tcp-channel _ us _))))
(on (asserted (advertise (tcp-channel $them us _)))
@ -46,5 +21,23 @@
(on (message (tcp-outgoing-data id $bs))
(send! (tcp-channel us them bs))))))
(spawn (on (asserted (tcp-remote-open $id))
(spawn-session id)))
(struct says (who what) #:prefab)
(struct present (who) #:prefab)
(spawn (during/spawn (tcp-remote-open $id)
(assert (tcp-local-open id))
(define (send-to-remote fmt . vs)
(send! (tcp-outgoing-data id (string->bytes/utf-8 (apply format fmt vs)))))
(define user (gensym 'user))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(assert (present user))
(on (message (tcp-incoming-data id $bs))
(send! (says user (string-trim (bytes->string/utf-8 bs)))))
(during (present $who)
(unless (equal? who user)
(on-start (send-to-remote "~a arrived.\n" who))
(on-stop (send-to-remote "~a departed.\n" who))
(on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what))))))

51
racket/syndicate/examples/actor/chat.rkt
View File

@ -8,34 +8,27 @@
(struct present (who) #:prefab)
(struct shutdown () #:prefab)
(define (spawn-session them us)
(spawn (define (send-to-remote fmt . vs)
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
(define (say who fmt . vs)
(unless (equal? who user)
(send-to-remote "~a ~a\n" who (apply format fmt vs))))
(define user (gensym 'user))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(stop-when (retracted (inbound (advertise (tcp-channel them us _)))))
(assert (present user))
(on (asserted (present $who)) (say who "arrived."))
(on (retracted (present $who)) (say who "departed."))
(on (message (says $who $what)) (say who "says: ~a" what))
(assert (outbound (advertise (tcp-channel us them _))))
(on (message (inbound (tcp-channel them us $bs)))
(define input-string (string-trim (bytes->string/utf-8 bs)))
(if (equal? input-string "quit-dataspace")
(send! (shutdown))
(send! (says user input-string))))))
(dataspace (define us (tcp-listener 5999))
(until (message (shutdown))
(assert (outbound (advertise (observe (tcp-channel _ us _)))))
(on (asserted (inbound (advertise (tcp-channel $them us _))))
(spawn-session them us))))
(assert (outbound (advertise (observe (tcp-channel _ us _)))))
(during/spawn (inbound (advertise (tcp-channel $them us _)))
(assert (outbound (advertise (tcp-channel us them _))))
(define (send-to-remote fmt . vs)
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
(define user (gensym 'user))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(assert (present user))
(on (message (inbound (tcp-channel them us $bs)))
(define input-string (string-trim (bytes->string/utf-8 bs)))
(if (equal? input-string "quit-dataspace")
(send! (shutdown))
(send! (says user input-string))))
(during (present $who)
(unless (equal? who user)
(on-start (send-to-remote "~a arrived.\n" who))
(on-stop (send-to-remote "~a departed.\n" who))
(on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))