/vendor/haskell-mode/haskell-indentation.el

http://github.com/rejeep/emacs · Emacs Lisp · 904 lines · 767 code · 93 blank · 44 comment · 3 complexity · eabe956fbc763a25f9b3ce1c819d86c5 MD5 · raw file

  1. ;;; haskell-indentation.el -- indentation module for Haskell Mode
  2. ;; Copyright 2009 Kristof Bastiaensen
  3. ;; Author: 2009 Kristof Bastiaensen <kristof.bastiaensen@vleeuwen.org>
  4. ;; This file is not part of GNU Emacs.
  5. ;; This file is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation; either version 3, or (at your option)
  8. ;; any later version.
  9. ;; This file is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  15. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  16. ;; Boston, MA 02111-1307, USA.
  17. ;;; Commentary:
  18. ;; Installation:
  19. ;;
  20. ;; To turn indentation on for all Haskell buffers under Haskell mode
  21. ;; <http://www.haskell.org/haskell-mode/> add this to .emacs:
  22. ;;
  23. ;; (add-hook haskell-mode-hook 'turn-on-haskell-indentation)
  24. ;;
  25. ;; Otherwise, call `haskell-indentation-mode'.
  26. ;;
  27. ;;; Code:
  28. (require 'syntax nil t) ; Emacs 21 add-on
  29. (defgroup haskell-indentation nil
  30. "Haskell indentation."
  31. :group 'haskell
  32. :prefix "haskell-indentation-")
  33. (defcustom haskell-indentation-cycle-warn t
  34. "Warn before moving to the leftmost indentation, if you tab at the rightmost one."
  35. :type 'boolean
  36. :group 'haskell-indentation)
  37. (defcustom haskell-indentation-layout-offset 2
  38. "Extra indentation to add before expressions in a haskell layout list."
  39. :type 'integer
  40. :group 'haskell-indentation)
  41. (defcustom haskell-indentation-starter-offset 1
  42. "Extra indentation after an opening keyword (e.g. let)."
  43. :type 'integer
  44. :group 'haskell-indentation)
  45. (defcustom haskell-indentation-left-offset 2
  46. "Extra indentation after an indentation to the left (e.g. after do)."
  47. :type 'integer
  48. :group 'haskell-indentation)
  49. (defcustom haskell-indentation-ifte-offset 2
  50. "Extra indentation after the keywords `if' `then' or `else'."
  51. :type 'integer
  52. :group 'haskell-indentation)
  53. (defcustom haskell-indentation-where-pre-offset 2
  54. "Extra indentation before the keyword `where'."
  55. :type 'integer
  56. :group 'haskell-indentation)
  57. (defcustom haskell-indentation-where-post-offset 2
  58. "Extra indentation after the keyword `where'."
  59. :type 'integer
  60. :group 'haskell-indentation)
  61. ;; Avoid a global bogus definition (which the original run-time
  62. ;; `defun' made), and support Emacs 21 without the syntax.el add-on.
  63. (eval-when-compile
  64. (unless (fboundp 'syntax-ppss)
  65. (defsubst syntax-ppss (&rest pos)
  66. (parse-partial-sexp (point-min) (or pos (point))))))
  67. (defconst haskell-indentation-mode-map
  68. (let ((keymap (make-sparse-keymap)))
  69. (define-key keymap [?\r] 'haskell-newline-and-indent)
  70. (define-key keymap [backspace] 'haskell-indentation-delete-backward-char)
  71. (define-key keymap [?\C-d] 'haskell-indentation-delete-char)
  72. keymap))
  73. ;;;###autoload
  74. (define-minor-mode haskell-indentation-mode
  75. "Haskell indentation mode that deals with the layout rule.
  76. It rebinds RET, DEL and BACKSPACE, so that indentations can be
  77. set and deleted as if they were real tabs. It supports
  78. autofill-mode."
  79. :lighter " Ind"
  80. :keymap haskell-indentation-mode-map
  81. (kill-local-variable 'indent-line-function)
  82. (kill-local-variable 'normal-auto-fill-function)
  83. (when haskell-indentation-mode
  84. (setq max-lisp-eval-depth (max max-lisp-eval-depth 600)) ;; set a higher limit for recursion
  85. (set (make-local-variable 'indent-line-function)
  86. 'haskell-indentation-indent-line)
  87. (set (make-local-variable 'normal-auto-fill-function)
  88. 'haskell-indentation-auto-fill-function)
  89. (set (make-local-variable 'haskell-indent-last-position)
  90. nil)))
  91. (defun turn-on-haskell-indentation ()
  92. "Turn on the haskell-indentation minor mode."
  93. (interactive)
  94. (haskell-indentation-mode t))
  95. (put 'parse-error
  96. 'error-conditions
  97. '(error parse-error))
  98. (put 'parse-error 'error-message "Parse error")
  99. (defun parse-error (&rest args)
  100. (signal 'parse-error (apply 'format args)))
  101. (defmacro on-parse-error (except &rest body)
  102. `(condition-case parse-error-string
  103. (progn ,@body)
  104. (parse-error
  105. ,except
  106. (message "%s" (cdr parse-error-string)))))
  107. (defun haskell-current-column ()
  108. "Compute current column according to haskell syntax rules,
  109. correctly ignoring composition."
  110. (save-excursion
  111. (let ((start (point))
  112. (cc 0))
  113. (beginning-of-line)
  114. (while (< (point) start)
  115. (if (= (char-after) ?\t)
  116. (setq cc (* 8 (+ 1 (/ cc 8))))
  117. (incf cc))
  118. (forward-char))
  119. cc)))
  120. (defun kill-indented-line (&optional arg)
  121. "`kill-line' for indented text.
  122. Preserves indentation and removes extra whitespace"
  123. (interactive "P")
  124. (let ((col (haskell-current-column))
  125. (old-point (point)))
  126. (cond ((or (and (numberp arg) (< arg 0))
  127. (and (not (looking-at "[ \t]*$"))
  128. (or (not (numberp arg)) (zerop arg))))
  129. ;use default behavior when calling with a negative argument
  130. ;or killing (once) from the middle of a line
  131. (kill-line arg))
  132. ((and (skip-chars-backward " \t") ;always true
  133. (bolp)
  134. (save-excursion
  135. (forward-line arg)
  136. (not (looking-at "[ \t]*$"))))
  137. ; killing from an empty line:
  138. ; preserve indentation of the next line
  139. (kill-region (point)
  140. (save-excursion
  141. (forward-line arg)
  142. (point)))
  143. (skip-chars-forward " \t")
  144. (if (> (haskell-current-column) col)
  145. (move-to-column col)))
  146. (t ; killing from not empty line:
  147. ; kill all indentation
  148. (goto-char old-point)
  149. (kill-region (point)
  150. (save-excursion
  151. (forward-line arg)
  152. (skip-chars-forward " \t")
  153. (point)))))))
  154. (defun haskell-indentation-auto-fill-function ()
  155. (when (> (haskell-current-column) fill-column)
  156. (while (> (haskell-current-column) fill-column)
  157. (skip-syntax-backward "-")
  158. (skip-syntax-backward "^-"))
  159. (let ((auto-fill-function nil)
  160. (indent (car (last (haskell-indentation-find-indentations)))))
  161. (newline)
  162. (indent-to indent)
  163. (end-of-line))))
  164. (defun haskell-indentation-reindent (col)
  165. (beginning-of-line)
  166. (delete-region (point)
  167. (progn (skip-syntax-forward "-")
  168. (point)))
  169. (indent-to col))
  170. (defun haskell-newline-and-indent ()
  171. (interactive)
  172. (on-parse-error (newline)
  173. (let* ((cc (haskell-current-column))
  174. (ci (current-indentation))
  175. (indentations (haskell-indentation-find-indentations)))
  176. (skip-syntax-forward "-")
  177. (if (prog1 (and (eolp)
  178. (not (= (haskell-current-column) ci)))
  179. (newline))
  180. (haskell-indentation-reindent
  181. (max (haskell-indentation-butlast indentations)
  182. (haskell-indentation-matching-indentation
  183. ci indentations)))
  184. (haskell-indentation-reindent (haskell-indentation-matching-indentation
  185. cc indentations))))))
  186. (defun haskell-indentation-one-indentation (col indentations)
  187. (let* ((last-pair (last indentations)))
  188. (cond ((null indentations)
  189. col)
  190. ((null (cdr indentations))
  191. (car indentations))
  192. ((<= col (car last-pair))
  193. col)
  194. (t (car last-pair)))))
  195. (defun haskell-indentation-butlast (indentations)
  196. (when (consp (cdr indentations))
  197. (while (cddr indentations)
  198. (setq indentations (cdr indentations))))
  199. (car indentations))
  200. (defun haskell-indentation-next-indentation (col indentations)
  201. "Find the lefmost indentation which is greater than COL."
  202. (catch 'return
  203. (while indentations
  204. (if (or (< col (car indentations))
  205. (null (cdr indentations)))
  206. (throw 'return (car indentations))
  207. (setq indentations (cdr indentations))))
  208. col))
  209. (defun haskell-indentation-previous-indentation (col indentations)
  210. "Find the rightmost indentation which is less than COL."
  211. (and indentations
  212. (> col (car indentations))
  213. (catch 'return
  214. (while indentations
  215. (if (or (null (cdr indentations))
  216. (<= col (cadr indentations)))
  217. (throw 'return (car indentations))
  218. (setq indentations (cdr indentations))))
  219. col)))
  220. (defun haskell-indentation-matching-indentation (col indentations)
  221. "Find the leftmost indentation which is greater than or equal to COL."
  222. (catch 'return
  223. (while indentations
  224. (if (or (<= col (car indentations))
  225. (null (cdr indentations)))
  226. (throw 'return (car indentations))
  227. (setq indentations (cdr indentations))))
  228. col))
  229. (defun haskell-indentation-indent-line ()
  230. (when (save-excursion
  231. (beginning-of-line)
  232. (not (nth 8 (syntax-ppss))))
  233. (let ((ci (current-indentation))
  234. (start-column (haskell-current-column)))
  235. (cond ((> (haskell-current-column) ci)
  236. (save-excursion
  237. (move-to-column ci)
  238. (haskell-indentation-reindent
  239. (haskell-indentation-one-indentation
  240. ci (haskell-indentation-find-indentations)))))
  241. ((= (haskell-current-column) ci)
  242. (haskell-indentation-reindent
  243. (haskell-indentation-next-indentation
  244. ci (haskell-indentation-find-indentations))))
  245. (t (move-to-column ci)
  246. (haskell-indentation-reindent
  247. (haskell-indentation-matching-indentation
  248. ci (haskell-indentation-find-indentations)))))
  249. (cond ((not (= (haskell-current-column) start-column))
  250. (setq haskell-indent-last-position nil))
  251. ((not haskell-indentation-cycle-warn)
  252. (haskell-indentation-reindent
  253. (haskell-indentation-next-indentation
  254. -1
  255. (haskell-indentation-find-indentations))))
  256. ((not (equal (point) haskell-indent-last-position))
  257. (message "Press TAB again to go to the leftmost indentation")
  258. (setq haskell-indent-last-position (point)))
  259. (t
  260. (haskell-indentation-reindent
  261. (haskell-indentation-next-indentation
  262. -1
  263. (haskell-indentation-find-indentations))))))))
  264. (defun haskell-indentation-delete-backward-char (n)
  265. (interactive "p")
  266. (on-parse-error (backward-delete-char 1)
  267. (cond
  268. ((and delete-selection-mode
  269. mark-active
  270. (not (= (point) (mark))))
  271. (delete-region (mark) (point)))
  272. ((or (= (haskell-current-column) 0)
  273. (> (haskell-current-column) (current-indentation))
  274. (nth 8 (syntax-ppss)))
  275. (delete-backward-char n))
  276. (t (let* ((ci (current-indentation))
  277. (pi (haskell-indentation-previous-indentation
  278. ci (haskell-indentation-find-indentations))))
  279. (save-excursion
  280. (cond (pi
  281. (move-to-column pi)
  282. (delete-region (point)
  283. (progn (move-to-column ci)
  284. (point))))
  285. (t
  286. (beginning-of-line)
  287. (delete-region (max (point-min) (- (point) 1))
  288. (progn (move-to-column ci)
  289. (point)))))))))))
  290. (defun haskell-indentation-delete-char (n)
  291. (interactive "p")
  292. (on-parse-error (delete-char 1)
  293. (cond
  294. ((and delete-selection-mode
  295. mark-active
  296. (not (= (point) (mark))))
  297. (delete-region (mark) (point)))
  298. ((or (eolp)
  299. (>= (haskell-current-column) (current-indentation))
  300. (nth 8 (syntax-ppss)))
  301. (delete-char n))
  302. (t
  303. (let* ((ci (current-indentation))
  304. (pi (haskell-indentation-previous-indentation
  305. ci (haskell-indentation-find-indentations))))
  306. (save-excursion
  307. (if (and pi (> pi (haskell-current-column)))
  308. (move-to-column pi))
  309. (delete-region (point)
  310. (progn (move-to-column ci)
  311. (point)))))))))
  312. (defun haskell-indentation-goto-least-indentation ()
  313. (beginning-of-line)
  314. (catch 'return
  315. (while (not (bobp))
  316. (forward-comment (- (buffer-size)))
  317. (beginning-of-line)
  318. (let ((ps (nth 8 (syntax-ppss))))
  319. (when ps ;; inside comment or string
  320. (goto-char ps)))
  321. (when (= 0 (current-indentation))
  322. (throw 'return nil))))
  323. (beginning-of-line)
  324. (when (bobp)
  325. (forward-comment (buffer-size))))
  326. ;; Dynamically scoped variables.
  327. (defvar following-token)
  328. (defvar current-token)
  329. (defvar left-indent)
  330. (defvar starter-indent)
  331. (defvar current-indent)
  332. (defvar layout-indent)
  333. (defvar parse-line-number)
  334. (defvar possible-indentations)
  335. (defvar indentation-point)
  336. (defun haskell-indentation-parse-to-indentations ()
  337. (save-excursion
  338. (skip-syntax-forward "-")
  339. (let ((indentation-point (point))
  340. (layout-indent 0)
  341. (parse-line-number 0)
  342. (current-indent haskell-indentation-layout-offset)
  343. (starter-indent haskell-indentation-layout-offset)
  344. (left-indent haskell-indentation-layout-offset)
  345. (case-fold-search nil)
  346. current-token
  347. following-token
  348. possible-indentations)
  349. (haskell-indentation-goto-least-indentation)
  350. (if (<= indentation-point (point))
  351. '(0)
  352. (setq current-token (haskell-indentation-peek-token))
  353. (catch 'parse-end
  354. (haskell-indentation-toplevel)
  355. (when (not (equal current-token 'end-tokens))
  356. (parse-error "Illegal token: %s" current-token)))
  357. possible-indentations))))
  358. (defun haskell-indentation-find-indentations ()
  359. (let ((ppss (syntax-ppss)))
  360. (cond
  361. ((nth 3 ppss) '(0))
  362. ((nth 4 ppss)
  363. (if (save-excursion
  364. (and (skip-syntax-forward "-")
  365. (eolp)
  366. (not (> (forward-line 1) 0))
  367. (not (nth 4 (syntax-ppss)))))
  368. (haskell-indentation-parse-to-indentations)
  369. '(0)))
  370. (t
  371. (haskell-indentation-parse-to-indentations)))))
  372. (defconst haskell-indentation-toplevel-list
  373. '(("module" . haskell-indentation-module)
  374. ("data" . haskell-indentation-data)
  375. ("type" . haskell-indentation-data)
  376. ("newtype" . haskell-indentation-data)
  377. ("class" . haskell-indentation-class-declaration)
  378. ("instance" . haskell-indentation-class-declaration )))
  379. (defconst haskell-indentation-type-list
  380. '(("::" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-type)))
  381. ("(" . (lambda () (haskell-indentation-list #'haskell-indentation-type
  382. ")" "," nil)))
  383. ("[" . (lambda () (haskell-indentation-list #'haskell-indentation-type
  384. "]" "," nil)))
  385. ("{" . (lambda () (haskell-indentation-list #'haskell-indentation-type
  386. "}" "," nil)))))
  387. (defconst haskell-indentation-expression-list
  388. '(("data" . haskell-indentation-data)
  389. ("type" . haskell-indentation-data)
  390. ("newtype" . haskell-indentation-data)
  391. ("if" . (lambda () (haskell-indentation-phrase
  392. '(haskell-indentation-expression
  393. "then" haskell-indentation-expression
  394. "else" haskell-indentation-expression))))
  395. ("let" . (lambda () (haskell-indentation-phrase
  396. '(haskell-indentation-declaration-layout
  397. "in" haskell-indentation-expression))))
  398. ("do" . (lambda () (haskell-indentation-with-starter
  399. #'haskell-indentation-expression-layout nil)))
  400. ("mdo" . (lambda () (haskell-indentation-with-starter
  401. #'haskell-indentation-expression-layout nil)))
  402. ("case" . (lambda () (haskell-indentation-phrase
  403. '(haskell-indentation-expression
  404. "of" haskell-indentation-case-layout))))
  405. ("\\" . (lambda () (haskell-indentation-phrase
  406. '(haskell-indentation-expression
  407. "->" haskell-indentation-expression))))
  408. ("proc" . (lambda () (haskell-indentation-phrase
  409. '(haskell-indentation-expression
  410. "->" haskell-indentation-expression))))
  411. ("where" . (lambda () (haskell-indentation-with-starter
  412. #'haskell-indentation-declaration-layout nil t)))
  413. ("::" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-type)))
  414. ("=" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-expression)))
  415. ("<-" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-expression)))
  416. ("(" . (lambda () (haskell-indentation-list #'haskell-indentation-expression
  417. ")" '(list "," "->") nil)))
  418. ("[" . (lambda () (haskell-indentation-list #'haskell-indentation-expression
  419. "]" "," "|")))
  420. ("{" . (lambda () (haskell-indentation-list #'haskell-indentation-expression
  421. "}" "," nil)))))
  422. (defun haskell-indentation-expression-layout ()
  423. (haskell-indentation-layout #'haskell-indentation-expression))
  424. (defun haskell-indentation-declaration-layout ()
  425. (haskell-indentation-layout #'haskell-indentation-declaration))
  426. (defun haskell-indentation-case-layout ()
  427. (haskell-indentation-layout #'haskell-indentation-case))
  428. (defun haskell-indentation-fundep ()
  429. (haskell-indentation-with-starter
  430. (lambda () (haskell-indentation-separated
  431. #'haskell-indentation-fundep1 "," nil))
  432. nil))
  433. (defun haskell-indentation-fundep1 ()
  434. (let ((current-indent (haskell-current-column)))
  435. (while (member current-token '(value "->"))
  436. (haskell-indentation-read-next-token))
  437. (when (and (equal current-token 'end-tokens)
  438. (member following-token '(value "->")))
  439. (haskell-indentation-add-indentation current-indent))))
  440. (defun haskell-indentation-toplevel ()
  441. (haskell-indentation-layout
  442. (lambda ()
  443. (let ((parser (assoc current-token haskell-indentation-toplevel-list)))
  444. (if parser
  445. (funcall (cdr parser))
  446. (haskell-indentation-declaration))))))
  447. (defun haskell-indentation-type ()
  448. (let ((current-indent (haskell-current-column)))
  449. (catch 'return
  450. (while t
  451. (cond
  452. ((member current-token '(value operator "->"))
  453. (haskell-indentation-read-next-token))
  454. ((equal current-token 'end-tokens)
  455. (when (member following-token
  456. '(value operator no-following-token
  457. "->" "(" "[" "{" "::"))
  458. (haskell-indentation-add-indentation current-indent))
  459. (throw 'return nil))
  460. (t (let ((parser (assoc current-token haskell-indentation-type-list)))
  461. (if (not parser)
  462. (throw 'return nil)
  463. (funcall (cdr parser))))))))))
  464. (defun haskell-indentation-data ()
  465. (haskell-indentation-with-starter
  466. (lambda ()
  467. (when (equal current-token "instance")
  468. (haskell-indentation-read-next-token))
  469. (haskell-indentation-type)
  470. (cond ((equal current-token "=")
  471. (haskell-indentation-with-starter
  472. (lambda () (haskell-indentation-separated #'haskell-indentation-type "|" "deriving"))
  473. nil))
  474. ((equal current-token "where")
  475. (haskell-indentation-with-starter
  476. #'haskell-indentation-expression-layout nil))))
  477. nil))
  478. (defun haskell-indentation-class-declaration ()
  479. (haskell-indentation-with-starter
  480. (lambda ()
  481. (haskell-indentation-type)
  482. (when (equal current-token "|")
  483. (haskell-indentation-fundep))
  484. (when (equal current-token "where")
  485. (haskell-indentation-with-starter
  486. #'haskell-indentation-expression-layout nil)))
  487. nil))
  488. (defun haskell-indentation-module ()
  489. (haskell-indentation-with-starter
  490. (lambda ()
  491. (let ((current-indent (haskell-current-column)))
  492. (haskell-indentation-read-next-token)
  493. (when (equal current-token "(")
  494. (haskell-indentation-list
  495. #'haskell-indentation-module-export
  496. ")" "," nil))
  497. (when (equal current-token 'end-tokens)
  498. (haskell-indentation-add-indentation current-indent)
  499. (throw 'parse-end nil))
  500. (when (equal current-token "where")
  501. (haskell-indentation-read-next-token)
  502. (when (equal current-token 'end-tokens)
  503. (haskell-indentation-add-layout-indent)
  504. (throw 'parse-end nil))
  505. (haskell-indentation-layout #'haskell-indentation-toplevel))))
  506. nil))
  507. (defun haskell-indentation-module-export ()
  508. (cond ((equal current-token "module")
  509. (let ((current-indent (haskell-current-column)))
  510. (haskell-indentation-read-next-token)
  511. (cond ((equal current-token 'end-tokens)
  512. (haskell-indentation-add-indentation current-indent))
  513. ((equal current-token 'value)
  514. (haskell-indentation-read-next-token)))))
  515. (t (haskell-indentation-type))))
  516. (defun haskell-indentation-list (parser end sep stmt-sep)
  517. (haskell-indentation-with-starter
  518. `(lambda () (haskell-indentation-separated #',parser
  519. ,sep
  520. ,stmt-sep))
  521. end))
  522. (defun haskell-indentation-with-starter (parser end &optional where-expr?)
  523. (let ((starter-column (haskell-current-column))
  524. (current-indent current-indent)
  525. (left-indent (if (= (haskell-current-column) (current-indentation))
  526. (haskell-current-column) left-indent)))
  527. (haskell-indentation-read-next-token)
  528. (when (equal current-token 'end-tokens)
  529. (if (equal following-token end)
  530. (haskell-indentation-add-indentation starter-column)
  531. (if where-expr?
  532. (haskell-indentation-add-where-post-indent left-indent)
  533. (haskell-indentation-add-indentation
  534. (+ left-indent haskell-indentation-left-offset))))
  535. (throw 'parse-end nil))
  536. (let* ((current-indent (haskell-current-column))
  537. (starter-indent (min starter-column current-indent))
  538. (left-indent (if end (+ current-indent haskell-indentation-starter-offset)
  539. left-indent)))
  540. (funcall parser)
  541. (cond ((equal current-token 'end-tokens)
  542. (when (equal following-token end)
  543. (haskell-indentation-add-indentation starter-indent))
  544. (when end (throw 'parse-end nil))) ;; add no indentations
  545. ((equal current-token end)
  546. (haskell-indentation-read-next-token)) ;; continue
  547. (end (parse-error "Illegal token: %s" current-token))))))
  548. (defun haskell-indentation-case ()
  549. (haskell-indentation-expression)
  550. (cond ((equal current-token 'end-tokens)
  551. (haskell-indentation-add-indentation current-indent))
  552. ((equal current-token "|")
  553. (haskell-indentation-with-starter
  554. (lambda () (haskell-indentation-separated #'haskell-indentation-case "|" nil))
  555. nil))
  556. ((equal current-token "->")
  557. (haskell-indentation-statement-right #'haskell-indentation-expression))
  558. ;; otherwise fallthrough
  559. ))
  560. (defun haskell-indentation-statement-right (parser)
  561. (haskell-indentation-read-next-token)
  562. (when (equal current-token 'end-tokens)
  563. (haskell-indentation-add-indentation
  564. (+ left-indent haskell-indentation-left-offset))
  565. (throw 'parse-end nil))
  566. (let ((current-indent (haskell-current-column)))
  567. (funcall parser)))
  568. (defun haskell-indentation-simple-declaration ()
  569. (haskell-indentation-expression)
  570. (cond ((equal current-token "=")
  571. (haskell-indentation-statement-right #'haskell-indentation-expression))
  572. ((equal current-token "::")
  573. (haskell-indentation-statement-right #'haskell-indentation-type))
  574. ((and (equal current-token 'end-tokens)
  575. (equal following-token "="))
  576. (haskell-indentation-add-indentation current-indent)
  577. (throw 'parse-end nil))))
  578. (defun haskell-indentation-declaration ()
  579. (haskell-indentation-expression)
  580. (cond ((equal current-token "|")
  581. (haskell-indentation-with-starter
  582. (lambda () (haskell-indentation-separated #'haskell-indentation-expression "," "|"))
  583. nil))
  584. ((equal current-token 'end-tokens)
  585. (when (member following-token '("|" "=" "::" ","))
  586. (haskell-indentation-add-indentation current-indent)
  587. (throw 'parse-end nil)))))
  588. (defun haskell-indentation-layout (parser)
  589. (if (equal current-token "{")
  590. (haskell-indentation-list parser "}" ";" nil)
  591. (haskell-indentation-implicit-layout-list parser)))
  592. (defun haskell-indentation-expression-token (token)
  593. (member token '("if" "let" "do" "case" "\\" "(" "[" "::"
  594. value operator no-following-token)))
  595. (defun haskell-indentation-expression ()
  596. (let ((current-indent (haskell-current-column)))
  597. (catch 'return
  598. (while t
  599. (cond
  600. ((member current-token '(value operator))
  601. (haskell-indentation-read-next-token))
  602. ((equal current-token 'end-tokens)
  603. (cond ((equal following-token "where")
  604. (haskell-indentation-add-where-pre-indent))
  605. ((haskell-indentation-expression-token following-token)
  606. (haskell-indentation-add-indentation
  607. current-indent)))
  608. (throw 'return nil))
  609. (t (let ((parser (assoc current-token haskell-indentation-expression-list)))
  610. (when (null parser)
  611. (throw 'return nil))
  612. (funcall (cdr parser))
  613. (when (and (equal current-token 'end-tokens)
  614. (equal (car parser) "let")
  615. (= haskell-indentation-layout-offset current-indent)
  616. (haskell-indentation-expression-token following-token))
  617. ;; inside a layout, after a let construct
  618. (haskell-indentation-add-layout-indent)
  619. (throw 'parse-end nil))
  620. (unless (member (car parser) '("(" "[" "{" "do" "case"))
  621. (throw 'return nil)))))))))
  622. (defun haskell-indentation-test-indentations ()
  623. (interactive)
  624. (let ((indentations (save-excursion (haskell-indentation-find-indentations)))
  625. (str "")
  626. (pos 0))
  627. (while indentations
  628. (when (>= (car indentations) pos)
  629. (setq str (concat str (make-string (- (car indentations) pos) ?\ )
  630. "|"))
  631. (setq pos (+ 1 (car indentations))))
  632. (setq indentations (cdr indentations)))
  633. (end-of-line)
  634. (newline)
  635. (insert str)))
  636. (defun haskell-indentation-separated (parser separator stmt-separator)
  637. (catch 'return
  638. (while t
  639. (funcall parser)
  640. (cond ((if (listp separator) (member current-token separator) (equal current-token separator))
  641. (haskell-indentation-at-separator))
  642. ((equal current-token stmt-separator)
  643. (setq starter-indent (haskell-current-column))
  644. (haskell-indentation-at-separator))
  645. ((equal current-token 'end-tokens)
  646. (cond ((or (equal following-token separator)
  647. (equal following-token stmt-separator))
  648. (haskell-indentation-add-indentation starter-indent)
  649. (throw 'parse-end nil)))
  650. (throw 'return nil))
  651. (t (throw 'return nil))))))
  652. (defun haskell-indentation-at-separator ()
  653. (let ((separator-column
  654. (and (= (haskell-current-column) (current-indentation))
  655. (haskell-current-column))))
  656. (haskell-indentation-read-next-token)
  657. (cond ((eq current-token 'end-tokens)
  658. (haskell-indentation-add-indentation current-indent)
  659. (throw 'return nil))
  660. (separator-column ;; on the beginning of the line
  661. (setq current-indent (haskell-current-column))
  662. (setq starter-indent separator-column)))))
  663. (defun haskell-indentation-implicit-layout-list (parser)
  664. (let* ((layout-indent (haskell-current-column))
  665. (current-indent (haskell-current-column))
  666. (left-indent (haskell-current-column)))
  667. (catch 'return
  668. (while t
  669. (let ((left-indent left-indent))
  670. (funcall parser))
  671. (cond ((member current-token '(layout-next ";"))
  672. (haskell-indentation-read-next-token))
  673. ((equal current-token 'end-tokens)
  674. (when (or (haskell-indentation-expression-token following-token)
  675. (equal following-token ";"))
  676. (haskell-indentation-add-layout-indent))
  677. (throw 'return nil))
  678. (t (throw 'return nil))))))
  679. ;; put haskell-indentation-read-next-token outside the current-indent definition
  680. ;; so it will not return 'layout-end again
  681. (when (eq current-token 'layout-end)
  682. (haskell-indentation-read-next-token))) ;; leave layout at 'layout-end or illegal token
  683. (defun haskell-indentation-phrase (phrase)
  684. (haskell-indentation-with-starter
  685. `(lambda () (haskell-indentation-phrase-rest ',phrase))
  686. nil))
  687. (defun haskell-indentation-phrase-rest (phrase)
  688. (let ((starter-line parse-line-number))
  689. (let ((current-indent (haskell-current-column)))
  690. (funcall (car phrase)))
  691. (cond
  692. ((equal current-token 'end-tokens)
  693. (cond ((null (cdr phrase))) ;; fallthrough
  694. ((equal following-token (cadr phrase))
  695. (haskell-indentation-add-indentation starter-indent)
  696. (throw 'parse-end nil))
  697. ((equal (cadr phrase) "in")
  698. (when (= left-indent layout-indent)
  699. (haskell-indentation-add-layout-indent)
  700. (throw 'parse-end nil)))
  701. (t (throw 'parse-end nil))))
  702. ((null (cdr phrase)))
  703. ((equal (cadr phrase) current-token)
  704. (let* ((on-new-line (= (haskell-current-column) (current-indentation)))
  705. (lines-between (- parse-line-number starter-line))
  706. (left-indent (if (<= lines-between 0)
  707. left-indent
  708. starter-indent)))
  709. (haskell-indentation-read-next-token)
  710. (when (equal current-token 'end-tokens)
  711. (haskell-indentation-add-indentation
  712. (cond ((member (cadr phrase) '("then" "else"))
  713. (+ starter-indent haskell-indentation-ifte-offset))
  714. ((member (cadr phrase) '("in" "->"))
  715. ;; expression ending in another expression
  716. (if on-new-line
  717. (+ left-indent haskell-indentation-starter-offset)
  718. left-indent))
  719. (t (+ left-indent haskell-indentation-left-offset))))
  720. (throw 'parse-end nil))
  721. (haskell-indentation-phrase-rest (cddr phrase))))
  722. ((equal (cadr phrase) "in")) ;; fallthrough
  723. (t (parse-error "Expecting %s" (cadr phrase))))))
  724. (defun haskell-indentation-add-indentation (indent)
  725. (haskell-indentation-push-indentation
  726. (if (<= indent layout-indent)
  727. (+ layout-indent haskell-indentation-layout-offset)
  728. indent)))
  729. (defun haskell-indentation-add-layout-indent ()
  730. (haskell-indentation-push-indentation layout-indent))
  731. (defun haskell-indentation-add-where-pre-indent ()
  732. (haskell-indentation-push-indentation
  733. (+ layout-indent haskell-indentation-where-pre-offset))
  734. (if (= layout-indent haskell-indentation-layout-offset)
  735. (haskell-indentation-push-indentation
  736. haskell-indentation-where-pre-offset)))
  737. (defun haskell-indentation-add-where-post-indent (indent)
  738. (haskell-indentation-push-indentation
  739. (+ indent haskell-indentation-where-post-offset)))
  740. (defun haskell-indentation-push-indentation (indent)
  741. (when (or (null possible-indentations)
  742. (< indent (car possible-indentations)))
  743. (setq possible-indentations
  744. (cons indent possible-indentations))))
  745. (defun haskell-indentation-token-test ()
  746. (let ((current-token nil)
  747. (following-token nil)
  748. (layout-indent 0)
  749. (indentation-point (mark)))
  750. (haskell-indentation-read-next-token)))
  751. (defun haskell-indentation-read-next-token ()
  752. (cond ((eq current-token 'end-tokens)
  753. 'end-tokens)
  754. ((eq current-token 'layout-end)
  755. (cond ((> layout-indent (haskell-current-column))
  756. 'layout-end)
  757. ((= layout-indent (haskell-current-column))
  758. (setq current-token 'layout-next))
  759. ((< layout-indent (haskell-current-column))
  760. (setq current-token (haskell-indentation-peek-token)))))
  761. ((eq current-token 'layout-next)
  762. (setq current-token (haskell-indentation-peek-token)))
  763. ((> layout-indent (haskell-current-column))
  764. (setq current-token 'layout-end))
  765. (t
  766. (haskell-indentation-skip-token)
  767. (if (>= (point) indentation-point)
  768. (progn
  769. (setq following-token
  770. (if (= (point) indentation-point)
  771. (haskell-indentation-peek-token)
  772. 'no-following-token))
  773. (setq current-token 'end-tokens))
  774. (when (= (haskell-current-column) (current-indentation))
  775. ;; on a new line
  776. (setq current-indent (haskell-current-column))
  777. (setq left-indent (haskell-current-column))
  778. (setq parse-line-number (+ parse-line-number 1)))
  779. (cond ((> layout-indent (haskell-current-column))
  780. (setq current-token 'layout-end))
  781. ((= layout-indent (haskell-current-column))
  782. (setq current-token 'layout-next))
  783. (t (setq current-token (haskell-indentation-peek-token))))))))
  784. (defun haskell-indentation-peek-token ()
  785. (cond ((looking-at "\\(if\\|then\\|else\\|let\\|in\\|mdo\\|do\\|proc\\|case\\|of\\|where\\|module\\|deriving\\|data\\|type\\|newtype\\|class\\|instance\\)\\([^[:alpha:]'_]\\|$\\)")
  786. (match-string 1))
  787. ((looking-at "[][(){}[,;]")
  788. (match-string 0))
  789. ((looking-at "\\(\\\\\\|->\\|<-\\|::\\|=\\||\\)\\([^-:!#$%&*+./<=>?@\\\\^|~]\\|$\\)")
  790. (match-string 1))
  791. ((looking-at"[-:!#$%&*+./<=>?@\\\\^|~`]" )
  792. 'operator)
  793. (t 'value)))
  794. (defun haskell-indentation-skip-token ()
  795. "Skip to the next token."
  796. (let ((case-fold-search nil))
  797. (if (or (looking-at "'\\([^\\']\\|\\\\.\\)*'")
  798. (looking-at "\"\\([^\\\"]\\|\\\\.\\)*\"")
  799. (looking-at ; Hierarchical names always start with uppercase
  800. "[[:upper:]]\\(\\sw\\|'\\)*\\(\\.\\(\\sw\\|'\\)+\\)*")
  801. (looking-at "\\sw\\(\\sw\\|'\\)*") ; Only unqualified vars can start with lowercase
  802. (looking-at "[0-9][0-9oOxXeE+-]*")
  803. (looking-at "[-:!#$%&*+./<=>?@\\\\^|~]+")
  804. (looking-at "[](){}[,;]")
  805. (looking-at "`[[:alnum:]']*`"))
  806. (goto-char (match-end 0))
  807. ;; otherwise skip until space found
  808. (skip-syntax-forward "^-"))
  809. (forward-comment (buffer-size))))
  810. (provide 'haskell-indentation)
  811. ;;; haskell-indentation.el ends here