Split out RPC from daemon

This commit is contained in:
Tony Garnock-Jones 2015-01-26 16:30:33 -05:00
parent 0a2e678ca3
commit ede3185e93
3 changed files with 32 additions and 31 deletions

View File

@ -1,15 +1,9 @@
#lang racket/base
(provide daemonize-thunk
daemon-thread
rpc-request-evt
rpc-handler
rpc-call
rpc-cast!)
daemon-thread)
(require (only-in web-server/private/util exn->string))
(require racket/match)
(define (daemonize-thunk name boot-thunk)
(lambda ()
@ -28,27 +22,3 @@
(define (daemon-thread name boot-thunk)
(thread (daemonize-thunk name boot-thunk)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (rpc-request-evt)
(handle-evt (thread-receive-evt)
(lambda (_) (thread-receive))))
(define-syntax-rule (rpc-handler ch-and-req [(argpat ...) body ...] ...)
(match ch-and-req
[(cons ch request)
(define-values (reply-value new-state)
(match request
[(list argpat ...) body ...]
...))
(when ch (channel-put ch reply-value))
new-state]))
(define (rpc-call thread . request)
(define ch (make-channel))
(thread-send thread (cons ch request))
(channel-get ch))
(define (rpc-cast! thread . request)
(thread-send thread (cons #f request)))

View File

@ -27,6 +27,7 @@
(require reloadable)
(require "config.rkt")
(require "daemon.rkt")
(require "rpc.rkt")
(require "hash-utils.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

30
src/rpc.rkt Normal file
View File

@ -0,0 +1,30 @@
#lang racket/base
(provide rpc-request-evt
rpc-handler
rpc-call
rpc-cast!)
(require racket/match)
(define (rpc-request-evt)
(handle-evt (thread-receive-evt)
(lambda (_) (thread-receive))))
(define-syntax-rule (rpc-handler ch-and-req [(argpat ...) body ...] ...)
(match ch-and-req
[(cons ch request)
(define-values (reply-value new-state)
(match request
[(list argpat ...) body ...]
...))
(when ch (channel-put ch reply-value))
new-state]))
(define (rpc-call thread . request)
(define ch (make-channel))
(thread-send thread (cons ch request))
(channel-get ch))
(define (rpc-cast! thread . request)
(thread-send thread (cons #f request)))