Split out RPC from daemon
This commit is contained in:
parent
0a2e678ca3
commit
ede3185e93
|
@ -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)))
|
||||
|
|
|
@ -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
30
src/rpc.rkt
Normal 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)))
|
Loading…
Reference in New Issue
Block a user