ob-haskell.el (16236B)
1 ;;; ob-haskell.el --- Babel Functions for Haskell -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2024 Free Software Foundation, Inc. 4 5 ;; Author: Eric Schulte 6 ;; Maintainer: Lawrence Bottorff <borgauf@gmail.com> 7 ;; Keywords: literate programming, reproducible research 8 ;; URL: https://orgmode.org 9 10 ;; This file is part of GNU Emacs. 11 12 ;; GNU Emacs is free software: you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation, either version 3 of the License, or 15 ;; (at your option) any later version. 16 17 ;; GNU Emacs is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25 ;;; Commentary: 26 27 ;; Org Babel support for evaluating Haskell source code. 28 ;; Haskell programs must be compiled before 29 ;; they can be run, but haskell code can also be run through an 30 ;; interactive interpreter. 31 ;; 32 ;; By default we evaluate using the Haskell interpreter. 33 ;; To use the compiler, specify :compile yes in the header. 34 35 ;;; Requirements: 36 37 ;; - haskell-mode: https://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode 38 ;; - inf-haskell: https://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode 39 ;; - (optionally) lhs2tex: https://people.cs.uu.nl/andres/lhs2tex/ 40 41 ;;; Code: 42 43 (require 'org-macs) 44 (org-assert-version) 45 46 (require 'ob) 47 (require 'org-macs) 48 (require 'comint) 49 50 (declare-function haskell-mode "ext:haskell-mode" ()) 51 (declare-function run-haskell "ext:inf-haskell" (&optional arg)) 52 (declare-function inferior-haskell-load-file 53 "ext:inf-haskell" (&optional reload)) 54 (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) 55 56 (defvar org-babel-tangle-lang-exts) 57 (add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) 58 59 (defvar org-babel-default-header-args:haskell 60 '((:padlines . "no"))) 61 62 (defvar org-babel-haskell-lhs2tex-command "lhs2tex") 63 64 (defvar org-babel-haskell-eoe "org-babel-haskell-eoe") 65 66 (defvar haskell-prompt-regexp) 67 68 (defcustom org-babel-haskell-compiler "ghc" 69 "Command used to compile a Haskell source code file into an executable. 70 May be either a command in the path, like \"ghc\" or an absolute 71 path name, like \"/usr/local/bin/ghc\". The command can include 72 a parameter, such as \"ghc -v\"." 73 :group 'org-babel 74 :package-version '(Org "9.4") 75 :type 'string) 76 77 (defconst org-babel-header-args:haskell '((compile . :any)) 78 "Haskell-specific header arguments.") 79 80 81 (defun org-babel-haskell-with-session--worker (params todo) 82 "See `org-babel-haskell-with-session'." 83 (let* ((sn (cdr (assq :session params))) 84 (session (org-babel-haskell-initiate-session sn params)) 85 (one-shot (equal sn "none"))) 86 (unwind-protect 87 (funcall todo session) 88 (when (and one-shot (buffer-live-p session)) 89 ;; As we don't control how the session temporary buffer is 90 ;; created, we need to explicitly work around the hooks and 91 ;; query functions. 92 (with-current-buffer session 93 (let ((kill-buffer-query-functions nil) 94 (kill-buffer-hook nil)) 95 (kill-buffer session))))))) 96 97 (defmacro org-babel-haskell-with-session (session-symbol params &rest body) 98 "Get the session identified by PARAMS and run BODY with it. 99 100 Get or create a session, as needed to match PARAMS. Assign the session to 101 SESSION-SYMBOL. Execute BODY. Destroy the session if needed. 102 Return the value of the last form of BODY." 103 (declare (indent 2) (debug (symbolp form body))) 104 `(org-babel-haskell-with-session--worker ,params (lambda (,session-symbol) ,@body))) 105 106 (defun org-babel-haskell-execute (body params) 107 "Execute Haskell BODY according to PARAMS. 108 This function should only be called by `org-babel-execute:haskell'." 109 (let* ((tmp-src-file (org-babel-temp-file "Haskell-src-" ".hs")) 110 (tmp-bin-file 111 (org-babel-process-file-name 112 (org-babel-temp-file "Haskell-bin-" org-babel-exeext))) 113 (cmdline (cdr (assq :cmdline params))) 114 (cmdline (if cmdline (concat " " cmdline) "")) 115 (flags (cdr (assq :flags params))) 116 (flags (mapconcat #'identity 117 (if (listp flags) 118 flags 119 (list flags)) 120 " ")) 121 (libs (org-babel-read 122 (or (cdr (assq :libs params)) 123 (org-entry-get nil "libs" t)) 124 nil)) 125 (libs (mapconcat #'identity 126 (if (listp libs) libs (list libs)) 127 " "))) 128 (with-temp-file tmp-src-file (insert body)) 129 (org-babel-eval 130 (format "%s -o %s %s %s %s" 131 org-babel-haskell-compiler 132 tmp-bin-file 133 flags 134 (org-babel-process-file-name tmp-src-file) 135 libs) 136 "") 137 (let ((results (org-babel-eval (concat tmp-bin-file cmdline) ""))) 138 (when results 139 (setq results (org-trim (org-remove-indentation results))) 140 (org-babel-reassemble-table 141 (org-babel-result-cond (cdr (assq :result-params params)) 142 (org-babel-read results t) 143 (let ((tmp-file (org-babel-temp-file "Haskell-"))) 144 (with-temp-file tmp-file (insert results)) 145 (org-babel-import-elisp-from-file tmp-file))) 146 (org-babel-pick-name 147 (cdr (assq :colname-names params)) (cdr (assq :colnames params))) 148 (org-babel-pick-name 149 (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))) 150 151 (defun org-babel-interpret-haskell (body params) 152 (org-require-package 'inf-haskell "haskell-mode") 153 (add-hook 'inferior-haskell-hook 154 (lambda () 155 (setq-local 156 org-babel-comint-prompt-regexp-old comint-prompt-regexp 157 comint-prompt-regexp 158 (concat haskell-prompt-regexp "\\|^λ?> ")))) 159 (org-babel-haskell-with-session session params 160 (cl-labels 161 ((send-txt-to-ghci (txt) 162 (insert txt) (comint-send-input nil t)) 163 (send-eoe () 164 (send-txt-to-ghci (concat "putStrLn \"" org-babel-haskell-eoe "\"\n"))) 165 (comint-with-output (todo) 166 (let ((comint-preoutput-filter-functions 167 (cons 'ansi-color-filter-apply 168 comint-preoutput-filter-functions))) 169 (org-babel-comint-with-output 170 (session org-babel-haskell-eoe nil nil) 171 (funcall todo))))) 172 (let* ((result-type (cdr (assq :result-type params))) 173 (full-body (org-babel-expand-body:generic 174 body params 175 (org-babel-variable-assignments:haskell params))) 176 (raw (pcase result-type 177 (`output 178 (comint-with-output 179 (lambda () (send-txt-to-ghci (org-trim full-body)) (send-eoe)))) 180 (`value 181 ;; We first compute the value and store it, 182 ;; ignoring any output. 183 (comint-with-output 184 (lambda () 185 (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__=()::()\n") 186 (send-txt-to-ghci (org-trim full-body)) 187 (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__=it\n") 188 (send-eoe))) 189 ;; We now display and capture the value. 190 (comint-with-output 191 (lambda() 192 (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__\n") 193 (send-eoe)))))) 194 (results (mapcar #'org-strip-quotes 195 (cdr (member org-babel-haskell-eoe 196 (reverse (mapcar #'org-trim raw))))))) 197 (org-babel-reassemble-table 198 (let ((result 199 (pcase result-type 200 (`output (mapconcat #'identity (reverse results) "\n")) 201 (`value (car results))))) 202 (org-babel-result-cond (cdr (assq :result-params params)) 203 result (when result (org-babel-script-escape result)))) 204 (org-babel-pick-name (cdr (assq :colname-names params)) 205 (cdr (assq :colname-names params))) 206 (org-babel-pick-name (cdr (assq :rowname-names params)) 207 (cdr (assq :rowname-names params)))))))) 208 209 210 (defun org-babel-execute:haskell (body params) 211 "Execute a block of Haskell code." 212 (let ((compile (string= "yes" (cdr (assq :compile params))))) 213 (if (not compile) 214 (org-babel-interpret-haskell body params) 215 (org-babel-haskell-execute body params)))) 216 217 218 219 220 ;; Variable defined in inf-haskell (haskell-mode package). 221 (defvar inferior-haskell-buffer) 222 (defvar inferior-haskell-root-dir) 223 224 (defun org-babel-haskell-initiate-session (&optional session-name _params) 225 "Initiate a haskell session. 226 Return the initialized session, i.e. the buffer for this session. 227 When SESSION-NAME is nil, use a global session named 228 \"*ob-haskell*\". When SESSION-NAME is the string \"none\", use 229 a temporary buffer. Else, (re)use the session named 230 SESSION-NAME. The buffer name is the session name. See also 231 `org-babel-haskell-with-session'." 232 (org-require-package 'inf-haskell "haskell-mode") 233 (cond 234 ((equal "none" session-name) 235 ;; Temporary buffer name. 236 (setq session-name (generate-new-buffer-name " *ob-haskell-tmp*"))) 237 ((eq nil session-name) 238 ;; The global default session. As haskell-mode is using the buffer 239 ;; named "*haskell*", we stay away from it. 240 (setq session-name "*ob-haskell*")) 241 ((not (stringp session-name)) 242 (error "session-name must be a string"))) 243 (let ((session (get-buffer session-name))) 244 ;; NOTE: By construction, as SESSION-NAME is a string, session is 245 ;; either nil or a live buffer. 246 (save-window-excursion 247 (or (org-babel-comint-buffer-livep session) 248 (let ((inferior-haskell-buffer session)) 249 ;; As inferior-haskell expects the buffer to be named 250 ;; "*haskell*", we temporarily rename it while executing 251 ;; `run-haskell' (unless the user explicitly requested to 252 ;; use the name "*haskell*"). 253 (when (not (equal "*haskell*" session-name)) 254 (when (bufferp session) 255 (when (bufferp "*haskell*") 256 (user-error "Conflicting buffer '*haskell*', rename it or kill it")) 257 (with-current-buffer session (rename-buffer "*haskell*")))) 258 (unwind-protect 259 (let ((inferior-haskell-root-dir default-directory)) 260 (run-haskell) 261 (sleep-for 0.25) 262 (setq session inferior-haskell-buffer)) 263 (when (and (not (equal "*haskell*" session-name)) 264 (bufferp session)) 265 (with-current-buffer session (rename-buffer session-name)))) 266 ;; Disable secondary prompt: If we do not do this, 267 ;; org-comint may treat secondary prompts as a part of 268 ;; output. 269 (org-babel-comint-input-command 270 session 271 ":set prompt-cont \"\"") 272 session) 273 )) 274 session)) 275 276 277 (defun org-babel-load-session:haskell (session body params) 278 "Load BODY into SESSION." 279 (save-window-excursion 280 (let* ((buffer (org-babel-prep-session:haskell session params)) 281 (load-file (concat (org-babel-temp-file "haskell-load-") ".hs"))) 282 (with-temp-buffer 283 (insert body) (write-file load-file) 284 (haskell-mode) (inferior-haskell-load-file)) 285 buffer))) 286 287 (defun org-babel-prep-session:haskell (session params) 288 "Prepare SESSION according to the header arguments in PARAMS." 289 (save-window-excursion 290 (let ((buffer (org-babel-haskell-initiate-session session))) 291 (org-babel-comint-in-buffer buffer 292 (mapc (lambda (line) 293 (insert line) 294 (comint-send-input nil t)) 295 (org-babel-variable-assignments:haskell params))) 296 (current-buffer)))) 297 298 (defun org-babel-variable-assignments:haskell (params) 299 "Return list of haskell statements assigning the block's variables." 300 (mapcar (lambda (pair) 301 (format "let %s = %s" 302 (car pair) 303 (org-babel-haskell-var-to-haskell (cdr pair)))) 304 (org-babel--get-vars params))) 305 306 (defun org-babel-haskell-var-to-haskell (var) 307 "Convert an elisp value VAR into a haskell variable. 308 The elisp VAR is converted to a string of haskell source code 309 specifying a variable of the same value." 310 (if (listp var) 311 (concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]") 312 (format "%S" var))) 313 314 (defvar org-export-copy-to-kill-ring) 315 (declare-function org-export-to-file "ox" 316 (backend file 317 &optional async subtreep visible-only body-only 318 ext-plist post-process)) 319 (defun org-babel-haskell-export-to-lhs (&optional arg) 320 "Export to a .lhs file with all haskell code blocks escaped. 321 When called with a prefix argument the resulting 322 .lhs file will be exported to a .tex file. This function will 323 create two new files, base-name.lhs and base-name.tex where 324 base-name is the name of the current Org file. 325 326 Note that all standard Babel literate programming 327 constructs (header arguments, no-web syntax etc...) are ignored." 328 (interactive "P") 329 (let* ((contents (buffer-string)) 330 (haskell-regexp 331 (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)[\r\n]" 332 "\\(\\(?:.\\|\n\\)*?\\)[\r\n][ \t]*#\\+end_src.*")) 333 (base-name (file-name-sans-extension (buffer-file-name))) 334 (tmp-file (org-babel-temp-file "haskell-")) 335 (tmp-org-file (concat tmp-file ".org")) 336 (tmp-tex-file (concat tmp-file ".tex")) 337 (lhs-file (concat base-name ".lhs")) 338 (tex-file (concat base-name ".tex")) 339 (command (concat org-babel-haskell-lhs2tex-command 340 " " (org-babel-process-file-name lhs-file) 341 " > " (org-babel-process-file-name tex-file))) 342 (preserve-indentp org-src-preserve-indentation) 343 indentation) 344 ;; escape haskell source-code blocks 345 (with-temp-file tmp-org-file 346 (insert contents) 347 (goto-char (point-min)) 348 (while (re-search-forward haskell-regexp nil t) 349 (save-match-data (setq indentation (length (match-string 1)))) 350 (replace-match (save-match-data 351 (concat 352 "#+begin_export latex\n\\begin{code}\n" 353 (if (or preserve-indentp 354 (string-match "-i" (match-string 2))) 355 (match-string 3) 356 (org-remove-indentation (match-string 3))) 357 "\n\\end{code}\n#+end_export\n")) 358 t t) 359 (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) 360 (save-excursion 361 (unwind-protect 362 (with-temp-buffer 363 ;; Export to latex w/org and save as .lhs 364 (require 'ox-latex) 365 (insert-file-contents tmp-org-file) 366 ;; Ensure we do not clutter kill ring with incomplete results. 367 (let (org-export-copy-to-kill-ring) 368 (org-export-to-file 'latex tmp-tex-file))) 369 (delete-file tmp-org-file)) 370 (unwind-protect 371 (with-temp-buffer 372 (insert-file-contents tmp-tex-file) 373 (goto-char (point-min)) (forward-line 2) 374 (insert "%include polycode.fmt\n") 375 ;; ensure all \begin/end{code} statements start at the first column 376 (while (re-search-forward "^[ \t]+\\\\begin{code}\\(?:.\\|\n\\)+\\\\end{code}" nil t) 377 (replace-match (save-match-data (org-remove-indentation (match-string 0))) 378 t t)) 379 ;; save org exported latex to a .lhs file 380 (write-region nil nil lhs-file)) 381 (delete-file tmp-tex-file))) 382 (if (not arg) 383 (find-file lhs-file) 384 ;; process .lhs file with lhs2tex 385 (message "running %s" command) (shell-command command) (find-file tex-file)))) 386 387 (provide 'ob-haskell) 388 389 ;;; ob-haskell.el ends here