Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
ralph/src/ralph/repl/interactor.ralph
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
174 lines (145 sloc)
6.1 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(define-module ralph/repl/interactor | |
import: (ralph/stream | |
ralph/format-out | |
ralph/compiler/environment | |
ralph/compiler/reader | |
ralph/compiler/compile | |
(ws rename: ("createServer" create-server)) | |
(readline | |
rename: ("createInterface" create-interface))) | |
export: (<interactor> start-interactor change-module)) | |
(define-function make-interface () | |
(create-interface | |
(%object "input" (%native "process.stdin") | |
"output" (%native "process.stdout")))) | |
(define-class <interactor> (<object>) | |
(current-line "")) | |
(define-method initialize ((interactor <interactor>)) | |
(call-next-method) | |
(bind ((interface (make-interface))) | |
(set! (get interactor "interface") | |
interface) | |
(. interface | |
(on "close" | |
(method () | |
(. (%native "process") | |
(exit 0))))))) | |
(define-function active? ((interactor <interactor>)) | |
(true? (get interactor "connection"))) | |
(define $incomplete (make-object)) | |
(define-function read-line ((interactor <interactor>) line) | |
(bind ((input-stream (make <string-stream> string: line))) | |
(read input-stream (get interactor "current-environment") | |
eof-error?: #f | |
eof-value: $incomplete | |
if-incomplete: $incomplete))) | |
(define-function on-each-line ((interactor <interactor>) handler) | |
(. (get interactor "interface") | |
(on "line" handler))) | |
(define-function make-environment (name) | |
(bind ((env (make-module-environment name))) | |
(set! (get env "persistent?") #f) | |
;; TODO: use module description to specifiy imports | |
env)) | |
(define-function send-command ((interactor <interactor>) type #rest data) | |
(. (get interactor "connection") | |
(send (as-json (apply make-object "type" type data))))) | |
(define-function perform-module-change ((interactor <interactor>) name) | |
(bind ((env (or (get interactor "environments" name) | |
(make-environment name)))) | |
(set! (get interactor "envrionments" name) env) | |
(set! (get interactor "current-environment") env))) | |
(define-function change-module ((interactor <interactor>) name) | |
(perform-module-change interactor name) | |
(send-command interactor "change-module" | |
"name" name)) | |
(define $handlers (make-plain-object)) | |
(define-function handle-message ((interactor <interactor>) serialized-message) | |
(bind ((message (parse-json serialized-message))) | |
(if-bind (handler (get $handlers (get message "type"))) | |
(handler interactor message)))) | |
(define-function handle-connection ((interactor <interactor>) connection) | |
;; TODO: close current connection | |
(. connection (on "message" | |
(curry handle-message interactor))) | |
(. connection (on "close" | |
(curry handle-close interactor))) | |
(set! (get interactor "connection") | |
connection) | |
(change-module interactor "ralph/core") | |
(update-prompt! interactor)) | |
(define-function handle-close ((interactor <interactor>)) | |
(set! (get interactor "connection") #f) | |
(set! (get interactor "current-environment") #f) | |
(update-prompt! interactor)) | |
(define-function start-server ((interactor <interactor>) port) | |
(bind ((server (create-server (%object "port" port) | |
(curry handle-connection interactor)))) | |
(set! (get interactor "server") server))) | |
(define-function start-interactor ((interactor <interactor>) #key (port 2342)) | |
(start-server interactor port) | |
(on-each-line interactor | |
(method (line) | |
(if (active? interactor) | |
(handle-line interactor line) | |
(begin | |
(format-out "[inactive]\n") | |
(update-prompt! interactor))))) | |
(update-prompt! interactor)) | |
(define-function append-line! ((interactor <interactor>) line) | |
(set! (get interactor "current-line") | |
(concatenate (get interactor "current-line") | |
"\n" line))) | |
(define-function eval-in-module ((interactor <interactor>) code) | |
(send-command interactor "eval-in-module" | |
"code" code)) | |
(set! (get $handlers "result") | |
(method (interactor message) | |
(bind-properties (result) message | |
(format-out "%s\n" result)) | |
(update-prompt! interactor))) | |
(set! (get $handlers "exception") | |
(method (interactor message) | |
(bind-properties (stack) message | |
(format-out "%s\n" stack)) | |
(update-prompt! interactor))) | |
(set! (get $handlers "change-module") | |
(method (interactor message) | |
(bind-properties (name) message | |
(perform-module-change interactor name)))) | |
(define-function handle-line ((interactor <interactor>) line) | |
(append-line! interactor line) | |
(bind-properties (current-line current-environment) | |
interactor | |
(handler-case | |
(bind ((expression (read-line interactor current-line)) | |
(incomplete? (== expression $incomplete))) | |
(set! (get interactor "incomplete?") | |
incomplete?) | |
(if incomplete? | |
(update-prompt! interactor) | |
(bind ((code (compile-to-string expression | |
current-environment))) | |
(eval-in-module interactor code) | |
(set! (get interactor "current-line") "")))) | |
((<error> condition: condition) | |
(format-out "%s\n" (get condition "stack")) | |
(set! current-line "") | |
(update-prompt! interactor))))) | |
(define-function current-module-name ((interactor <interactor>)) | |
(if-bind (env (get interactor "current-environment")) | |
(get env "module" "name"))) | |
(define-function set-prompt! ((interactor <interactor>) prompt) | |
(. (get interactor "interface") | |
("setPrompt" prompt))) | |
(define-function prompt! ((interactor <interactor>)) | |
(. (get interactor "interface") | |
(prompt))) | |
(define-function update-prompt! ((interactor <interactor>)) | |
(bind ((name (or (current-module-name interactor) ""))) | |
(set-prompt! interactor | |
(if (get interactor "incomplete?") | |
(concatenate (repeat-string " " (- (size name) 2)) | |
"... ") | |
(concatenate name "> "))) | |
(prompt! interactor))) |