From d26447d0a0316058a3eb8cb5ea597f4f7ee24e14 Mon Sep 17 00:00:00 2001 From: Bruno BARBIER Date: Sat, 25 Mar 2023 09:59:31 +0100 Subject: [PATCH 5/7] lisp/ob-haskell: Request the last value from GHCi * lisp/ob-haskell.el (org-babel-interpret-haskell): When the result type is 'value, use the last value as defined by GHCi. (org-babel-haskell-eoe): New default value. (org-babel-interpret-haskell): Update for the new value of `org-babel-haskell-eoe'. * testing/lisp/test-ob-haskell-ghci.el: Update tests related to output/value. --- lisp/ob-haskell.el | 80 ++++++++++++++++++---------- testing/lisp/test-ob-haskell-ghci.el | 6 +-- 2 files changed, 53 insertions(+), 33 deletions(-) diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el index 8f9ae397a..6cec21217 100644 --- a/lisp/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -61,7 +61,7 @@ (defvar org-babel-default-header-args:haskell (defvar org-babel-haskell-lhs2tex-command "lhs2tex") -(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"") +(defvar org-babel-haskell-eoe "org-babel-haskell-eoe") (defvar haskell-prompt-regexp) @@ -127,34 +127,56 @@ (defun org-babel-interpret-haskell (body params) (lambda () (setq-local comint-prompt-regexp (concat haskell-prompt-regexp "\\|^λ?> ")))) - (let* ((session (cdr (assq :session params))) - (result-type (cdr (assq :result-type params))) - (full-body (org-babel-expand-body:generic - body params - (org-babel-variable-assignments:haskell params))) - (session (org-babel-haskell-initiate-session session params)) - (comint-preoutput-filter-functions - (cons 'ansi-color-filter-apply comint-preoutput-filter-functions)) - (raw (org-babel-comint-with-output - (session org-babel-haskell-eoe nil full-body) - (insert (org-trim full-body)) - (comint-send-input nil t) - (insert org-babel-haskell-eoe) - (comint-send-input nil t))) - (results (mapcar #'org-strip-quotes - (cdr (member org-babel-haskell-eoe - (reverse (mapcar #'org-trim raw))))))) - (org-babel-reassemble-table - (let ((result - (pcase result-type - (`output (mapconcat #'identity (reverse results) "\n")) - (`value (car results))))) - (org-babel-result-cond (cdr (assq :result-params params)) - result (when result (org-babel-script-escape result)))) - (org-babel-pick-name (cdr (assq :colname-names params)) - (cdr (assq :colname-names params))) - (org-babel-pick-name (cdr (assq :rowname-names params)) - (cdr (assq :rowname-names params)))))) + (org-babel-haskell-with-session session params + (cl-labels + ((send-txt-to-ghci (txt) + (insert txt) (comint-send-input nil t)) + (send-eoe () + (send-txt-to-ghci (concat "putStrLn \"" org-babel-haskell-eoe "\"\n"))) + (comint-with-output (todo) + (let ((comint-preoutput-filter-functions + (cons 'ansi-color-filter-apply + comint-preoutput-filter-functions))) + (org-babel-comint-with-output + (session org-babel-haskell-eoe nil nil) + (funcall todo))))) + (let* ((result-type (cdr (assq :result-type params))) + (full-body (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:haskell params))) + (raw (pcase result-type + (`output + (comint-with-output + (lambda () (send-txt-to-ghci (org-trim full-body)) (send-eoe)))) + (`value + ;; We first compute the value and store it, + ;; ignoring any output. + (comint-with-output + (lambda () + (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__=()::()\n") + (send-txt-to-ghci (org-trim full-body)) + (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__=it\n") + (send-eoe))) + ;; We now display and capture the value. + (comint-with-output + (lambda() + (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__\n") + (send-eoe)))))) + (results (mapcar #'org-strip-quotes + (cdr (member org-babel-haskell-eoe + (reverse (mapcar #'org-trim raw))))))) + (org-babel-reassemble-table + (let ((result + (pcase result-type + (`output (mapconcat #'identity (reverse results) "\n")) + (`value (car results))))) + (org-babel-result-cond (cdr (assq :result-params params)) + result (when result (org-babel-script-escape result)))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colname-names params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rowname-names params)))))))) + (defun org-babel-execute:haskell (body params) "Execute a block of Haskell code." diff --git a/testing/lisp/test-ob-haskell-ghci.el b/testing/lisp/test-ob-haskell-ghci.el index 868a56e63..5049bc01a 100644 --- a/testing/lisp/test-ob-haskell-ghci.el +++ b/testing/lisp/test-ob-haskell-ghci.el @@ -86,8 +86,8 @@ (ert-deftest ob-haskell/hello-world-output () (test-ob-haskell-ghci ":results output" "putStrLn \"Hello World!\"")))) (ert-deftest ob-haskell/hello-world-output-nothing () - :expected-result :failed - (should (equal "" + ;; GHCi prints the value on standard output. So, the last value is part of the output. + (should (equal "Hello World!" (test-ob-haskell-ghci ":results output" "return \"Hello World!\"")))) (ert-deftest ob-haskell/hello-world-output-multilines () @@ -391,12 +391,10 @@ (ert-deftest ob-haskell/results-value-2 () (ert-deftest ob-haskell/results-value-3 () "Don't confuse output and values: nothing." - :expected-result :failed (should (equal nil (test-ob-haskell-ghci ":results value" "putStrLn \"3\"")))) (ert-deftest ob-haskell/results-value-4 () "Don't confuse output and values: nothing." - :expected-result :failed (should (equal nil (test-ob-haskell-ghci ":results value" " putStrLn \"3\" return () -- 2.39.3