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