forked from mirrors/org-mode
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.
This commit is contained in:
parent
b852172170
commit
924c2dd836
|
@ -61,7 +61,7 @@
|
|||
|
||||
(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 @@ a parameter, such as \"ghc -v\"."
|
|||
(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."
|
||||
|
|
|
@ -88,8 +88,8 @@ before the code block. When UNPROTECTED is non-nil, check pre/post conditions."
|
|||
(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 ()
|
||||
|
@ -393,12 +393,10 @@ readIORef r
|
|||
|
||||
(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 ()
|
||||
|
|
Loading…
Reference in New Issue