interactor.ralph

(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)))