emacs-jupyter/test/jupyter-monad-test.el
2023-02-13 20:30:19 -06:00

262 lines
10 KiB
EmacsLisp

;;; jupyter-monad-test.el --- Test monadic I/O -*- lexical-binding: t -*-
;; Copyright (C) 2020 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 16 May 2020
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or (at
;; your option) any later version.
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
;; Kernel messages are property list representations of JSON encoded
;; strings.
;; A kernel client is a publisher of requests and subscriber of
;; kernel messages.
(ert-deftest jupyter-verify-monad-axioms ()
:tags '(monad)
(let ((f (lambda (n) (jupyter-return-delayed (/ n 0.5))))
(g (lambda (n) (jupyter-return-delayed (* n 3))))
(m (jupyter-return-delayed 9)))
(should (equal (jupyter-bind-delayed (jupyter-return-delayed 1) f)
(funcall f 1)))
(should (equal (jupyter-bind-delayed m #'jupyter-return-delayed) m))
(should (equal (jupyter-bind-delayed
;; Instead of applying a function, f, to a
;; value, a, to get b, you bind a delayed value
;; M a to f to get M b. Binding unboxes M a
;; into a and then applies f on a.
(jupyter-bind-delayed m f) g)
(jupyter-bind-delayed m
(lambda (x) (jupyter-bind-delayed (funcall f x) g)))))))
(ert-deftest jupyter-mlet* ()
:tags '(monad)
(should (equal (jupyter-mlet* ((a (jupyter-return-delayed 1))))
jupyter-io-nil))
(should (equal (jupyter-mlet* ((a (jupyter-return-delayed 1)))
a)
1))
(should (equal (jupyter-mlet* ((a (jupyter-return-delayed 2))
(b (jupyter-return-delayed (* a 3))))
b)
6)))
(ert-deftest jupyter-publisher/subscriber ()
:tags '(monad)
;; Publisher/subscriber
(ert-info ("Publisher/subscriber")
(let* ((msgs '())
(pub (jupyter-publisher))
(sub (jupyter-subscriber
(lambda (n)
(if (> n 2) (jupyter-unsubscribe)
(push n msgs))))))
(jupyter-run-with-io pub
(jupyter-subscribe sub))
(cl-loop
for x in '(1 2 3)
do (jupyter-run-with-io pub
(jupyter-publish x)))
(should (equal '(2 1) msgs))))
(ert-info ("Subscriber errors")
(ert-info ("`jupyter-subscribed-subscriber' error")
(let* ((n 1)
(sub (jupyter-subscriber
(lambda (x) (setq n (* x 3))))))
(should-error
(jupyter-run-with-io sub
(jupyter-subscribe (jupyter-publisher)))
:type 'jupyter-subscribed-subscriber)
(should-error (funcall sub 'any))))
;; FIXME: Prevent ert from catching the error
;; (ert-info ("Keep subscriber on subscriber error")
;; (let* ((msgs '())
;; (pub (jupyter-publisher))
;; (sub (jupyter-subscriber
;; (lambda (n)
;; (if (= n 1) (error "(= n 1)")
;; (push n msgs))))))
;; (jupyter-run-with-io pub
;; (jupyter-subscribe sub))
;; (cl-loop
;; for x in '(1 2 3)
;; do (jupyter-run-with-io pub
;; (jupyter-publish x)))
;; (should (equal '(3 2) msgs))))
)
;; Extra for fun
(let* ((lst '(1 2 3 4 5 6 7 8 9 10))
(emitter (lambda (_) (jupyter-content (pop lst))))
(pub (jupyter-publisher emitter))
(collector (lambda (el)
(if el
;; NOTE: Not a good idea to do in practice
;; on large lists since it will cause lots
;; of recursion.
(jupyter-run-with-io pub
(jupyter-publish 'next))
(jupyter-unsubscribe))))
(sub (jupyter-publisher collector)))
(jupyter-run-with-io pub
(jupyter-do
(jupyter-subscribe sub)
(jupyter-publish 'start)))
(should (null lst)))
;; NOTE: Same as above, creating a subscription cycle can cause
;; errors when the recursion is too deep. See
;; `max-lisp-eval-depth'.
(letrec ((n 10)
(ping (jupyter-publisher
(lambda (_) (jupyter-content 'ping))))
(pong (jupyter-publisher
(lambda (_)
(if (< (cl-decf n) 0)
(jupyter-unsubscribe)
(jupyter-content 'pong))))))
(jupyter-run-with-io pong
(jupyter-do
(jupyter-subscribe ping)
(jupyter-with-io ping
(jupyter-do
(jupyter-subscribe pong)
(jupyter-publish 'play)))))
(should (< n 0))))
(defun jupyter-test-dummy-msgs (req-id)
`((:header (:msg_id ,(jupyter-new-uuid)
:msg_type "status"
:username "nathan"
:session "5c5b72e9-48c4ae02e3eb1ca272fb0275"
:date "2020-05-22T13:29:34.756271Z"
:version "5.3")
:parent_header (:msg_id ,req-id
:msg_type "execute_request"
:version "5.3"
:username "nathan"
:session "7c1d195f-f10f-4c84-b5cc-ddba55e94689"
:date "2020-05-22T08:29:34.744583-05:00")
:metadata nil
:content (:execution_state "busy") :buffers nil :channel "iopub")
(:header (:msg_id ,(jupyter-new-uuid)
:msg_type "execute_reply"
:username "nathan"
:session "5c5b72e9-48c4ae02e3eb1ca272fb0275"
:date "2020-05-22T13:29:34.755354Z"
:version "5.3")
:parent_header (:msg_id ,req-id
:msg_type "execute_request"
:version "5.3"
:username "nathan"
:session "7c1d195f-f10f-4c84-b5cc-ddba55e94689"
:date "2020-05-22T08:29:34.744583-05:00")
:metadata nil
:content nil :buffers nil :channel "shell")
(:header (:msg_id ,(jupyter-new-uuid)
:msg_type "status"
:username "nathan"
:session "5c5b72e9-48c4ae02e3eb1ca272fb0275"
:date "2020-05-22T13:29:34.756271Z"
:version "5.3")
:parent_header (:msg_id ,req-id
:msg_type "execute_request"
:version "5.3"
:username "nathan"
:session "7c1d195f-f10f-4c84-b5cc-ddba55e94689"
:date "2020-05-22T08:29:34.744583-05:00")
:metadata nil
:content (:execution_state "idle") :buffers nil :channel "iopub")))
(ert-deftest fix-req-unsubscribe-mechanic ()
:tags '(monad)
(let ((unsubed-reqs '()))
(cl-labels ((idle-p
(req)
(jupyter-request-idle-p req))
(req-msg-p
(req msg)
(string= (jupyter-request-id req)
(jupyter-message-parent-id msg)))
(make-req-pub
(req)
(jupyter-publisher
(lambda (msg)
(cond
((idle-p req)
(push req unsubed-reqs)
(jupyter-unsubscribe))
((req-msg-p req msg)
(when (jupyter-message-status-idle-p msg)
(setf (jupyter-request-idle-p req) t))
(jupyter-content msg)))))))
(let* ((req1 (make-jupyter-request))
(req2 (make-jupyter-request))
(lst (append (jupyter-test-dummy-msgs
(jupyter-request-id req1))
(jupyter-test-dummy-msgs
(jupyter-request-id req2))))
(initial-msgs (copy-sequence lst))
(kernel-io (jupyter-publisher
(lambda (_)
(when lst
(jupyter-content (pop lst))))))
(client-msgs '())
(client-sub (jupyter-subscriber
(lambda (msg)
(push msg client-msgs)))))
;; A subscription chain for REQ1 (KIO -> REQ-PUB -> CLIENT-SUB)
(let ((req-pub (make-req-pub req1)))
(jupyter-run-with-io kernel-io
(jupyter-subscribe req-pub))
(jupyter-run-with-io req-pub
(jupyter-subscribe client-sub)))
;; Send a message down the chain
(jupyter-run-with-io kernel-io
(jupyter-publish 'emit))
;; Another chain for REQ2.
(let ((req-pub (make-req-pub req2)))
(jupyter-run-with-io kernel-io
(jupyter-subscribe req-pub))
(jupyter-run-with-io req-pub
(jupyter-subscribe client-sub)))
;; Send five messages. Now REQ1 and REQ2 messages will be
;; received by CLIENT-SUB.
(cl-loop
repeat 5
do (jupyter-run-with-io kernel-io
(jupyter-publish 'emit)))
(should (memq req1 unsubed-reqs))
(should (equal initial-msgs (reverse client-msgs)))))))
;; - `seq-elt'
;; - `seq-length'
;; - `seq-do'
;; - `seqp'
;; - `seq-subseq'
;; - `seq-into-sequence'
;; - `seq-copy'
;; - `seq-into'
(ert-deftest jupyter-seq-interface ()
:tags '(monad seq)
)
;;; jupyter-monad-test.el ends here