/iserver.rkt

 1#lang racket
 2
 3(require
 4 (except-in "incubot.rkt" main)
 5 (only-in "vars.rkt" *incubot-logger*)
 6 (only-in "log-parser.rkt" utterance-text))
 7
 8(define (log fmt . args)
 9  (when (*incubot-logger*)
10    (apply (*incubot-logger*) (string-append "incubot-server:" fmt) args)))
11
12(provide make-incubot-server)
13(define make-incubot-server
14  (match-lambda
15   [(? string? ifn)
16    (with-handlers ([exn:fail:filesystem?
17                     (lambda (e)
18                       (log "Uh oh: ~a; using empty corpus" (exn-message e))
19                       (make-incubot-server (make-corpus)))])
20
21      ;; Load the server up asynchronously, so we don't have to wait
22      ;; for it.
23      (let ([the-server (make-incubot-server (make-corpus))])
24        (begin0
25            the-server
26          (thread
27           (lambda ()
28             (log "Reading log from ~a..." ifn)
29             (time
30              (with-handlers ([exn? (lambda (e)
31                                      (log "Ooops: ~a~%" (exn-message e))
32                                      (lambda ignored #f))])
33
34                (call-with-input-file ifn
35                  (lambda (inp)
36                    (let/ec return
37                      (for ([(utterance i) (in-indexed (in-port read inp))])
38                        (the-server 'put (utterance-text utterance))
39                        (when (= i 100000)
40                          (return))))
41                    (log "Reading log from ~a...done~%" inp))))))))))]
42
43   [(? corpus? c)
44    ;; TODO, low priority: Racket threads have a built-in "mailbox",
45    ;; which is essentially an async channel; we could replace one of
46    ;; these channels with it.
47    (let ([*to-server*   (make-channel)]
48          [*from-server* (make-channel)])
49      (define funcs-by-symbol
50        (make-immutable-hash
51         `([get .
52                ,(lambda (inp c)
53                   (channel-put *from-server* (incubot-sentence inp c))
54                   c)]
55           [put .
56                ,(lambda (sentence c)
57                   (channel-put *from-server* #t)
58                   (add-to-corpus sentence c))])))
59      (thread
60       (lambda ()
61         (let loop ([c c])
62           (match (channel-get *to-server*)
63             [(cons symbol inp)
64              (loop ((hash-ref funcs-by-symbol symbol) inp c))]))))
65
66      (lambda (command-sym inp)
67        (channel-put *to-server* (cons command-sym inp))
68        (channel-get *from-server*)))]))