PageRenderTime 88ms CodeModel.GetById 19ms app.highlight 61ms RepoModel.GetById 0ms app.codeStats 1ms

/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
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