1256 lines
49 KiB
EmacsLisp
1256 lines
49 KiB
EmacsLisp
|
;;; haskell-indentation.el --- indentation module for Haskell Mode -*- lexical-binding: t -*-
|
|||
|
|
|
|||
|
|
;; Copyright (C) 2013 Kristof Bastiaensen, Gergely Risko
|
|||
|
|
|
|||
|
|
;; Author: Kristof Bastiaensen <kristof.bastiaensen@vleeuwen.org>
|
|||
|
|
;; Author: Gergely Risko <errge@nilcons.com>
|
|||
|
|
;; Keywords: indentation haskell
|
|||
|
|
;; URL: https://github.com/haskell/haskell-mode
|
|||
|
|
|
|||
|
|
;; This file is not part of GNU Emacs.
|
|||
|
|
|
|||
|
|
;; This file is free software; you can redistribute it and/or modify
|
|||
|
|
;; it under the terms of the GNU General Public License as published by
|
|||
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
|||
|
|
;; any later version.
|
|||
|
|
|
|||
|
|
;; This file is distributed in the hope that it will be useful,
|
|||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|||
|
|
;; GNU General Public License for more details.
|
|||
|
|
|
|||
|
|
;; You should have received a copy of the GNU General Public License
|
|||
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
|
|
|
|||
|
|
;;; Commentary:
|
|||
|
|
|
|||
|
|
;; Installation:
|
|||
|
|
;;
|
|||
|
|
;; To turn indentation on for all Haskell buffers under Haskell mode add
|
|||
|
|
;; this to your configuration file:
|
|||
|
|
;;
|
|||
|
|
;; (add-hook haskell-mode-hook 'haskell-indentation-mode)
|
|||
|
|
;;
|
|||
|
|
;; Otherwise, call `haskell-indentation-mode'.
|
|||
|
|
|
|||
|
|
;;; Code:
|
|||
|
|
|
|||
|
|
;; TODO eliminate magic number 2 where possible, use a variable
|
|||
|
|
|
|||
|
|
;; TODO `haskell-indentation-find-indentation' — fix it, get rid of "safe"
|
|||
|
|
;; version
|
|||
|
|
|
|||
|
|
(require 'cl-lib)
|
|||
|
|
(require 'haskell-lexeme)
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(defgroup haskell-indentation nil
|
|||
|
|
"Haskell indentation."
|
|||
|
|
:link '(custom-manual "(haskell-mode)Indentation")
|
|||
|
|
:group 'haskell
|
|||
|
|
:prefix "haskell-indentation-")
|
|||
|
|
|
|||
|
|
(defcustom haskell-indentation-layout-offset 2
|
|||
|
|
"Extra indentation to add before expressions in a Haskell layout list."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'haskell-indentation)
|
|||
|
|
|
|||
|
|
(defcustom haskell-indentation-starter-offset 2
|
|||
|
|
"Extra indentation after an opening keyword (e.g. \"let\")."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'haskell-indentation)
|
|||
|
|
|
|||
|
|
(defcustom haskell-indentation-left-offset 2
|
|||
|
|
"Extra indentation after an indentation to the left (e.g. after \"do\")."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'haskell-indentation)
|
|||
|
|
|
|||
|
|
(defcustom haskell-indentation-where-pre-offset 2
|
|||
|
|
"Extra indentation before the keyword \"where\"."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'haskell-indentation)
|
|||
|
|
|
|||
|
|
(defcustom haskell-indentation-where-post-offset 2
|
|||
|
|
"Extra indentation after the keyword \"where\"."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'haskell-indentation)
|
|||
|
|
|
|||
|
|
(defcustom haskell-indentation-electric-flag nil
|
|||
|
|
"Non-nil means insertion of some characters may auto reindent the line.
|
|||
|
|
If the variable `electric-indent-mode' is non-nil then this variable is
|
|||
|
|
overridden."
|
|||
|
|
:type 'symbol
|
|||
|
|
:group 'haskell-indentation)
|
|||
|
|
(make-variable-buffer-local 'haskell-indentation-electric-flag)
|
|||
|
|
|
|||
|
|
(defvar haskell-indentation-mode-map
|
|||
|
|
(let ((map (make-sparse-keymap)))
|
|||
|
|
(define-key map (kbd "RET") #'haskell-indentation-newline-and-indent)
|
|||
|
|
(define-key map (kbd "<backtab>") #'haskell-indentation-indent-backwards)
|
|||
|
|
(define-key map (kbd ",") #'haskell-indentation-common-electric-command)
|
|||
|
|
(define-key map (kbd ";") #'haskell-indentation-common-electric-command)
|
|||
|
|
(define-key map (kbd ")") #'haskell-indentation-common-electric-command)
|
|||
|
|
(define-key map (kbd "}") #'haskell-indentation-common-electric-command)
|
|||
|
|
(define-key map (kbd "]") #'haskell-indentation-common-electric-command)
|
|||
|
|
map)
|
|||
|
|
"Keymap for `haskell-indentation-mode'.")
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(define-minor-mode haskell-indentation-mode
|
|||
|
|
"Haskell indentation mode that deals with the layout rule.
|
|||
|
|
It rebinds RET, DEL and BACKSPACE, so that indentations can be
|
|||
|
|
set and deleted as if they were real tabs."
|
|||
|
|
:keymap haskell-indentation-mode-map
|
|||
|
|
(kill-local-variable 'indent-line-function)
|
|||
|
|
(kill-local-variable 'indent-region-function)
|
|||
|
|
|
|||
|
|
(when haskell-indentation-mode
|
|||
|
|
(when (and (bound-and-true-p haskell-indent-mode)
|
|||
|
|
(fboundp 'turn-off-haskell-indent))
|
|||
|
|
(turn-off-haskell-indent))
|
|||
|
|
(setq-local indent-line-function #'haskell-indentation-indent-line)
|
|||
|
|
(setq-local indent-region-function #'haskell-indentation-indent-region)))
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(defun turn-on-haskell-indentation ()
|
|||
|
|
"Turn on the haskell-indentation minor mode."
|
|||
|
|
(interactive)
|
|||
|
|
(haskell-indentation-mode t))
|
|||
|
|
|
|||
|
|
(make-obsolete 'turn-on-haskell-indentation
|
|||
|
|
'haskell-indentation-mode
|
|||
|
|
"2015-05-25")
|
|||
|
|
|
|||
|
|
(defvar haskell-literate) ; defined in haskell-mode.el
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-bird-p ()
|
|||
|
|
"Return t if this is a literate Haskell buffer in bird style, NIL otherwise."
|
|||
|
|
(eq haskell-literate 'bird))
|
|||
|
|
|
|||
|
|
;;----------------------------------------------------------------------------
|
|||
|
|
;; UI starts here
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-reindent-to (col &optional move)
|
|||
|
|
"Reindent current line to COL, move the point there if MOVE is non-NIL."
|
|||
|
|
(let* ((ci (haskell-indentation-current-indentation)))
|
|||
|
|
(save-excursion
|
|||
|
|
(move-to-column ci)
|
|||
|
|
(if (<= ci col)
|
|||
|
|
(insert-before-markers (make-string (- col ci) ? ))
|
|||
|
|
(delete-char (- col ci))))
|
|||
|
|
(when move
|
|||
|
|
(move-to-column col))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-indent-rigidly (start end arg)
|
|||
|
|
"Indent all lines starting in the region sideways by ARG columns.
|
|||
|
|
Called from a program, takes three arguments, START, END and ARG.
|
|||
|
|
You can remove all indentation from a region by giving a large
|
|||
|
|
negative ARG. Handles bird style literate Haskell too."
|
|||
|
|
(interactive "*r\np")
|
|||
|
|
(save-excursion
|
|||
|
|
(goto-char end)
|
|||
|
|
(let ((end-marker (point-marker)))
|
|||
|
|
(goto-char start)
|
|||
|
|
(or (bolp) (forward-line 0))
|
|||
|
|
(while (< (point) end-marker)
|
|||
|
|
(let ((ci (haskell-indentation-current-indentation)))
|
|||
|
|
(when (and t
|
|||
|
|
(eq (char-after) ?>))
|
|||
|
|
(forward-char 1))
|
|||
|
|
(skip-syntax-forward "-")
|
|||
|
|
(unless (eolp)
|
|||
|
|
(haskell-indentation-reindent-to (max 0 (+ ci arg))))
|
|||
|
|
(forward-line 1)))
|
|||
|
|
(move-marker end-marker nil))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-current-indentation ()
|
|||
|
|
"Column position of first non-whitespace character in current line."
|
|||
|
|
(save-excursion
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(when (haskell-indentation-bird-p)
|
|||
|
|
(forward-char))
|
|||
|
|
(skip-syntax-forward "-")
|
|||
|
|
(current-column)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-bird-outside-code-p ()
|
|||
|
|
"Non-NIL if we are in bird literate mode, but outside of code."
|
|||
|
|
(and (haskell-indentation-bird-p)
|
|||
|
|
(or (< (current-column) 2)
|
|||
|
|
(save-excursion
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(not (eq (char-after) ?>))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-newline-and-indent ()
|
|||
|
|
"Insert newline and indent."
|
|||
|
|
(interactive "*")
|
|||
|
|
;; On RET (or C-j), we:
|
|||
|
|
;; - just jump to the next line if literate haskell, but outside code
|
|||
|
|
(if (haskell-indentation-bird-outside-code-p)
|
|||
|
|
(progn
|
|||
|
|
(delete-horizontal-space)
|
|||
|
|
(newline))
|
|||
|
|
;; - save the current column
|
|||
|
|
(let ((ci (haskell-indentation-current-indentation)))
|
|||
|
|
;; - jump to the next line and reindent to at the least same level
|
|||
|
|
(delete-horizontal-space)
|
|||
|
|
(newline)
|
|||
|
|
;; calculate indentation after newline is inserted because if we
|
|||
|
|
;; break an identifier we might create a keyword, for example
|
|||
|
|
;; "dowhere" => "do where"
|
|||
|
|
(let ((indentations (or (haskell-indentation-find-indentations)
|
|||
|
|
'(0))))
|
|||
|
|
(when (haskell-indentation-bird-p)
|
|||
|
|
(insert "> "))
|
|||
|
|
(haskell-indentation-reindent-to
|
|||
|
|
(haskell-indentation-next-indentation (- ci 1) indentations 'nofail)
|
|||
|
|
'move)))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-next-indentation (col indentations &optional nofail)
|
|||
|
|
"Find the leftmost indentation which is greater than COL.
|
|||
|
|
Indentations are taken from INDENTATIONS, which should be a
|
|||
|
|
list. Return the last indentation if there are no bigger ones and
|
|||
|
|
NOFAIL is non-NIL."
|
|||
|
|
(when (null indentations)
|
|||
|
|
(error "haskell-indentation-next-indentation called with empty list"))
|
|||
|
|
(or (cl-find-if (lambda (i) (> i col)) indentations)
|
|||
|
|
(when nofail
|
|||
|
|
(car (last indentations)))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-previous-indentation (col indentations &optional nofail)
|
|||
|
|
"Find the rightmost indentation less than COL from INDENTATIONS.
|
|||
|
|
When no indentations are less than COL, return the rightmost indentation
|
|||
|
|
if NOFAIL is non-nil, or nil otherwise."
|
|||
|
|
(when (null indentations)
|
|||
|
|
(error "haskell-indentation-previous-indentation called with empty list"))
|
|||
|
|
(let ((rev (reverse indentations)))
|
|||
|
|
(or (cl-find-if (lambda (i) (< i col)) rev)
|
|||
|
|
(when nofail
|
|||
|
|
(car rev)))))
|
|||
|
|
|
|||
|
|
(defvar haskell-indentation-dyn-last-direction nil
|
|||
|
|
"") ; FIXME
|
|||
|
|
(defvar haskell-indentation-dyn-last-indentations nil
|
|||
|
|
"") ; FIXME
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-indent-line ()
|
|||
|
|
"Indent current line, cycle though indentation positions.
|
|||
|
|
Do nothing inside multiline comments and multiline strings.
|
|||
|
|
Start enumerating the indentation points to the right. The user
|
|||
|
|
can continue by repeatedly pressing TAB. When there is no more
|
|||
|
|
indentation points to the right, we switch going to the left."
|
|||
|
|
(interactive "*")
|
|||
|
|
;; try to repeat
|
|||
|
|
(when (not (haskell-indentation-indent-line-repeat))
|
|||
|
|
(setq haskell-indentation-dyn-last-direction nil)
|
|||
|
|
;; parse error is intentionally not cought here, it may come from
|
|||
|
|
;; `haskell-indentation-find-indentations', but escapes the scope
|
|||
|
|
;; and aborts the opertaion before any moving happens
|
|||
|
|
(let* ((cc (current-column))
|
|||
|
|
(ci (haskell-indentation-current-indentation))
|
|||
|
|
(inds (save-excursion
|
|||
|
|
(move-to-column ci)
|
|||
|
|
(or (haskell-indentation-find-indentations)
|
|||
|
|
'(0))))
|
|||
|
|
(valid (memq ci inds))
|
|||
|
|
(cursor-in-whitespace (< cc ci)))
|
|||
|
|
|
|||
|
|
(if (and valid cursor-in-whitespace)
|
|||
|
|
(move-to-column ci)
|
|||
|
|
(haskell-indentation-reindent-to
|
|||
|
|
(haskell-indentation-next-indentation ci inds 'nofail)
|
|||
|
|
cursor-in-whitespace))
|
|||
|
|
(setq haskell-indentation-dyn-last-direction 'right
|
|||
|
|
haskell-indentation-dyn-last-indentations inds))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-indent-line-repeat ()
|
|||
|
|
"Cycle though indentation positions."
|
|||
|
|
(cond
|
|||
|
|
((and (memq last-command
|
|||
|
|
'(indent-for-tab-command
|
|||
|
|
haskell-indentation-indent-backwards))
|
|||
|
|
(eq haskell-indentation-dyn-last-direction 'region))
|
|||
|
|
(let ((mark-even-if-inactive t))
|
|||
|
|
(haskell-indentation-indent-rigidly
|
|||
|
|
(region-beginning)
|
|||
|
|
(region-end)
|
|||
|
|
1))
|
|||
|
|
t)
|
|||
|
|
((and (eq last-command 'indent-for-tab-command)
|
|||
|
|
(memq haskell-indentation-dyn-last-direction '(left right))
|
|||
|
|
haskell-indentation-dyn-last-indentations)
|
|||
|
|
(let ((ci (haskell-indentation-current-indentation)))
|
|||
|
|
(if (eq haskell-indentation-dyn-last-direction 'left)
|
|||
|
|
(haskell-indentation-reindent-to
|
|||
|
|
(haskell-indentation-previous-indentation
|
|||
|
|
ci haskell-indentation-dyn-last-indentations 'nofail))
|
|||
|
|
;; right
|
|||
|
|
(if (haskell-indentation-next-indentation
|
|||
|
|
ci haskell-indentation-dyn-last-indentations)
|
|||
|
|
(haskell-indentation-reindent-to
|
|||
|
|
(haskell-indentation-next-indentation
|
|||
|
|
ci haskell-indentation-dyn-last-indentations 'nofail))
|
|||
|
|
;; but failed, switch to left
|
|||
|
|
(setq haskell-indentation-dyn-last-direction 'left)
|
|||
|
|
(haskell-indentation-indent-line-repeat)))
|
|||
|
|
t))
|
|||
|
|
(t nil)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-indent-region (_start _end)
|
|||
|
|
"This function does nothing.
|
|||
|
|
|
|||
|
|
It is better to do nothing to indent region in Haskell than to
|
|||
|
|
break the semantics of indentation. This function is used for
|
|||
|
|
`indent-region-function' because the default is to call
|
|||
|
|
`indent-line-function' on every line from START to END and that
|
|||
|
|
also produces catastrophic results.
|
|||
|
|
|
|||
|
|
Someday we will have indent region that preserves semantics and
|
|||
|
|
fixes up only indentation."
|
|||
|
|
nil)
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-indent-backwards ()
|
|||
|
|
"Indent the current line to the previous indentation point."
|
|||
|
|
(interactive "*")
|
|||
|
|
(cond
|
|||
|
|
((and (memq last-command
|
|||
|
|
'(indent-for-tab-command haskell-indentation-indent-backwards))
|
|||
|
|
(eq haskell-indentation-dyn-last-direction 'region))
|
|||
|
|
(let ((mark-even-if-inactive t))
|
|||
|
|
(haskell-indentation-indent-rigidly (region-beginning) (region-end) -1)))
|
|||
|
|
((use-region-p)
|
|||
|
|
(setq haskell-indentation-dyn-last-direction 'region)
|
|||
|
|
(haskell-indentation-indent-rigidly (region-beginning) (region-end) -1)
|
|||
|
|
(message "Press TAB or S-TAB again to indent the region more"))
|
|||
|
|
(t
|
|||
|
|
(setq haskell-indentation-dyn-last-direction nil)
|
|||
|
|
(let* ((cc (current-column))
|
|||
|
|
(ci (haskell-indentation-current-indentation))
|
|||
|
|
(inds (save-excursion
|
|||
|
|
(move-to-column ci)
|
|||
|
|
(or (haskell-indentation-find-indentations)
|
|||
|
|
'(0))))
|
|||
|
|
(cursor-in-whitespace (< cc ci))
|
|||
|
|
(pi (haskell-indentation-previous-indentation ci inds)))
|
|||
|
|
(if (null pi)
|
|||
|
|
;; if there are no more indentations to the left, just go to column 0
|
|||
|
|
(haskell-indentation-reindent-to
|
|||
|
|
(car (haskell-indentation-first-indentation)) cursor-in-whitespace)
|
|||
|
|
(haskell-indentation-reindent-to pi cursor-in-whitespace))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-common-electric-command (arg)
|
|||
|
|
"Call `self-insert-command' to insert the character typed ARG times
|
|||
|
|
and indent when all of the following are true:
|
|||
|
|
1) The character is the first non-whitespace character on the line.
|
|||
|
|
2) There is only one possible indentation position.
|
|||
|
|
3) The variable `electric-indent-mode' or `haskell-indentation-electric-flag'
|
|||
|
|
is non-nil.
|
|||
|
|
4) The point is not in a comment, string, or quasiquote."
|
|||
|
|
(interactive "*p")
|
|||
|
|
(let ((col (current-column))
|
|||
|
|
ind)
|
|||
|
|
(self-insert-command arg)
|
|||
|
|
(when (and (or haskell-indentation-electric-flag
|
|||
|
|
electric-indent-mode)
|
|||
|
|
(= (haskell-indentation-current-indentation)
|
|||
|
|
col)
|
|||
|
|
(> arg 0)
|
|||
|
|
(not (nth 8 (syntax-ppss)))
|
|||
|
|
(= 1 (save-excursion
|
|||
|
|
(move-to-column col)
|
|||
|
|
(length (setq ind (haskell-indentation-find-indentations))))))
|
|||
|
|
(haskell-indentation-reindent-to (car ind)))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;----------------------------------------------------------------------------
|
|||
|
|
;; Parser Starts Here
|
|||
|
|
|
|||
|
|
;; The parser is implemented as a recursive descent parser. Each parser
|
|||
|
|
;; advances the point to after the expression it parses, and sets the
|
|||
|
|
;; dynamic scoped variables containing the information about the
|
|||
|
|
;; indentations. The dynamic scoping allows transparent backtracking to
|
|||
|
|
;; previous states of these variables. A new state can be set using `let'.
|
|||
|
|
;; When the scope of this function ends, the variable is automatically
|
|||
|
|
;; reverted to its old value.
|
|||
|
|
|
|||
|
|
;; This is basicly a performance hack. It would have been possible to
|
|||
|
|
;; thread this state using a association-list through the parsers, but it
|
|||
|
|
;; would be probably more complicated and slower due to the lack of real
|
|||
|
|
;; closures in Emacs Lisp.
|
|||
|
|
;;
|
|||
|
|
;; When finished parsing, the tokenizer returns 'end-token, and
|
|||
|
|
;; following-token is set to the token after point. The parser adds its
|
|||
|
|
;; indentations to possible-indentations and returns to it's parent, or
|
|||
|
|
;; exits non-locally by throwing parse-end, so that the parent will not add
|
|||
|
|
;; new indentations to it.
|
|||
|
|
|
|||
|
|
;; the parse state:
|
|||
|
|
(defvar following-token) ;; the next token after parsing finished
|
|||
|
|
;; the token at the current parser point or a pseudo-token (see
|
|||
|
|
;; `haskell-indentation-read-next-token')
|
|||
|
|
(defvar current-token)
|
|||
|
|
(defvar previous-token)
|
|||
|
|
(defvar left-indent) ;; most left possible indentation
|
|||
|
|
(defvar starter-indent) ;; column at a keyword
|
|||
|
|
(defvar current-indent) ;; the most right indentation
|
|||
|
|
(defvar layout-indent) ;; the column of the layout list
|
|||
|
|
(defvar possible-indentations) ;; the return value of the indentations
|
|||
|
|
(defvar indentation-point) ;; where to stop parsing
|
|||
|
|
(defvar implicit-layout-active) ;; is "off-side" rule active?
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-goto-least-indentation ()
|
|||
|
|
"" ; FIXME
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(if (haskell-indentation-bird-p)
|
|||
|
|
(catch 'return
|
|||
|
|
(while t
|
|||
|
|
(when (not (eq (char-after) ?>))
|
|||
|
|
(forward-line)
|
|||
|
|
(forward-char 2)
|
|||
|
|
(throw 'return nil))
|
|||
|
|
(let ((ps (nth 8 (syntax-ppss))))
|
|||
|
|
(when ps ;; inside comment or string
|
|||
|
|
(goto-char ps)
|
|||
|
|
(beginning-of-line)))
|
|||
|
|
(when (and (>= 2 (haskell-indentation-current-indentation))
|
|||
|
|
(not (looking-at ">\\s-*$")))
|
|||
|
|
(forward-char 2)
|
|||
|
|
(throw 'return nil))
|
|||
|
|
(when (bobp)
|
|||
|
|
(forward-char 2)
|
|||
|
|
(throw 'return nil))
|
|||
|
|
(forward-line -1)))
|
|||
|
|
;; not bird style
|
|||
|
|
(catch 'return
|
|||
|
|
(while (not (bobp))
|
|||
|
|
(let ((point (point)))
|
|||
|
|
;; (forward-comment -1) gets lost if there are unterminated
|
|||
|
|
;; string constants and does not move point anywhere. We fix
|
|||
|
|
;; that case with (forward-line -1)
|
|||
|
|
(forward-comment (- (buffer-size)))
|
|||
|
|
(if (equal (point) point)
|
|||
|
|
(forward-line -1)
|
|||
|
|
(beginning-of-line)))
|
|||
|
|
(let* ((ps (syntax-ppss))
|
|||
|
|
(start-of-comment-or-string (nth 8 ps))
|
|||
|
|
(start-of-list-expression (nth 1 ps)))
|
|||
|
|
(cond
|
|||
|
|
(start-of-comment-or-string
|
|||
|
|
;; inside comment or string
|
|||
|
|
(goto-char start-of-comment-or-string))
|
|||
|
|
(start-of-list-expression
|
|||
|
|
;; inside a parenthesized expression
|
|||
|
|
(goto-char start-of-list-expression))
|
|||
|
|
((= 0 (haskell-indentation-current-indentation))
|
|||
|
|
(throw 'return nil))))))
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(when (bobp)
|
|||
|
|
(forward-comment (buffer-size)))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-parse-to-indentations ()
|
|||
|
|
"" ; FIXME
|
|||
|
|
(save-excursion
|
|||
|
|
(skip-syntax-forward "-")
|
|||
|
|
(let ((indentation-point (point))
|
|||
|
|
(layout-indent 0)
|
|||
|
|
(current-indent haskell-indentation-layout-offset)
|
|||
|
|
(starter-indent haskell-indentation-layout-offset)
|
|||
|
|
(left-indent haskell-indentation-layout-offset)
|
|||
|
|
(case-fold-search nil)
|
|||
|
|
current-token
|
|||
|
|
previous-token
|
|||
|
|
following-token
|
|||
|
|
possible-indentations
|
|||
|
|
implicit-layout-active)
|
|||
|
|
(haskell-indentation-goto-least-indentation)
|
|||
|
|
(if (<= indentation-point (point))
|
|||
|
|
(haskell-indentation-first-indentation)
|
|||
|
|
(setq current-token (haskell-indentation-peek-token))
|
|||
|
|
(catch 'parse-end
|
|||
|
|
(haskell-indentation-toplevel))
|
|||
|
|
possible-indentations))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-first-indentation ()
|
|||
|
|
"Return column of first indentation."
|
|||
|
|
(list (if (haskell-indentation-bird-p) 2 0)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-find-indentations ()
|
|||
|
|
"Return list of indentation positions corresponding to actual cursor position."
|
|||
|
|
(let ((ppss (syntax-ppss)))
|
|||
|
|
(cond
|
|||
|
|
((nth 3 ppss)
|
|||
|
|
(if (save-excursion
|
|||
|
|
(and (forward-line -1)
|
|||
|
|
(< (nth 8 ppss) (point))))
|
|||
|
|
;; if this string goes over more than one line we want to
|
|||
|
|
;; sync with the last line, not the first one
|
|||
|
|
(list (save-excursion
|
|||
|
|
(forward-line -1)
|
|||
|
|
(current-indentation)))
|
|||
|
|
|
|||
|
|
(append
|
|||
|
|
(haskell-indentation-first-indentation)
|
|||
|
|
(list (save-excursion
|
|||
|
|
(goto-char (nth 8 ppss))
|
|||
|
|
(current-column))))))
|
|||
|
|
((nth 4 ppss)
|
|||
|
|
(if (save-excursion
|
|||
|
|
(and (skip-syntax-forward "-")
|
|||
|
|
(eolp)
|
|||
|
|
(not (> (forward-line 1) 0))
|
|||
|
|
(not (nth 4 (syntax-ppss)))))
|
|||
|
|
(haskell-indentation-parse-to-indentations)
|
|||
|
|
(haskell-indentation-first-indentation)))
|
|||
|
|
(t
|
|||
|
|
(haskell-indentation-parse-to-indentations)))))
|
|||
|
|
|
|||
|
|
(defconst haskell-indentation-unicode-tokens
|
|||
|
|
'(("→" . "->") ;; #x2192 RIGHTWARDS ARROW
|
|||
|
|
("∷" . "::") ;; #x2237 PROPORTION
|
|||
|
|
("←" . "<-") ;; #x2190 LEFTWARDS ARROW
|
|||
|
|
("⇒" . "=>") ;; #x21D2 RIGHTWARDS DOUBLE ARROW
|
|||
|
|
("∀" . "forall") ;; #x2200 FOR ALL
|
|||
|
|
("⤙" . "-<") ;; #x2919 LEFTWARDS ARROW-TAIL
|
|||
|
|
("⤚" . ">-") ;; #x291A RIGHTWARDS ARROW-TAIL
|
|||
|
|
("⤛" . "-<<") ;; #x291B LEFTWARDS DOUBLE ARROW-TAIL
|
|||
|
|
("⤜" . ">>-") ;; #x291C RIGHTWARDS DOUBLE ARROW-TAIL
|
|||
|
|
("★" . "*")) ;; #x2605 BLACK STAR
|
|||
|
|
"Translation from UnicodeSyntax tokens to their ASCII representation.")
|
|||
|
|
|
|||
|
|
(defconst haskell-indentation-toplevel-list
|
|||
|
|
`(("module" . haskell-indentation-module)
|
|||
|
|
("signature" . haskell-indentation-module)
|
|||
|
|
("data" . haskell-indentation-data)
|
|||
|
|
("type" . haskell-indentation-data)
|
|||
|
|
("newtype" . haskell-indentation-data)
|
|||
|
|
("import" . haskell-indentation-import)
|
|||
|
|
("foreign" . haskell-indentation-foreign)
|
|||
|
|
("where" . haskell-indentation-toplevel-where)
|
|||
|
|
("class" . haskell-indentation-class-declaration)
|
|||
|
|
("instance" . haskell-indentation-class-declaration)
|
|||
|
|
("deriving" . haskell-indentation-deriving))
|
|||
|
|
"Alist of toplevel keywords with associated parsers.")
|
|||
|
|
|
|||
|
|
(defconst haskell-indentation-type-list
|
|||
|
|
`(("::" .
|
|||
|
|
,(apply-partially 'haskell-indentation-with-starter
|
|||
|
|
(apply-partially 'haskell-indentation-separated
|
|||
|
|
'haskell-indentation-type '("->" "=>"))))
|
|||
|
|
("(" .
|
|||
|
|
,(apply-partially 'haskell-indentation-list
|
|||
|
|
'haskell-indentation-type ")" ","))
|
|||
|
|
("[" .
|
|||
|
|
,(apply-partially 'haskell-indentation-list
|
|||
|
|
'haskell-indentation-type "]" ","))
|
|||
|
|
("{" .
|
|||
|
|
,(apply-partially 'haskell-indentation-list
|
|||
|
|
'haskell-indentation-type "}" ",")))
|
|||
|
|
"Alist of tokens in type declarations with associated parsers.")
|
|||
|
|
|
|||
|
|
(defconst haskell-indentation-expression-list
|
|||
|
|
`(("data" . haskell-indentation-data)
|
|||
|
|
("type" . haskell-indentation-data)
|
|||
|
|
("newtype" . haskell-indentation-data)
|
|||
|
|
("if" . haskell-indentation-if)
|
|||
|
|
("let" .
|
|||
|
|
,(apply-partially 'haskell-indentation-phrase
|
|||
|
|
'(haskell-indentation-declaration-layout
|
|||
|
|
"in" haskell-indentation-expression)))
|
|||
|
|
("do" .
|
|||
|
|
,(apply-partially 'haskell-indentation-with-starter
|
|||
|
|
'haskell-indentation-expression-layout))
|
|||
|
|
("mdo" .
|
|||
|
|
,(apply-partially 'haskell-indentation-with-starter
|
|||
|
|
'haskell-indentation-expression-layout))
|
|||
|
|
("rec" .
|
|||
|
|
,(apply-partially 'haskell-indentation-with-starter
|
|||
|
|
'haskell-indentation-expression-layout))
|
|||
|
|
("case" .
|
|||
|
|
,(apply-partially 'haskell-indentation-phrase
|
|||
|
|
'(haskell-indentation-expression
|
|||
|
|
"of" haskell-indentation-case-layout)))
|
|||
|
|
("\\" .
|
|||
|
|
,(apply-partially 'haskell-indentation-with-starter
|
|||
|
|
'haskell-indentation-lambda-maybe-lambdacase))
|
|||
|
|
("proc" .
|
|||
|
|
,(apply-partially 'haskell-indentation-phrase
|
|||
|
|
'(haskell-indentation-expression
|
|||
|
|
"->" haskell-indentation-expression)))
|
|||
|
|
("where" .
|
|||
|
|
,(apply-partially 'haskell-indentation-with-starter
|
|||
|
|
'haskell-indentation-declaration-layout nil t))
|
|||
|
|
("::" . haskell-indentation-scoped-type)
|
|||
|
|
("=" .
|
|||
|
|
,(apply-partially 'haskell-indentation-statement-right
|
|||
|
|
'haskell-indentation-expression))
|
|||
|
|
("<-" .
|
|||
|
|
,(apply-partially 'haskell-indentation-statement-right
|
|||
|
|
'haskell-indentation-expression))
|
|||
|
|
("(" .
|
|||
|
|
,(apply-partially 'haskell-indentation-list
|
|||
|
|
'haskell-indentation-expression
|
|||
|
|
")"
|
|||
|
|
'(list "," "->")))
|
|||
|
|
("[" .
|
|||
|
|
,(apply-partially 'haskell-indentation-list
|
|||
|
|
'haskell-indentation-expression "]" "," "|"))
|
|||
|
|
("{" .
|
|||
|
|
,(apply-partially 'haskell-indentation-list
|
|||
|
|
'haskell-indentation-expression "}" ",")))
|
|||
|
|
"Alist of keywords in expressions with associated parsers.")
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-expression-layout ()
|
|||
|
|
"Parse layout list with expressions, such as after \"do\"."
|
|||
|
|
(haskell-indentation-layout #'haskell-indentation-expression))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-declaration-layout ()
|
|||
|
|
"Parse layout list with declarations, such as after \"where\"."
|
|||
|
|
(haskell-indentation-layout #'haskell-indentation-declaration))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-case-layout ()
|
|||
|
|
"Parse layout list with case expressions."
|
|||
|
|
(haskell-indentation-layout #'haskell-indentation-case))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-lambda-maybe-lambdacase ()
|
|||
|
|
"Parse lambda or lambda-case expression.
|
|||
|
|
After a lambda (backslash) there are two possible cases:
|
|||
|
|
|
|||
|
|
- the new lambdacase expression, that can be recognized by the
|
|||
|
|
next token being \"case\";
|
|||
|
|
|
|||
|
|
- or simply an anonymous function definition in the form of
|
|||
|
|
\"expression -> expression\"."
|
|||
|
|
(if (string= current-token "case")
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
#'haskell-indentation-case-layout)
|
|||
|
|
(haskell-indentation-phrase-rest
|
|||
|
|
'(haskell-indentation-expression "->" haskell-indentation-expression))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-fundep ()
|
|||
|
|
"Parse functional dependency."
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(apply-partially #'haskell-indentation-separated
|
|||
|
|
#'haskell-indentation-fundep1 ",")))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-fundep1 ()
|
|||
|
|
"Parse an item in functional dependency declaration."
|
|||
|
|
(let ((current-indent (current-column)))
|
|||
|
|
(while (member current-token '(value "->"))
|
|||
|
|
(haskell-indentation-read-next-token))
|
|||
|
|
(when (and (eq current-token 'end-tokens)
|
|||
|
|
(member following-token '(value "->")))
|
|||
|
|
(haskell-indentation-add-indentation current-indent))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-toplevel ()
|
|||
|
|
"Parse toplevel statements."
|
|||
|
|
(haskell-indentation-layout
|
|||
|
|
(lambda ()
|
|||
|
|
(let ((parser (assoc current-token haskell-indentation-toplevel-list)))
|
|||
|
|
(if parser
|
|||
|
|
(funcall (cdr parser))
|
|||
|
|
(haskell-indentation-declaration))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-type ()
|
|||
|
|
"Parse type declaration."
|
|||
|
|
(let ((current-indent (current-column)))
|
|||
|
|
(catch 'return
|
|||
|
|
(while t
|
|||
|
|
(cond
|
|||
|
|
((member current-token '(value operator "->" "=>"))
|
|||
|
|
(haskell-indentation-read-next-token))
|
|||
|
|
|
|||
|
|
((eq current-token 'end-tokens)
|
|||
|
|
(when (member following-token
|
|||
|
|
'(value operator no-following-token
|
|||
|
|
"(" "[" "{" "::"))
|
|||
|
|
(if (equal following-token "=>")
|
|||
|
|
(haskell-indentation-add-indentation starter-indent)
|
|||
|
|
(haskell-indentation-add-indentation current-indent))
|
|||
|
|
(haskell-indentation-add-indentation left-indent))
|
|||
|
|
(throw 'return nil))
|
|||
|
|
(t (let ((parser (assoc current-token haskell-indentation-type-list)))
|
|||
|
|
(if (not parser)
|
|||
|
|
(throw 'return nil)
|
|||
|
|
(funcall (cdr parser))))))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-type-1 ()
|
|||
|
|
"Parse a single type declaration."
|
|||
|
|
(let ((current-indent (current-column)))
|
|||
|
|
(catch 'return
|
|||
|
|
(cond
|
|||
|
|
((member current-token '(value operator "->" "=>"))
|
|||
|
|
(haskell-indentation-read-next-token))
|
|||
|
|
|
|||
|
|
((eq current-token 'end-tokens)
|
|||
|
|
(when (member following-token
|
|||
|
|
'(value operator no-following-token
|
|||
|
|
"->" "=>" "(" "[" "{" "::"))
|
|||
|
|
(haskell-indentation-add-indentation current-indent))
|
|||
|
|
(throw 'return nil))
|
|||
|
|
(t (let ((parser (assoc current-token haskell-indentation-type-list)))
|
|||
|
|
(if (not parser)
|
|||
|
|
(throw 'return nil)
|
|||
|
|
(funcall (cdr parser)))))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-scoped-type ()
|
|||
|
|
"Parse scoped type declaration.
|
|||
|
|
|
|||
|
|
For example
|
|||
|
|
let x :: Int = 12
|
|||
|
|
do x :: Int <- return 12"
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(apply-partially #'haskell-indentation-separated #'haskell-indentation-type '("->" "=>")))
|
|||
|
|
(when (member current-token '("<-" "="))
|
|||
|
|
(haskell-indentation-statement-right #'haskell-indentation-expression)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-data ()
|
|||
|
|
"Parse data or type declaration."
|
|||
|
|
(haskell-indentation-read-next-token)
|
|||
|
|
(when (string= current-token "instance")
|
|||
|
|
(haskell-indentation-read-next-token))
|
|||
|
|
(haskell-indentation-type)
|
|||
|
|
(cond ((eq current-token 'end-tokens)
|
|||
|
|
(when (member following-token '("=" "where"))
|
|||
|
|
(haskell-indentation-add-indentation current-indent)
|
|||
|
|
(throw 'parse-end nil)))
|
|||
|
|
((string= current-token "=")
|
|||
|
|
(let ((starter-indent-inside (current-column)))
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(lambda ()
|
|||
|
|
(haskell-indentation-separated
|
|||
|
|
#'haskell-indentation-expression "|")))
|
|||
|
|
(cond
|
|||
|
|
((equal current-token 'end-tokens)
|
|||
|
|
(when (string= following-token "deriving")
|
|||
|
|
(haskell-indentation-push-indentation starter-indent-inside)
|
|||
|
|
(haskell-indentation-add-left-indent)))
|
|||
|
|
((equal current-token "deriving")
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
#'haskell-indentation-type-1)))))
|
|||
|
|
((string= current-token "where")
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
#'haskell-indentation-expression-layout nil)
|
|||
|
|
(cond
|
|||
|
|
((equal current-token 'end-tokens)
|
|||
|
|
(when (string= following-token "deriving")
|
|||
|
|
(haskell-indentation-add-left-indent)))
|
|||
|
|
((equal current-token "deriving")
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
#'haskell-indentation-type-1))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-import ()
|
|||
|
|
"Parse import declaration."
|
|||
|
|
(haskell-indentation-with-starter #'haskell-indentation-expression))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-foreign ()
|
|||
|
|
"Parse foreign import declaration."
|
|||
|
|
(haskell-indentation-with-starter (apply-partially #'haskell-indentation-expression '(value operator "import"))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-class-declaration ()
|
|||
|
|
"Parse class declaration."
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(lambda ()
|
|||
|
|
(haskell-indentation-type)
|
|||
|
|
(when (string= current-token "|")
|
|||
|
|
(haskell-indentation-fundep))
|
|||
|
|
(when (string= current-token "where")
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
#'haskell-indentation-declaration-layout nil)))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-deriving ()
|
|||
|
|
"Parse standalone declaration."
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(lambda ()
|
|||
|
|
(when (string= "instance" current-token)
|
|||
|
|
(haskell-indentation-read-next-token))
|
|||
|
|
(when (equal current-token 'end-tokens)
|
|||
|
|
(haskell-indentation-add-left-indent)
|
|||
|
|
(throw 'parse-end nil))
|
|||
|
|
(haskell-indentation-type)
|
|||
|
|
(when (string= current-token "|")
|
|||
|
|
(haskell-indentation-fundep)))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-module ()
|
|||
|
|
"Parse module declaration."
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(lambda ()
|
|||
|
|
(haskell-indentation-read-next-token)
|
|||
|
|
(when (equal current-token 'layout-item)
|
|||
|
|
(haskell-indentation-read-next-token))
|
|||
|
|
(when (string= current-token "(")
|
|||
|
|
(haskell-indentation-list
|
|||
|
|
#'haskell-indentation-module-export
|
|||
|
|
")" ","))
|
|||
|
|
(if (string= current-token "where")
|
|||
|
|
(haskell-indentation-read-next-token)
|
|||
|
|
|
|||
|
|
(when (eq current-token 'end-tokens)
|
|||
|
|
(when (member following-token '(value no-following-token "("))
|
|||
|
|
(haskell-indentation-add-indentation
|
|||
|
|
(+ starter-indent haskell-indentation-starter-offset))
|
|||
|
|
(haskell-indentation-add-indentation
|
|||
|
|
(+ left-indent haskell-indentation-starter-offset))
|
|||
|
|
(throw 'parse-end nil))
|
|||
|
|
(haskell-indentation-add-layout-indent)
|
|||
|
|
(throw 'parse-end nil))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-toplevel-where ()
|
|||
|
|
"Parse 'where' that we may hit as a standalone in module declaration."
|
|||
|
|
(haskell-indentation-read-next-token)
|
|||
|
|
|
|||
|
|
(when (eq current-token 'end-tokens)
|
|||
|
|
(haskell-indentation-add-layout-indent)
|
|||
|
|
(throw 'parse-end nil)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-module-export ()
|
|||
|
|
"Parse export list."
|
|||
|
|
(cond ((string= current-token "module")
|
|||
|
|
(let ((current-indent (current-column)))
|
|||
|
|
(haskell-indentation-read-next-token)
|
|||
|
|
(cond ((eq current-token 'end-tokens)
|
|||
|
|
(haskell-indentation-add-indentation current-indent))
|
|||
|
|
((eq current-token 'value)
|
|||
|
|
(haskell-indentation-read-next-token)))))
|
|||
|
|
(t (haskell-indentation-type))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-list (parser end sep &optional stmt-sep)
|
|||
|
|
"Parse a list, pair or other expression containing multiple
|
|||
|
|
items parsed by PARSER, separated by SEP or STMT-SEP, and ending
|
|||
|
|
with END."
|
|||
|
|
;; note that we use macro expansion here to preserver Emacs 23
|
|||
|
|
;; compatibility and its lack of lexical binding
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
`(lambda ()
|
|||
|
|
(let ((implicit-layout-active nil))
|
|||
|
|
(haskell-indentation-separated
|
|||
|
|
#',parser ,sep ,stmt-sep)))
|
|||
|
|
end))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-with-starter (parser &optional end where-expr?)
|
|||
|
|
"Parse an expression starting with a keyword or parenthesis.
|
|||
|
|
Skip the keyword or parenthesis." ; FIXME: better description needed
|
|||
|
|
(let ((starter-column (current-column))
|
|||
|
|
(current-indent current-indent)
|
|||
|
|
(left-indent
|
|||
|
|
(if (= (current-column) (haskell-indentation-current-indentation))
|
|||
|
|
(current-column)
|
|||
|
|
left-indent)))
|
|||
|
|
(haskell-indentation-read-next-token)
|
|||
|
|
(when (eq current-token 'end-tokens)
|
|||
|
|
(cond ((equal following-token end)
|
|||
|
|
;; indent before keyword or parenthesis
|
|||
|
|
(haskell-indentation-add-indentation starter-column))
|
|||
|
|
(where-expr?
|
|||
|
|
;; left indent + where post indent
|
|||
|
|
(haskell-indentation-add-where-post-indent left-indent))
|
|||
|
|
(t
|
|||
|
|
(haskell-indentation-add-left-indent)))
|
|||
|
|
(throw 'parse-end nil))
|
|||
|
|
(let* ((current-indent (current-column))
|
|||
|
|
(starter-indent (min starter-column current-indent))
|
|||
|
|
(left-indent
|
|||
|
|
(if end
|
|||
|
|
(+ starter-indent haskell-indentation-starter-offset)
|
|||
|
|
left-indent)))
|
|||
|
|
(funcall parser)
|
|||
|
|
(cond ((eq current-token 'end-tokens)
|
|||
|
|
(when (equal following-token end)
|
|||
|
|
;; indent before keyword or parenthesis
|
|||
|
|
(haskell-indentation-add-indentation starter-indent))
|
|||
|
|
;; add no more indentations if we expect a closing keyword
|
|||
|
|
(when end
|
|||
|
|
(throw 'parse-end nil)))
|
|||
|
|
((equal current-token end)
|
|||
|
|
(haskell-indentation-read-next-token))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-case-alternative ()
|
|||
|
|
"" ; FIXME
|
|||
|
|
(setq left-indent (current-column))
|
|||
|
|
(haskell-indentation-separated #'haskell-indentation-expression "," nil)
|
|||
|
|
(cond ((eq current-token 'end-tokens)
|
|||
|
|
(haskell-indentation-add-indentation current-indent))
|
|||
|
|
((string= current-token "->")
|
|||
|
|
(haskell-indentation-statement-right #'haskell-indentation-expression))
|
|||
|
|
;; otherwise fallthrough
|
|||
|
|
))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-case ()
|
|||
|
|
"" ; FIXME
|
|||
|
|
(haskell-indentation-expression)
|
|||
|
|
(cond ((eq current-token 'end-tokens)
|
|||
|
|
(haskell-indentation-add-indentation current-indent))
|
|||
|
|
((string= current-token "|")
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(apply-partially #'haskell-indentation-separated
|
|||
|
|
#'haskell-indentation-case-alternative "|" nil)
|
|||
|
|
nil))
|
|||
|
|
((string= current-token "->")
|
|||
|
|
(haskell-indentation-statement-right #'haskell-indentation-expression))
|
|||
|
|
;; otherwise fallthrough
|
|||
|
|
))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-statement-right (parser)
|
|||
|
|
"Process right side of a statement.
|
|||
|
|
Set `current-indent' to the current column and calls the given
|
|||
|
|
parser. If parsing ends here, set indentation to left-indent."
|
|||
|
|
(haskell-indentation-read-next-token)
|
|||
|
|
(when (eq current-token 'end-tokens)
|
|||
|
|
(haskell-indentation-add-left-indent)
|
|||
|
|
(haskell-indentation-add-indentation current-indent)
|
|||
|
|
(throw 'parse-end nil))
|
|||
|
|
(funcall parser)
|
|||
|
|
(when (equal current-token "where")
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
#'haskell-indentation-expression-layout nil)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-guard ()
|
|||
|
|
"Parse \"guard\" statement."
|
|||
|
|
(setq left-indent (current-column))
|
|||
|
|
(haskell-indentation-separated
|
|||
|
|
#'haskell-indentation-expression "," nil))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-declaration ()
|
|||
|
|
"Parse function or type declaration."
|
|||
|
|
(haskell-indentation-separated #'haskell-indentation-expression "," nil)
|
|||
|
|
(when (string= current-token "|")
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(apply-partially #'haskell-indentation-separated
|
|||
|
|
#'haskell-indentation-guard "|" nil)
|
|||
|
|
nil))
|
|||
|
|
(when (eq current-token 'end-tokens)
|
|||
|
|
(when (member following-token '("|" "=" "::" ","))
|
|||
|
|
(haskell-indentation-add-indentation current-indent)
|
|||
|
|
(throw 'parse-end nil))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-layout (parser)
|
|||
|
|
"Parse layout list, where each layout item is parsed by parser."
|
|||
|
|
(if (string= current-token "{")
|
|||
|
|
(haskell-indentation-list parser "}" ";") ; explicit layout
|
|||
|
|
(haskell-indentation-implicit-layout-list parser)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-expression-token-p (token)
|
|||
|
|
"Return non-NIL value if TOKEN is an expression token."
|
|||
|
|
(member token
|
|||
|
|
'("if" "let" "do" "case" "\\" "(" "{" "[" "::"
|
|||
|
|
value operator no-following-token)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-expression (&optional accepted-tokens)
|
|||
|
|
"Parse an expression until an unknown token is encountered."
|
|||
|
|
(catch 'return
|
|||
|
|
(let ((current-indent (current-column)))
|
|||
|
|
(unless accepted-tokens
|
|||
|
|
(setq accepted-tokens '(value operator)))
|
|||
|
|
(while t
|
|||
|
|
(cond
|
|||
|
|
((memq current-token accepted-tokens)
|
|||
|
|
(haskell-indentation-read-next-token))
|
|||
|
|
((eq current-token 'end-tokens)
|
|||
|
|
(cond ((string= following-token "where")
|
|||
|
|
(haskell-indentation-add-where-pre-indent)) ; before a where
|
|||
|
|
((haskell-indentation-expression-token-p following-token)
|
|||
|
|
;; a normal expression can be either continued or have
|
|||
|
|
;; left indent
|
|||
|
|
(haskell-indentation-add-indentation
|
|||
|
|
current-indent)
|
|||
|
|
(haskell-indentation-add-indentation
|
|||
|
|
left-indent)))
|
|||
|
|
(throw 'return nil))
|
|||
|
|
(t (let ((parser (assoc current-token
|
|||
|
|
haskell-indentation-expression-list)))
|
|||
|
|
(when (null parser)
|
|||
|
|
(throw 'return nil)) ; not expression token, so exit
|
|||
|
|
(funcall (cdr parser)) ; run parser
|
|||
|
|
|
|||
|
|
;; after an 'open' expression such as 'if', exit
|
|||
|
|
(unless (member (car parser) '("(" "[" "{" "case"))
|
|||
|
|
(throw 'return nil)))))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-separated (parser separator &optional stmt-separator)
|
|||
|
|
"Evaluate PARSER separated by SEPARATOR and STMT-SEPARATOR.
|
|||
|
|
If STMT-SEPARATOR is not NIL, it will be used to set a new starter-indent.
|
|||
|
|
|
|||
|
|
For example:
|
|||
|
|
|
|||
|
|
[ i | i <- [1..10]
|
|||
|
|
,"
|
|||
|
|
(catch 'return
|
|||
|
|
(unless (listp separator)
|
|||
|
|
(setq separator (list separator)))
|
|||
|
|
(unless (listp stmt-separator)
|
|||
|
|
(setq stmt-separator (list stmt-separator)))
|
|||
|
|
(while t
|
|||
|
|
(funcall parser)
|
|||
|
|
(cond ((member current-token separator)
|
|||
|
|
(haskell-indentation-at-separator))
|
|||
|
|
|
|||
|
|
((member current-token stmt-separator)
|
|||
|
|
(setq starter-indent (current-column))
|
|||
|
|
(haskell-indentation-at-separator))
|
|||
|
|
|
|||
|
|
((eq current-token 'end-tokens)
|
|||
|
|
(when (or (member following-token separator)
|
|||
|
|
(member following-token stmt-separator))
|
|||
|
|
;; Set an indentation before a separator, for example:
|
|||
|
|
;; [ 1 or [ 1 | a
|
|||
|
|
;; , 2 , 20
|
|||
|
|
(haskell-indentation-add-indentation starter-indent)
|
|||
|
|
(when (< left-indent starter-indent)
|
|||
|
|
(haskell-indentation-add-indentation left-indent))
|
|||
|
|
(throw 'parse-end nil))
|
|||
|
|
(when (equal following-token 'no-following-token)
|
|||
|
|
;; Set an indentation before a separator, for example:
|
|||
|
|
;; [ 1 or [ 1 | a
|
|||
|
|
;; , 2 , 20
|
|||
|
|
(haskell-indentation-add-indentation starter-indent)
|
|||
|
|
(haskell-indentation-add-indentation left-indent))
|
|||
|
|
(throw 'return nil))
|
|||
|
|
(t (throw 'return nil))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-at-separator ()
|
|||
|
|
"At a separator.
|
|||
|
|
|
|||
|
|
If at a new line, set starter-indent at the separator
|
|||
|
|
and current-indent after the separator, for example:
|
|||
|
|
|
|||
|
|
l = [ 1
|
|||
|
|
, 2
|
|||
|
|
, -- start now here."
|
|||
|
|
(let ((separator-column
|
|||
|
|
(and (= (current-column) (haskell-indentation-current-indentation))
|
|||
|
|
(current-column))))
|
|||
|
|
(haskell-indentation-read-next-token)
|
|||
|
|
(cond ((eq current-token 'end-tokens)
|
|||
|
|
(haskell-indentation-add-indentation current-indent)
|
|||
|
|
(haskell-indentation-add-indentation left-indent)
|
|||
|
|
(throw 'return nil))
|
|||
|
|
(separator-column ; on the beginning of the line
|
|||
|
|
(setq current-indent (current-column))
|
|||
|
|
(setq starter-indent separator-column)
|
|||
|
|
(setq left-indent
|
|||
|
|
(+ starter-indent haskell-indentation-starter-offset))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-implicit-layout-list (parser)
|
|||
|
|
"An implicit layout list, elements are parsed with PARSER.
|
|||
|
|
This sets the `layout-indent' variable to the column where the
|
|||
|
|
layout starts."
|
|||
|
|
(let* ((layout-indent (current-column))
|
|||
|
|
(current-indent (current-column))
|
|||
|
|
(left-indent (current-column))
|
|||
|
|
(implicit-layout-active t))
|
|||
|
|
(catch 'return
|
|||
|
|
(while t
|
|||
|
|
(let ((left-indent left-indent))
|
|||
|
|
(funcall parser))
|
|||
|
|
(cond ((member current-token '(layout-item ";"))
|
|||
|
|
(haskell-indentation-read-next-token))
|
|||
|
|
((eq current-token 'end-tokens)
|
|||
|
|
(when (or (and
|
|||
|
|
(not (member following-token '("{" operator)))
|
|||
|
|
(not (member previous-token '(operator)))
|
|||
|
|
(haskell-indentation-expression-token-p following-token))
|
|||
|
|
(string= following-token ";")
|
|||
|
|
(and (equal layout-indent 0)
|
|||
|
|
(member following-token (mapcar #'car haskell-indentation-toplevel-list))
|
|||
|
|
(not (string= following-token "where"))))
|
|||
|
|
(haskell-indentation-add-layout-indent))
|
|||
|
|
(throw 'return nil))
|
|||
|
|
(t (throw 'return nil))))))
|
|||
|
|
;; put `haskell-indentation-read-next-token' outside the current-indent
|
|||
|
|
;; definition so it will not return 'layout-end again
|
|||
|
|
(when (eq current-token 'layout-end)
|
|||
|
|
(let ((implicit-layout-active t))
|
|||
|
|
;; leave layout at 'layout-end or illegal token
|
|||
|
|
(haskell-indentation-read-next-token))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-if ()
|
|||
|
|
"" ; FIXME
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(lambda ()
|
|||
|
|
(if (string= current-token "|")
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(lambda ()
|
|||
|
|
(haskell-indentation-separated
|
|||
|
|
#'haskell-indentation-case-alternative "|" nil))
|
|||
|
|
nil)
|
|||
|
|
(haskell-indentation-phrase-rest
|
|||
|
|
'(haskell-indentation-expression
|
|||
|
|
"then" haskell-indentation-expression
|
|||
|
|
"else" haskell-indentation-expression))))
|
|||
|
|
nil))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-phrase (phrase)
|
|||
|
|
"" ; FIXME
|
|||
|
|
(haskell-indentation-with-starter
|
|||
|
|
(apply-partially #'haskell-indentation-phrase-rest phrase)
|
|||
|
|
nil))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-phrase-rest (phrase1)
|
|||
|
|
"" ; FIXME
|
|||
|
|
(while phrase1
|
|||
|
|
(let ((phrase phrase1))
|
|||
|
|
(setq phrase1 nil)
|
|||
|
|
(let ((current-indent (current-column))
|
|||
|
|
(left-indent left-indent)
|
|||
|
|
(layout-indent layout-indent))
|
|||
|
|
(funcall (car phrase)))
|
|||
|
|
(cond
|
|||
|
|
((eq current-token 'end-tokens)
|
|||
|
|
(cond ((null (cdr phrase))) ;; fallthrough
|
|||
|
|
((equal following-token (cadr phrase))
|
|||
|
|
(haskell-indentation-add-indentation starter-indent)
|
|||
|
|
(unless (member following-token '("," ";"))
|
|||
|
|
;; we want to keep comma and semicolon aligned always
|
|||
|
|
(haskell-indentation-add-indentation left-indent))
|
|||
|
|
(throw 'parse-end nil))
|
|||
|
|
((string= (cadr phrase) "in")
|
|||
|
|
(when (= left-indent layout-indent)
|
|||
|
|
(haskell-indentation-add-layout-indent)
|
|||
|
|
(throw 'parse-end nil)))
|
|||
|
|
(t (throw 'parse-end nil))))
|
|||
|
|
((null (cdr phrase)))
|
|||
|
|
((equal (cadr phrase) current-token)
|
|||
|
|
(haskell-indentation-read-next-token)
|
|||
|
|
(when (eq current-token 'end-tokens)
|
|||
|
|
(haskell-indentation-add-indentation
|
|||
|
|
(+ starter-indent haskell-indentation-starter-offset))
|
|||
|
|
(haskell-indentation-add-indentation
|
|||
|
|
(+ left-indent haskell-indentation-starter-offset))
|
|||
|
|
(throw 'parse-end nil))
|
|||
|
|
(setq phrase1 (cddr phrase)))
|
|||
|
|
((string= (cadr phrase) "in"))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-add-indentation (indent)
|
|||
|
|
"" ; FIXME
|
|||
|
|
(haskell-indentation-push-indentation
|
|||
|
|
(if (<= indent layout-indent)
|
|||
|
|
(+ layout-indent haskell-indentation-layout-offset)
|
|||
|
|
indent)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-add-layout-indent ()
|
|||
|
|
"" ; FIXME
|
|||
|
|
(haskell-indentation-push-indentation layout-indent))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-add-where-pre-indent ()
|
|||
|
|
"" ; FIXME
|
|||
|
|
(haskell-indentation-push-indentation
|
|||
|
|
(+ layout-indent haskell-indentation-where-pre-offset))
|
|||
|
|
(if (= layout-indent haskell-indentation-layout-offset)
|
|||
|
|
(haskell-indentation-push-indentation
|
|||
|
|
haskell-indentation-where-pre-offset)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-add-where-post-indent (indent)
|
|||
|
|
"" ; FIXME
|
|||
|
|
(haskell-indentation-push-indentation
|
|||
|
|
(+ indent haskell-indentation-where-post-offset)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-add-left-indent ()
|
|||
|
|
"" ; FIXME
|
|||
|
|
(haskell-indentation-add-indentation
|
|||
|
|
(+ left-indent haskell-indentation-left-offset)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-push-indentation (indent)
|
|||
|
|
"Add INDENT to list of possible indentations.
|
|||
|
|
|
|||
|
|
Add INDENT to `possible-indentations' if it is not there
|
|||
|
|
yet. Keep the list in ascending order."
|
|||
|
|
(unless (member indent possible-indentations)
|
|||
|
|
(setq possible-indentations
|
|||
|
|
(sort (cons indent possible-indentations) #'<))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-read-next-token ()
|
|||
|
|
"Go to the next token and set current-token to the next token.
|
|||
|
|
|
|||
|
|
The following symbols are used as pseudo tokens:
|
|||
|
|
|
|||
|
|
'layout-item: A new item in a layout list. The next token
|
|||
|
|
will be the first token from the item.
|
|||
|
|
|
|||
|
|
'layout-end: the end of a layout list. Next token will be
|
|||
|
|
the first token after the layout list.
|
|||
|
|
|
|||
|
|
'end-tokens: back at point where we started, following-token
|
|||
|
|
will be set to the next token.
|
|||
|
|
|
|||
|
|
Pseudo tokens are used only when implicit-layout-active is
|
|||
|
|
t. That is the case only after keywords \"do\", \"where\",
|
|||
|
|
\"let\" and \"of\".
|
|||
|
|
|
|||
|
|
If we are at a new line, parse-line is increased, and
|
|||
|
|
current-indent and left-indent are set to the indentation of the
|
|||
|
|
line."
|
|||
|
|
(cond ((and implicit-layout-active
|
|||
|
|
(eq current-token 'end-tokens))
|
|||
|
|
'end-tokens)
|
|||
|
|
((and implicit-layout-active
|
|||
|
|
(eq current-token 'layout-end))
|
|||
|
|
(cond ((> layout-indent (current-column))
|
|||
|
|
'layout-end)
|
|||
|
|
((= layout-indent (current-column))
|
|||
|
|
(setq current-token 'layout-item))
|
|||
|
|
((< layout-indent (current-column))
|
|||
|
|
(setq current-token (haskell-indentation-peek-token)))))
|
|||
|
|
((and implicit-layout-active
|
|||
|
|
(eq current-token 'layout-item))
|
|||
|
|
(setq current-token (haskell-indentation-peek-token)))
|
|||
|
|
((and implicit-layout-active
|
|||
|
|
(> layout-indent (current-column)))
|
|||
|
|
(setq current-token 'layout-end))
|
|||
|
|
(t
|
|||
|
|
(setq previous-token (haskell-indentation-peek-token))
|
|||
|
|
(haskell-indentation-skip-token)
|
|||
|
|
(if (>= (point) indentation-point)
|
|||
|
|
(progn
|
|||
|
|
(setq following-token
|
|||
|
|
(if (and (not (eobp))
|
|||
|
|
(= (point) indentation-point))
|
|||
|
|
(haskell-indentation-peek-token)
|
|||
|
|
'no-following-token))
|
|||
|
|
(setq current-token 'end-tokens))
|
|||
|
|
(when (= (current-column) (haskell-indentation-current-indentation))
|
|||
|
|
;; on a new line
|
|||
|
|
(setq current-indent (current-column)))
|
|||
|
|
(cond ((and implicit-layout-active
|
|||
|
|
(> layout-indent (current-column)))
|
|||
|
|
(setq current-token 'layout-end))
|
|||
|
|
((and implicit-layout-active
|
|||
|
|
(= layout-indent (current-column)))
|
|||
|
|
(setq current-token 'layout-item))
|
|||
|
|
(t (setq current-token (haskell-indentation-peek-token))))))))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-peek-token ()
|
|||
|
|
"Return token starting at point."
|
|||
|
|
(cond ((looking-at "\\(if\\|then\\|else\\|let\\|in\\|mdo\\|rec\\|do\\|proc\\|case\\|of\\|where\\|module\\|signature\\|deriving\\|import\\|data\\|type\\|newtype\\|class\\|instance\\)\\([^[:alnum:]'_]\\|$\\)")
|
|||
|
|
(match-string-no-properties 1))
|
|||
|
|
((looking-at "[][(){}[,;]")
|
|||
|
|
(match-string-no-properties 0))
|
|||
|
|
((looking-at "\\(\\\\\\|->\\|<-\\|::\\|=\\||\\|=>\\)\\([^-:!#$%&*+./<=>?@\\\\^|~]\\|$\\)")
|
|||
|
|
(match-string-no-properties 1))
|
|||
|
|
((looking-at "\\(→\\|←\\|∷\\|⇒\\)\\([^-:!#$%&*+./<=>?@\\\\^|~]\\|$\\)")
|
|||
|
|
(let ((tok (match-string-no-properties 1)))
|
|||
|
|
(or (cdr (assoc tok haskell-indentation-unicode-tokens)) tok)))
|
|||
|
|
((looking-at"[-:!#$%&*+./<=>?@\\\\^|~`]" )
|
|||
|
|
'operator)
|
|||
|
|
(t 'value)))
|
|||
|
|
|
|||
|
|
(defun haskell-indentation-skip-token ()
|
|||
|
|
"Skip to the next token."
|
|||
|
|
(if (haskell-lexeme-looking-at-token)
|
|||
|
|
(goto-char (match-end 0))
|
|||
|
|
;; otherwise skip until space found
|
|||
|
|
(skip-syntax-forward "^-"))
|
|||
|
|
;; we have to skip unterminated string fence at the end of line
|
|||
|
|
(skip-chars-forward "\n")
|
|||
|
|
(forward-comment (buffer-size))
|
|||
|
|
(while (and (haskell-indentation-bird-p)
|
|||
|
|
(bolp)
|
|||
|
|
(eq (char-after) ?>))
|
|||
|
|
(forward-char)
|
|||
|
|
(forward-comment (buffer-size))))
|
|||
|
|
|
|||
|
|
(provide 'haskell-indentation)
|
|||
|
|
|
|||
|
|
;; Local Variables:
|
|||
|
|
;; tab-width: 8
|
|||
|
|
;; End:
|
|||
|
|
|
|||
|
|
;;; haskell-indentation.el ends here
|