forked from jeapostrophe/racket-langserver
-
Notifications
You must be signed in to change notification settings - Fork 0
/
main.rkt
71 lines (63 loc) · 1.85 KB
/
main.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
#lang racket/base
(require json
mzlib/cml
racket/exn
racket/function
racket/list
racket/match
"append-message.rkt"
"error-codes.rkt"
"methods.rkt"
"msg-io.rkt"
"responses.rkt")
;; https://www.cs.utah.edu/plt/publications/pldi04-ff.pdf
(struct Q (in-ch out-ch mgr-t))
(define (queue)
(define in-ch (channel))
(define out-ch (channel))
(define (serve msgs)
(cond [(empty? msgs)
(serve (list (sync (channel-recv-evt in-ch))))]
[else
(sync (choice-evt
(wrap-evt
(channel-recv-evt in-ch)
(λ (m)
(serve (append-message msgs m))))
(wrap-evt
(channel-send-evt out-ch (first msgs))
(thunk*
(serve (rest msgs))))))]))
(define mgr-t (spawn (λ () (serve empty))))
(Q in-ch out-ch mgr-t))
(define (queue-send-evt q v)
(guard-evt
(λ ()
(thread-resume (Q-mgr-t q) (current-thread))
(channel-send-evt (Q-in-ch q) v))))
(define (queue-recv-evt q)
(guard-evt
(λ ()
(thread-resume (Q-mgr-t q) (current-thread))
(channel-recv-evt (Q-out-ch q)))))
(define (report-error exn)
(eprintf "\nCaught exn:\n~a\n" (exn->string exn)))
(define (main-loop)
(define q (queue))
(define (consume)
(define msg (sync (queue-recv-evt q)))
(match msg
['parse-json-error
(define err "Invalid JSON was received by the server.")
(display-message/flush (error-response (json-null) PARSE-ERROR err))]
[_
(with-handlers ([exn:fail? report-error])
(process-message msg))])
(consume))
(spawn consume)
(for ([msg (in-port read-message)])
(sync (queue-send-evt q msg)))
(eprintf "Unexpected EOF\n")
(exit 1))
(module+ main
(main-loop))