From b9fb970c925235be16cd04496235ed13eb31fb63 Mon Sep 17 00:00:00 2001 From: Bruno BARBIER Date: Sat, 25 Mar 2023 10:06:44 +0100 Subject: [PATCH 6/7] ob-haskell: Implement sessions * lisp/ob-haskell.el (org-babel-haskell-initiate-session): Implement sessions. (org-babel-haskell-with-session): New macro to manage sessions. (org-babel-interpret-haskell): Refactor code. Use `org-babel-haskell-with-session` to manage sessions. (org-babel-prep-session:haskell): Don't ignore the PARAMS argument. * testing/lisp/test-ob-haskell-ghci.el: Update tests related to sessions. --- lisp/ob-haskell.el | 98 +++++++++++++++++++++++----- testing/lisp/test-ob-haskell-ghci.el | 47 +++++++++---- 2 files changed, 116 insertions(+), 29 deletions(-) diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el index 6cec21217..cd930266c 100644 --- a/lisp/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -77,6 +77,32 @@ (defcustom org-babel-haskell-compiler "ghc" (defconst org-babel-header-args:haskell '((compile . :any)) "Haskell-specific header arguments.") + +(defun org-babel-haskell-with-session--worker (params todo) + "See `org-babel-haskell-with-session'." + (let* ((sn (cdr (assq :session params))) + (session (org-babel-haskell-initiate-session sn params)) + (one-shot (equal sn "none"))) + (unwind-protect + (funcall todo session) + (when (and one-shot (buffer-live-p session)) + ;; As we don't control how the session temporary buffer is + ;; created, we need to explicitly work around the hooks and + ;; query functions. + (with-current-buffer session + (let ((kill-buffer-query-functions nil) + (kill-buffer-hook nil)) + (kill-buffer session))))))) + +(defmacro org-babel-haskell-with-session (session-symbol params &rest body) + "Get the session identified by PARAMS and run BODY with it. + +Get or create a session, as needed to match PARAMS. Assign the session to +SESSION-SYMBOL. Execute BODY. Destroy the session if needed. +Return the value of the last form of BODY." + (declare (indent 2) (debug (symbolp form body))) + `(org-babel-haskell-with-session--worker ,params (lambda (,session-symbol) ,@body))) + (defun org-babel-haskell-execute (body params) "This function should only be called by `org-babel-execute:haskell'." (let* ((tmp-src-file (org-babel-temp-file "Haskell-src-" ".hs")) @@ -185,22 +211,64 @@ (defun org-babel-execute:haskell (body params) (org-babel-interpret-haskell body params) (org-babel-haskell-execute body params)))) -(defun org-babel-haskell-initiate-session (&optional _session _params) + + + +;; Variable defined in inf-haskell (haskell-mode package). +(defvar inferior-haskell-buffer) + +(defun org-babel-haskell-initiate-session (&optional session-name _params) "Initiate a haskell session. -If there is not a current inferior-process-buffer in SESSION -then create one. Return the initialized session." +Return the initialized session, i.e. the buffer for this session. +When SESSION-NAME is nil, use a global session named +\"*ob-haskell*\". When SESSION-NAME is the string \"none\", use +a temporary buffer. Else, (re)use the session named +SESSION-NAME. The buffer name is the session name. See also +`org-babel-haskell-with-session'." (org-require-package 'inf-haskell "haskell-mode") - (or (get-buffer "*haskell*") - (save-window-excursion - (run-haskell) - (sleep-for 0.25) - ;; Disable secondary prompt: If we do not do this, - ;; org-comint may treat secondary prompts as a part of - ;; output. - (org-babel-comint-input-command - (current-buffer) - ":set prompt-cont \"\"") - (current-buffer)))) + (cond + ((equal "none" session-name) + ;; Temporary buffer name. + (setq session-name (generate-new-buffer-name " *ob-haskell-tmp*"))) + ((eq nil session-name) + ;; The global default session. As haskell-mode is using the buffer + ;; named "*haskell*", we stay away from it. + (setq session-name "*ob-haskell*")) + ((not (stringp session-name)) + (error "session-name must be a string"))) + (let ((session (get-buffer session-name))) + ;; NOTE: By construction, as SESSION-NAME is a string, session is + ;; either nil or a live buffer. + (save-window-excursion + (or (org-babel-comint-buffer-livep session) + (let ((inferior-haskell-buffer session)) + ;; As inferior-haskell expects the buffer to be named + ;; "*haskell*", we rename it, unless the user explicitly + ;; requested to use the name "*haskell*". + (when (not (equal "*haskell*" session-name)) + (when (bufferp session) + (when (bufferp "*haskell*") + (user-error "Conflicting buffer '*haskell*', rename it or kill it")) + (with-current-buffer session (rename-buffer "*haskell*")))) + (unwind-protect + ;; We protect default-directory. + (let ((default-directory default-directory)) + (run-haskell) + (sleep-for 0.25) + (setq session inferior-haskell-buffer)) + (when (and (not (equal "*haskell*" session-name)) + (bufferp session)) + (with-current-buffer session (rename-buffer session-name)))) + ;; Disable secondary prompt: If we do not do this, + ;; org-comint may treat secondary prompts as a part of + ;; output. + (org-babel-comint-input-command + session + ":set prompt-cont \"\"") + session) + )) + session)) + (defun org-babel-load-session:haskell (session body params) "Load BODY into SESSION." @@ -215,7 +283,7 @@ (defun org-babel-load-session:haskell (session body params) (defun org-babel-prep-session:haskell (session params) "Prepare SESSION according to the header arguments in PARAMS." (save-window-excursion - (let ((buffer (org-babel-haskell-initiate-session session))) + (let ((buffer (org-babel-haskell-initiate-session session params))) (org-babel-comint-in-buffer buffer (mapc (lambda (line) (insert line) diff --git a/testing/lisp/test-ob-haskell-ghci.el b/testing/lisp/test-ob-haskell-ghci.el index 5049bc01a..adc9f939c 100644 --- a/testing/lisp/test-ob-haskell-ghci.el +++ b/testing/lisp/test-ob-haskell-ghci.el @@ -106,20 +106,39 @@ (ert-deftest ob-haskell/hello-world-output-multilines () (ert-deftest ob-haskell/sessions-must-not-share-variables () "Sessions must not share variables." - :expected-result :failed - (test-ob-haskell-ghci-with-global-session - (test-ob-haskell-ghci ":session s1" "x=2" nil :unprotected) - (should (equal 2 (test-ob-haskell-ghci ":session s1" "x" nil :unprotected))) - (test-ob-haskell-ghci ":session s2" "x=3" nil :unprotected) - (should-not (equal 3 (test-ob-haskell-ghci ":session s1" "x" nil :unprotected))) - )) - -(ert-deftest ob-haskell/no-session-means-one-shot-sessions () - "When no session, use a new session." - :expected-result :failed - (test-ob-haskell-ghci-with-global-session - (test-ob-haskell-ghci "" "x=2" nil :unprotected) - (should-not (equal 2 (test-ob-haskell-ghci "" "x" nil :unprotected))))) + (test-ob-haskell-ghci ":session s1" "x=2" nil) + (should (equal 2 (test-ob-haskell-ghci ":session s1" "x" nil))) + (test-ob-haskell-ghci ":session s2" "x=3" nil) + (should-not (equal 3 (test-ob-haskell-ghci ":session s1" "x" nil))) + ) + +(ert-deftest ob-haskell/session-named-none-means-one-shot-sessions () + "When no session, use a new session. +\"none\" is a special name that means `no session'." + (test-ob-haskell-ghci ":session none" "x=2" nil) + (should-not (equal 2 (test-ob-haskell-ghci ":session \"none\"" "x" nil))) + (test-ob-haskell-ghci ":session none" "x=2" nil) + (should-not (equal 2 (test-ob-haskell-ghci ":session \"none\"" "x" nil)))) + +(ert-deftest ob-haskell/reuse-variables-in-same-session () + "Reuse variables between blocks using the same session." + (test-ob-haskell-ghci ":session s1" "x=2" nil) + (should (equal 2 (test-ob-haskell-ghci ":session s1" "x")))) + +(ert-deftest ob-haskell/may-use-the-*haskell*-session () + "The user may use the special *haskell* buffer." + (when (get-buffer "*haskell*") + (error "A buffer named '*haskell*' exists. Can't run this test")) + (unwind-protect + (progn + (test-ob-haskell-ghci ":session *haskell*" "x=2" nil :unprotected) + (should (equal 2 (test-ob-haskell-ghci ":session *haskell*" "x" nil :unprotected)))) + (with-current-buffer "*haskell*" + (let ((kill-buffer-query-functions nil) + (kill-buffer-hook nil)) + (kill-buffer "*haskell*"))))) + + ;;;; Values -- 2.39.3