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

Support for using struct-defaults in web.rkt, plus a simple default

This commit is contained in:
Tony Garnock-Jones 2016-07-23 11:28:46 -04:00
parent 981914c15b
commit b6e863fa79
4 changed files with 19 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
racket/info.rkt
View File

@ -13,6 +13,7 @@
"gui-lib"
"pict-lib"
"sgl"
"struct-defaults"
))
(define build-deps '("racket-doc"
"scribble-lib"))

9
racket/syndicate/drivers/web.rkt
View File

@ -11,7 +11,9 @@
(struct-out web-response-header)
(struct-out web-response-complete)
(struct-out web-response-chunked)
(struct-out web-response-websocket)
(rename-out [web-response-websocket <web-response-websocket>])
(struct-out/defaults [make-web-response-websocket web-response-websocket])
(struct-out web-response-chunk)
(struct-out websocket-message)
@ -38,6 +40,7 @@
(require web-server/private/connection-manager)
(require (only-in web-server/private/util lowercase-symbol!))
(require web-server/dispatchers/dispatch)
(require struct-defaults)
(require/activate "timer.rkt")
@ -57,6 +60,10 @@
(struct web-response-chunk (id bytes) #:prefab)
(struct websocket-message (id direction body) #:prefab)
(begin-for-declarations
(define-struct-defaults make-web-response-websocket web-response-websocket
(#:headers [web-response-websocket-headers '()])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Ground-level communication messages

2
racket/syndicate/examples/actor/web-sanity-check.rkt
View File

@ -22,7 +22,7 @@
($ req (web-request-header _ (web-resource vh `("ws" ())) _ _))
_))
(actor (react
(assert (web-response-websocket id '()))
(assert (web-response-websocket id))
(stop-when (retracted (observe (websocket-message id 'outbound _)))
(log-info "Connection dropped"))
(stop-when (message (websocket-message id 'inbound "quit"))

11
racket/syndicate/lang.rkt
View File

@ -10,6 +10,7 @@
activate
require/activate
current-ground-dataspace
begin-for-declarations
(except-out (all-from-out racket/base) #%module-begin sleep)
(all-from-out racket/match)
(all-from-out "main.rkt")
@ -31,6 +32,9 @@
(require module-path ...)
(activate module-path ...))]))
(define-syntax-rule (begin-for-declarations decl ...)
(begin decl ...))
(define current-ground-dataspace (make-parameter #f))
(define-syntax (module-begin stx)
@ -60,7 +64,9 @@
final-stx)
(syntax-case (local-expand (car forms)
'module
(cons #'module+ (kernel-form-identifier-list))) ()
(append (list #'module+
#'begin-for-declarations)
(kernel-form-identifier-list))) ()
[(head rest ...)
(if (free-identifier=? #'head #'begin)
(accumulate-actions action-ids
@ -70,7 +76,8 @@
(syntax->list #'(define-values define-syntaxes begin-for-syntax
module module* module+
#%module-begin
#%require #%provide)))
#%require #%provide
begin-for-declarations)))
(accumulate-actions action-ids
(cons (car forms) final-forms)
(cdr forms))