ob-haskell.el (11466B)
1 ;;; ob-haskell.el --- Babel Functions for Haskell -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2023 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 (defun org-babel-haskell-execute (body params) 81 "This function should only be called by `org-babel-execute:haskell'." 82 (let* ((tmp-src-file (org-babel-temp-file "Haskell-src-" ".hs")) 83 (tmp-bin-file 84 (org-babel-process-file-name 85 (org-babel-temp-file "Haskell-bin-" org-babel-exeext))) 86 (cmdline (cdr (assq :cmdline params))) 87 (cmdline (if cmdline (concat " " cmdline) "")) 88 (flags (cdr (assq :flags params))) 89 (flags (mapconcat #'identity 90 (if (listp flags) 91 flags 92 (list flags)) 93 " ")) 94 (libs (org-babel-read 95 (or (cdr (assq :libs params)) 96 (org-entry-get nil "libs" t)) 97 nil)) 98 (libs (mapconcat #'identity 99 (if (listp libs) libs (list libs)) 100 " "))) 101 (with-temp-file tmp-src-file (insert body)) 102 (org-babel-eval 103 (format "%s -o %s %s %s %s" 104 org-babel-haskell-compiler 105 tmp-bin-file 106 flags 107 (org-babel-process-file-name tmp-src-file) 108 libs) 109 "") 110 (let ((results (org-babel-eval (concat tmp-bin-file cmdline) ""))) 111 (when results 112 (setq results (org-trim (org-remove-indentation results))) 113 (org-babel-reassemble-table 114 (org-babel-result-cond (cdr (assq :result-params params)) 115 (org-babel-read results t) 116 (let ((tmp-file (org-babel-temp-file "Haskell-"))) 117 (with-temp-file tmp-file (insert results)) 118 (org-babel-import-elisp-from-file tmp-file))) 119 (org-babel-pick-name 120 (cdr (assq :colname-names params)) (cdr (assq :colnames params))) 121 (org-babel-pick-name 122 (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))) 123 124 (defun org-babel-interpret-haskell (body params) 125 (require 'inf-haskell) 126 (add-hook 'inferior-haskell-hook 127 (lambda () 128 (setq-local comint-prompt-regexp 129 (concat haskell-prompt-regexp "\\|^λ?> ")))) 130 (let* ((session (cdr (assq :session params))) 131 (result-type (cdr (assq :result-type params))) 132 (full-body (org-babel-expand-body:generic 133 body params 134 (org-babel-variable-assignments:haskell params))) 135 (session (org-babel-haskell-initiate-session session params)) 136 (comint-preoutput-filter-functions 137 (cons 'ansi-color-filter-apply comint-preoutput-filter-functions)) 138 (raw (org-babel-comint-with-output 139 (session org-babel-haskell-eoe nil full-body) 140 (insert (org-trim full-body)) 141 (comint-send-input nil t) 142 (insert org-babel-haskell-eoe) 143 (comint-send-input nil t))) 144 (results (mapcar #'org-strip-quotes 145 (cdr (member org-babel-haskell-eoe 146 (reverse (mapcar #'org-trim raw))))))) 147 (org-babel-reassemble-table 148 (let ((result 149 (pcase result-type 150 (`output (mapconcat #'identity (reverse results) "\n")) 151 (`value (car results))))) 152 (org-babel-result-cond (cdr (assq :result-params params)) 153 result (when result (org-babel-script-escape result)))) 154 (org-babel-pick-name (cdr (assq :colname-names params)) 155 (cdr (assq :colname-names params))) 156 (org-babel-pick-name (cdr (assq :rowname-names params)) 157 (cdr (assq :rowname-names params)))))) 158 159 (defun org-babel-execute:haskell (body params) 160 "Execute a block of Haskell code." 161 (let ((compile (string= "yes" (cdr (assq :compile params))))) 162 (if (not compile) 163 (org-babel-interpret-haskell body params) 164 (org-babel-haskell-execute body params)))) 165 166 (defun org-babel-haskell-initiate-session (&optional _session _params) 167 "Initiate a haskell session. 168 If there is not a current inferior-process-buffer in SESSION 169 then create one. Return the initialized session." 170 (require 'inf-haskell) 171 (or (get-buffer "*haskell*") 172 (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer)))) 173 174 (defun org-babel-load-session:haskell (session body params) 175 "Load BODY into SESSION." 176 (save-window-excursion 177 (let* ((buffer (org-babel-prep-session:haskell session params)) 178 (load-file (concat (org-babel-temp-file "haskell-load-") ".hs"))) 179 (with-temp-buffer 180 (insert body) (write-file load-file) 181 (haskell-mode) (inferior-haskell-load-file)) 182 buffer))) 183 184 (defun org-babel-prep-session:haskell (session params) 185 "Prepare SESSION according to the header arguments in PARAMS." 186 (save-window-excursion 187 (let ((buffer (org-babel-haskell-initiate-session session))) 188 (org-babel-comint-in-buffer buffer 189 (mapc (lambda (line) 190 (insert line) 191 (comint-send-input nil t)) 192 (org-babel-variable-assignments:haskell params))) 193 (current-buffer)))) 194 195 (defun org-babel-variable-assignments:haskell (params) 196 "Return list of haskell statements assigning the block's variables." 197 (mapcar (lambda (pair) 198 (format "let %s = %s" 199 (car pair) 200 (org-babel-haskell-var-to-haskell (cdr pair)))) 201 (org-babel--get-vars params))) 202 203 (defun org-babel-haskell-var-to-haskell (var) 204 "Convert an elisp value VAR into a haskell variable. 205 The elisp VAR is converted to a string of haskell source code 206 specifying a variable of the same value." 207 (if (listp var) 208 (concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]") 209 (format "%S" var))) 210 211 (defvar org-export-copy-to-kill-ring) 212 (declare-function org-export-to-file "ox" 213 (backend file 214 &optional async subtreep visible-only body-only 215 ext-plist post-process)) 216 (defun org-babel-haskell-export-to-lhs (&optional arg) 217 "Export to a .lhs file with all haskell code blocks escaped. 218 When called with a prefix argument the resulting 219 .lhs file will be exported to a .tex file. This function will 220 create two new files, base-name.lhs and base-name.tex where 221 base-name is the name of the current Org file. 222 223 Note that all standard Babel literate programming 224 constructs (header arguments, no-web syntax etc...) are ignored." 225 (interactive "P") 226 (let* ((contents (buffer-string)) 227 (haskell-regexp 228 (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)[\r\n]" 229 "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*")) 230 (base-name (file-name-sans-extension (buffer-file-name))) 231 (tmp-file (org-babel-temp-file "haskell-")) 232 (tmp-org-file (concat tmp-file ".org")) 233 (tmp-tex-file (concat tmp-file ".tex")) 234 (lhs-file (concat base-name ".lhs")) 235 (tex-file (concat base-name ".tex")) 236 (command (concat org-babel-haskell-lhs2tex-command 237 " " (org-babel-process-file-name lhs-file) 238 " > " (org-babel-process-file-name tex-file))) 239 (preserve-indentp org-src-preserve-indentation) 240 indentation) 241 ;; escape haskell source-code blocks 242 (with-temp-file tmp-org-file 243 (insert contents) 244 (goto-char (point-min)) 245 (while (re-search-forward haskell-regexp nil t) 246 (save-match-data (setq indentation (length (match-string 1)))) 247 (replace-match (save-match-data 248 (concat 249 "#+begin_export latex\n\\begin{code}\n" 250 (if (or preserve-indentp 251 (string-match "-i" (match-string 2))) 252 (match-string 3) 253 (org-remove-indentation (match-string 3))) 254 "\n\\end{code}\n#+end_export\n")) 255 t t) 256 (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) 257 (save-excursion 258 ;; export to latex w/org and save as .lhs 259 (require 'ox-latex) 260 (find-file tmp-org-file) 261 ;; Ensure we do not clutter kill ring with incomplete results. 262 (let (org-export-copy-to-kill-ring) 263 (org-export-to-file 'latex tmp-tex-file)) 264 (kill-buffer nil) 265 (delete-file tmp-org-file) 266 (find-file tmp-tex-file) 267 (goto-char (point-min)) (forward-line 2) 268 (insert "%include polycode.fmt\n") 269 ;; ensure all \begin/end{code} statements start at the first column 270 (while (re-search-forward "^[ \t]+\\\\begin{code}[^\000]+\\\\end{code}" nil t) 271 (replace-match (save-match-data (org-remove-indentation (match-string 0))) 272 t t)) 273 (setq contents (buffer-string)) 274 (save-buffer) (kill-buffer nil)) 275 (delete-file tmp-tex-file) 276 ;; save org exported latex to a .lhs file 277 (with-temp-file lhs-file (insert contents)) 278 (if (not arg) 279 (find-file lhs-file) 280 ;; process .lhs file with lhs2tex 281 (message "running %s" command) (shell-command command) (find-file tex-file)))) 282 283 (provide 'ob-haskell) 284 285 ;;; ob-haskell.el ends here