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.

* testing/lisp/test-ob-haskell-ghci.el: Update tests related to
sessions.

lisp/ob-haskell.el

@@ -77,6 +77,32 @@ a parameter, such as \"ghc -v\"."
 (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 @@ a parameter, such as \"ghc -v\"."
 	(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 temporarily rename it while executing
+            ;; `run-haskell' (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
+                (let ((inferior-haskell-root-dir 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."

testing/lisp/test-ob-haskell-ghci.el

@@ -108,20 +108,39 @@ main
 
 (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)))
-   ))
+  (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*")))))
+
 
-(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)))))
 
 
 ;;;; Values