Monad things

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

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)

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

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