;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.remote-eval)

;;;;;;
;;; Server

(def class* remote-eval-server ()
  ((socket :type stream-server-usocket)))

(def (function e) startup-server (port &optional (message-processor #'eval))
  (bind ((socket (socket-listen "127.0.0.1" port :reuse-address t :element-type '(unsigned-byte 8)))
         (server (make-instance 'remote-eval-server :socket socket)))
    (make-thread (lambda ()
                   ;; TODO: proper error handling
                   (ignore-errors
                     (run-server server message-processor))) :name "Remote Eval Server")
    server))

(def (function e) shutdown-server (server)
  (socket-close (socket-of server))
  server)

(def function run-server (server message-processor)
  (iter (for socket = (socket-accept (socket-of server)))
        (for stream = (socket-stream socket))
        (for input-message = (read-message stream))
        (for output-message = (multiple-value-list (funcall message-processor input-message)))
        (write-message output-message stream)))

;;;;;;
;;; Connection

(def class* remote-eval-connection ()
  ((socket :type stream-usocket)))

(def (function e) connect-server (host port)
  (make-instance 'remote-eval-connection :socket (socket-connect host port :element-type '(unsigned-byte 8))))

(def (function e) disconnect-server (connection)
  (socket-close (socket-of connection))
  connection)

(def (function e) remote-eval (connection expression)
  (send connection expression))

(def function send (connection object)
  (bind ((stream (socket-stream (socket-of connection))))
    (write-message object stream)
    (values-list (read-message stream))))

(def function write-message (object stream)
  (bind ((buffer (serialize object)))
    (write-header stream)
    (write-size (length buffer) stream)
    (write-sequence buffer stream)
    (force-output stream)))

(def function read-message (stream)
  (read-header stream)
  (bind ((buffer (make-array (read-size stream) :element-type '(unsigned-byte 8))))
    (read-sequence buffer stream)
    (deserialize buffer)))

(def function write-header (stream)
  (write-sequence #(1 2 3 4) stream))

(def function read-header (stream)
  (bind ((buffer (make-array 4 :element-type '(unsigned-byte 8))))
    (read-sequence buffer stream)))

(def function write-size (size stream)
  (bind ((buffer (serialize size)))
    (write-sequence buffer stream)
    (write-sequence (make-array (- 8 (length buffer)) :initial-element 0) stream)))

(def function read-size (stream)
  (bind ((buffer (make-array 8 :element-type '(unsigned-byte 8))))
    (read-sequence buffer stream)
    (deserialize buffer)))