diff --git a/jupyter-base.el b/jupyter-base.el index 67df5af..86f6b97 100644 --- a/jupyter-base.el +++ b/jupyter-base.el @@ -432,9 +432,7 @@ fields: ;;; Request object definition -(cl-defstruct (jupyter-request - (:constructor nil) - (:constructor jupyter-request)) +(cl-defstruct jupyter-request "Represents a request made to a kernel. Requests sent by a client always return something that can be interpreted as a `jupyter-request'. It holds the state of a @@ -451,9 +449,11 @@ types to callback functions a client should call." (id (jupyter-new-uuid) :read-only t) (type nil :read-only t) (content nil :read-only t) + (client nil :read-only t) (time (current-time) :read-only t) (idle-p nil) (last-message nil) + (messages nil) (inhibited-handlers nil) (callbacks nil)) diff --git a/jupyter-client.el b/jupyter-client.el index 7605232..9a56138 100644 --- a/jupyter-client.el +++ b/jupyter-client.el @@ -537,14 +537,19 @@ kernel whose kernelspec if SPEC." ;;; Shutdown and interrupt a kernel +;; FN is already a monadic function in the IO context of Emacs + (cl-defmethod jupyter-shutdown-kernel ((client jupyter-kernel-client)) "Shutdown the kernel CLIENT is connected to. After CLIENT shuts down the kernel it is connected to, it is no longer connected to a kernel." - (when-let* ((kernel (and (slot-boundp client 'kernel) - (oref client kernel)))) - (jupyter-wait-until-idle (jupyter-send client :shutdown-request)) - (jupyter-shutdown kernel))) + (jupyter-do (jupyter-io client) + (jupyter-after + (jupyter-idle (jupyter-request "shutdown")) + (lambda (req) + ;; Ensure the Emacs representation of the kernel also knows + ;; that the kernel's process has been shutdown. + (jupyter-shutdown (jupyter-kernel client)))))) (cl-defmethod jupyter-interrupt-kernel ((client jupyter-kernel-client)) "Interrupt the kernel CLIENT is connected to." @@ -878,10 +883,12 @@ user. Otherwise `read-from-minibuffer' is used." (read-from-minibuffer prompt)) (with-timeout-unsuspend timeout-spec))) (quit "")))) - (unwind-protect - (jupyter-send client :input-reply :value value) - (when (eq password t) - (clear-string value))) + (jupyter-do (jupyter-io client) + (jupyter-bind + (jupyter-request :input-reply :value value) + (lambda (_req) + (when (eq password t) + (clear-string value))))) value))) (defalias 'jupyter-handle-input-reply 'jupyter-handle-input-request) diff --git a/jupyter-connection.el b/jupyter-connection.el index d029d79..5350b4b 100644 --- a/jupyter-connection.el +++ b/jupyter-connection.el @@ -136,6 +136,22 @@ actions/queries: ('hb nil) (_ (error "Unhandled IO: %s" args)))))) +;; Kernel -> IO Kernel-IO +(cl-defmethod jupyter-connect ((kernel jupyter-kernel)) + ;; Any -> IO Kernel-IO + (jupyter-launch kernel) + (jupyter-return (jupyter-io kernel))) + +;; Client -> IO Client +(cl-defmethod jupyter-connect ((client jupyter-kernel-client)) + ;; Any -> IO Client-IO + (lambda (_) + (let ((io (jupyter-io (jupyter-kernel client)))) + (jupyter-return + (lambda (&rest args) + (let ((jupyter-current-client client)) + (apply io args))))))) + (defun jupyter-io (thing) "Return a function that can be used to perform I/O with THING. The function takes arguments like (TYPE ARGS...) where TYPE is a diff --git a/jupyter-monads.el b/jupyter-monads.el new file mode 100644 index 0000000..3a63249 --- /dev/null +++ b/jupyter-monads.el @@ -0,0 +1,91 @@ +(require 'thunk) + +(defun jupyter-return (value) + (declare (indent 0)) + (lambda (_io) value)) + +;; Adapted from `thunk-delay' +(defmacro jupyter-return-thunk (&rest body) + (declare (indent 0)) + `(let (forced val) + (lambda (_io) + (unless forced + (setf val (progn ,@body)) + (setf forced t)) + val))) + +(defconst jupyter-io-nil (jupyter-return nil)) + +(defvar jupyter-current-io + (lambda (&rest args) + (error "Unhandled IO: %s" args))) + +;; TODO: Keep track of the function bound to a io-value such that the +;; function is accessible +(defun jupyter-bind (io-value fn) + "Bind MVALUE to MFN." + (declare (indent 1)) + (pcase (funcall io-value jupyter-current-io) + ((and req (cl-struct jupyter-request client) + (let jupyter-current-client client)) + (funcall fn req)) + (`(timeout ,(and req (cl-struct jupyter-request))) + (error "Timed out: %s" (cl-prin1-to-string req))) + (`,value (funcall fn value)))) + +(defun jupyter--do (&rest mfns) + (cl-reduce + (lambda (io-value mfn) + (jupyter-bind io-value mfn)) + mfns :initial-value jupyter-io-nil)) + +(defmacro jupyter-do (io &rest forms) + (declare (indent 1)) + `(let ((jupyter-current-io ,io)) + (jupyter--do ,@forms))) + +(defun jupyter-after (io-value fn) + (declare (indent 1)) + (lambda (io) + (jupyter-bind io-value fn))) + +(defun jupyter-idle (io-req) + (jupyter-after io-req + (lambda (req) + (jupyter-return + (if (jupyter-wait-until-idle req) req + (list 'timeout req)))))) + +;; MsgType -> MsgList -> (IO -> Req) +;; (IO -> Req) represents an IO monadic value. IO Req +(defun jupyter-request (type &rest content) + "Return an IO action that sends a `jupyter-request'. +TYPE is the message type of the message that CONTENT, a property +list, represents. + +See `jupyter-io' for more information on IO actions." + (declare (indent 1)) + (setq type (intern (format ":%s-request" + (replace-regexp-in-string "_" "-" type)))) + (lambda (io) + (let* ((req (make-jupyter-request + :client jupyter-current-client + :type type + :content content)) + (ch (if (memq type '(:input-reply :input-request)) + :stdin + :shell)) + (id (jupyter-request-id req))) + (letrec ((handler + (lambda (event) + (pcase (car event) + ((and 'message (let `(,channel . ,msg) (cdr event)) + (guard (string= id (jupyter-message-parent-id msg)))) + (cl-callf nconc (jupyter-request-messages req) + (list msg)) + (when (jupyter--message-completes-request-p msg) + (setf (jupyter-request-idle-p req) t) + (jupyter-send io 'remove-handler handler))))))) + (jupyter-send io 'message ch type content id) + (jupyter-send io 'add-handler handler) + req))))