branch: elpa/haskell-tng-mode
commit 2320b89ba59d363d5e5c698602076b931bd7c72a
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
alternative to smie-rules-* in :elem and :list-intro
---
haskell-tng-layout.el | 8 ++
haskell-tng-smie.el | 198 +++++++++++++++-------------------
haskell-tng-util.el | 10 ++
test/haskell-tng-indent-test.el | 4 +
test/src/indentation.hs.append.indent | 4 +-
test/src/indentation.hs.insert.indent | 20 ++--
test/src/indentation.hs.reindent | 2 +-
7 files changed, 123 insertions(+), 123 deletions(-)
diff --git a/haskell-tng-layout.el b/haskell-tng-layout.el
index 106bccd..bdedb2f 100644
--- a/haskell-tng-layout.el
+++ b/haskell-tng-layout.el
@@ -36,6 +36,14 @@
(require 'haskell-tng-util)
+;; FIXME incorrect layout for brackets near the edge, don't add semis for
commas
+;; and parens.
+;;
+;; ;data Record1 = Record1 {
+;; fieldA :: String
+;; ;, fieldB :: String
+;; ;}
+
;; Easiest cache... full buffer parse with full invalidation on any insertion.
;;
;; A list of (OPEN . (CLOSE . SEPS)) positions, one per inferred block.
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 6f2cc0a..18707ed 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -136,95 +136,89 @@ information, to aid in the creation of new rules."
;; indentation of that token. For example, consider a `do' block, we may get an
;; `:after' and a `:before' for `do' which may be at column 20 but virtually at
;; column 0.
+;;
+;; NOTE https://debbugs.gnu.org/cgi/bugreport.cgi?bug=36434
+;;
+;; smie-rule-* are not designed be used in :elem or :list-intro
(defun haskell-tng-smie:rules (method arg)
(when haskell-tng-smie:debug
(let ((sym (symbol-at-point))
(parent (and (boundp 'smie--parent)
- (caddr (smie-indent--parent))))
- (grand (and (boundp 'smie--parent)
- (caddr (smie-indent--grandparent)))))
+ (caddr (smie-indent--parent)))))
(with-current-buffer haskell-tng-smie:debug
(insert
(format
- "RULES: %S %S %S\n PARENT: %S\n GRAND: %S\n"
- method arg sym parent grand)))))
+ "RULES: %S %S %S\n P: %S\n"
+ method arg sym parent)))))
(pcase method
-
(:elem
(pcase arg
((or 'args 'basic) 0)
('empty-line-token
- ;; WORKAROUND https://debbugs.gnu.org/cgi/bugreport.cgi?bug=36434
- ;;
- ;; smie-rule-* are not designed be used in :elem because there is no
- ;; clear current token. We force their use to mean relative to the
- ;; current empty line, prior to knowing what the expected value should
- ;; be.
- (defvar smie--after)
- (setq smie--after (point))
- (defvar smie--parent)
- (setq smie--parent nil)
- (when haskell-tng-smie:debug
- (let ((parent (caddr (smie-indent--parent)))
- (grand (caddr (smie-indent--grandparent)))
- (pnonid (caddr (smie-indent--prev-nonid))))
- (with-current-buffer haskell-tng-smie:debug
- (insert
- (format
- " PARENT': %S\n GRAND': %S\n NONID: %S\n"
- parent grand pnonid)))))
-
- (cond
- ((or (smie-rule-parent-p "[" "(")
- (and (smie-rule-parent-p "{")
- (smie-rule-grandparent-p "=")))
- ",")
-
- ((or (smie-rule-parent-p "|")
- (and (smie-rule-parent-p "=")
- (smie-rule-grandparent-p "data"))
- (smie-rule-prev-nonid-p "|"))
+ (let* ((parents (save-excursion
+ (haskell-tng-smie:ancestors 2)))
+ (parent (car parents))
+ (grand (cadr parents))
+ (prev (save-excursion
+ (car (smie-indent-backward-token))))
+ (next (save-excursion
+ (car (smie-indent-forward-token)))))
+
(when haskell-tng-smie:debug
(with-current-buffer haskell-tng-smie:debug
- (insert " NEWLINE IS |\n")))
- "|")
-
- ((smie-rule-next-p ";" "}")
- ;; TODO semantic indentation
- ;;
- ;; Consult a local table, populated by an external tool, containing
- ;; the parameter requirements for function calls. For simple cases,
- ;; we should be able to infer if the user wants to terminate ; or
- ;; continue "" the current line.
- ";")
-
- ((save-excursion
- (forward-comment (point-max))
- (eobp))
- ;; this happens when we're at the end of the buffer. Must use
- ;; heuristics before we get to this point.
- ";")
- ))))
+ (insert (format " ^^: %S\n ^: %S\n -1: %S\n +1: %S\n"
+ grand parent prev next))))
+
+ (cond
+ ((or
+ (equal next ",")
+ (member parent '("[" "(" ","))
+ (and (equal parent "{")
+ (equal grand "=")))
+ ",")
+
+ ((or (equal parent "|")
+ ;; TODO not if there is a deriving keyword somewhere
+ (and (equal parent "=")
+ (equal grand "data")
+ (not (equal prev "}"))))
+ "|")
+
+ ((member next '(";" "}"))
+ ;; TODO we could do semantic indentation here
+ ;;
+ ;; Consult a local table, populated by an external tool, containing
+ ;; the parameter requirements for function calls. For simple cases,
+ ;; we should be able to infer if the user wants to terminate ; or
+ ;; continue "" the current line.
+ ";")
+
+ ((save-excursion
+ (forward-comment (point-max))
+ (eobp))
+ ;; this happens when we're at the end of the buffer. Must use
+ ;; heuristics before we get to this point.
+ ";")
+ )))))
(:list-intro
(pcase arg
((or "<-" "SYMID") t)
- ("=" (not (smie-rule-parent-p "data")))
))
(:after
(pcase arg
((or "let" "do" "of" "in" "->" "\\") 2)
- ("=" (when (not (smie-rule-parent-p "data")) 2))
("\\case" 2) ;; LambdaCase
- ("where" (when (not (smie-rule-parent-p "module")) 2))
+ ((and "=" (guard (not (smie-rule-parent-p "data")))) 2)
+ ((and "where" (guard (not (smie-rule-parent-p "module")))) 2)
((or "[" "(") 2)
- ("{" (when (not (smie-rule-prev-p
- "\\case" ;; LambdaCase
- "where" "let" "do" "of"))
- 2))
+ ((and "{" (guard (not (smie-rule-prev-p
+ "\\case" ;; LambdaCase
+ "where" "let" "do" "of"))))
+ 2)
("," (smie-rule-separator method))
((or "SYMID")
(if (smie-rule-hanging-p) 2 (smie-rule-parent)))
@@ -248,14 +242,13 @@ information, to aid in the creation of new rules."
(smie-rule-parent))
("|"
(if (smie-rule-parent-p "=")
- (smie-rule-parent-column)
+ (haskell-tng-smie:rule-parent-column)
(smie-rule-separator method)))
- ((or "[" "(" "{")
- (when (smie-rule-hanging-p)
- (smie-rule-parent)))
+ ((and (or "[" "(" "{") (guard (smie-rule-hanging-p)))
+ (smie-rule-parent))
("," (smie-rule-separator method))
- (_ (when (smie-rule-parent-p "SYMID")
- (smie-rule-parent)))
+ ((guard (smie-rule-parent-p "SYMID"))
+ (smie-rule-parent))
))
))
@@ -372,6 +365,33 @@ BEFORE is t if the line appears before the indentation."
:backward-token #'haskell-tng-lexer:backward-token)
)
+(defun haskell-tng-smie:rule-parent-column ()
+ "For use inside `smie-rules-function',
+use the column indentation as the parent. Note that
+`smie-rule-parent' may use relative values."
+ (save-excursion
+ (goto-char (cadr (smie-indent--parent)))
+ `(column . ,(current-column))))
+
+(defun haskell-tng-smie:ancestors (n)
+ "A list of the Nth non-{identifier, matched paren, string}
+tokens before point, closest first. Leaves the point at the most
+extreme parent.
+
+Inspired by `smie-indent--parent', which can only be used in
+:before and :after."
+ (when-let ((res (or (smie-backward-sexp t)
+ (haskell-tng:until
+ (smie-backward-sexp)
+ (bobp))))
+ (tok (if (car res)
+ ;; break through open parens
+ (car (smie-indent-backward-token))
+ (caddr res))))
+ (if (< 1 n)
+ (cons tok (haskell-tng-smie:ancestors (- n 1)))
+ (list tok))))
+
;; SMIE wishlist, in order of desirability:
;;
;; 1. if the lexer could return lists of tokens.
@@ -389,47 +409,5 @@ BEFORE is t if the line appears before the indentation."
;; but can otherwise be used as a varid. I'd like to be able to lex it as
(or
;; "via" "VARID") so that it can appear in multiple places in the grammar.
-;; Extensions to SMIE
-(defun smie-rule-parent-column ()
- "For use inside `smie-rules-function',
-use the column indentation as the parent. Note that
-`smie-rule-parent' may use relative values."
- (save-excursion
- (goto-char (cadr (smie-indent--parent)))
- `(column . ,(current-column))))
-
-(defun smie-indent--grandparent ()
- "Like `smie-indent--parent' but for the parent's parent."
- (defvar smie--parent)
- (let (cache)
- (save-excursion
- (goto-char (cadr (smie-indent--parent)))
- (setq cache smie--parent)
- (setq smie--parent nil)
- (let ((res (smie-indent--parent)))
- (setq smie--parent cache)
- res))))
-
-(defun smie-rule-grandparent-p (&rest grandparents)
- "Like `smie-rule-parent-p' but for the parent's parent."
- (member (nth 2 (smie-indent--grandparent)) grandparents))
-
-(defun smie-indent--prev-nonid ()
- "Returns the previous non-identifier s-expression."
- (save-excursion
- (let (seen)
- (while (null (setq seen (smie-backward-sexp))))
- seen)))
-
-(defun smie-rule-prev-nonid-p (&rest tokens)
- "Non-nil if the previous non-identifier s-expression is one of TOKENS."
- (member (nth 2 (smie-indent--prev-nonid)) tokens))
-
-(defun smie-debug-parent ()
- (interactive)
- (defvar smie--parent)
- (setq smie--parent nil)
- (smie-indent--parent))
-
(provide 'haskell-tng-smie)
;;; haskell-tng-smie.el ends here
diff --git a/haskell-tng-util.el b/haskell-tng-util.el
index 5f464db..2c08e86 100644
--- a/haskell-tng-util.el
+++ b/haskell-tng-util.el
@@ -60,5 +60,15 @@ and taking a regexp."
default-directory
(lambda (dir) (directory-files dir nil regexp))))
+(defmacro haskell-tng:until (form &optional guard)
+ "Runs `while' on FORM until it is non-nil, returning the value.
+
+A guard is provided which may cause the loop to exit early with nil."
+ (let ((res (gensym "res")))
+ `(let (,res)
+ (while (and (not ,guard)
+ (not (setq ,res ,form))))
+ ,res)))
+
(provide 'haskell-tng-util)
;;; haskell-tng-util.el ends here
diff --git a/test/haskell-tng-indent-test.el b/test/haskell-tng-indent-test.el
index 11a14ca..da015fc 100644
--- a/test/haskell-tng-indent-test.el
+++ b/test/haskell-tng-indent-test.el
@@ -14,10 +14,14 @@
;; FIXME implement more indentation rules
;;
+;; TODO records
+;; TODO coproducts
;; TODO multiline type signatures
;; TODO if/then/else
;; TODO data: one conid ~> record, multi ~> coproduct
+;; TODO reindenting needs attention, it's all over the radar
+
;; Three indentation regression tests are possible:
;;
;; 1. newline-and-indent with the rest of the file deleted (append)
diff --git a/test/src/indentation.hs.append.indent
b/test/src/indentation.hs.append.indent
index a5d99e0..1f9b5ee 100644
--- a/test/src/indentation.hs.append.indent
+++ b/test/src/indentation.hs.append.indent
@@ -149,7 +149,7 @@ not_dollars = do
1 v 2 3
data Wibble = Wibble Int
-v
+1 v
| Wobble Int
1 v
| Vibble Int
@@ -167,7 +167,7 @@ v
v
data Record2 = Record2
-v
+1 v
{ fieldA :: String
1 v
, fieldB :: String
diff --git a/test/src/indentation.hs.insert.indent
b/test/src/indentation.hs.insert.indent
index dc63d4c..5be54f3 100644
--- a/test/src/indentation.hs.insert.indent
+++ b/test/src/indentation.hs.insert.indent
@@ -45,7 +45,7 @@ basic_do = do
sideeffect' blah
2 v 1 3
let baz = blah blah
-3 2 1 4 v
+4 2 1 5 3 v
blah -- manual correction
2 3 v 4 1
gaz = blah
@@ -69,13 +69,13 @@ nested_do = -- manual correction
1 2 v 3 4
nested_where a b = foo a b
-1 v
+1 v
where -- manual correction
1 v
foo = bar baz -- indented
1 v
baz = blah blah -- same level as foo
-2 1 v
+2 1 v
where -- manual correction
1 2 v
gaz a = blah -- indented
@@ -171,7 +171,7 @@ data Record2 = Record2
{ fieldA :: String
1 v
, fieldB :: String
-2 1 v
+1 v
}
v 1
@@ -179,13 +179,13 @@ v 1
lists1 = [ foo
1 v
, bar
-2 1 v
+1 v
, [ blah
2 1 v
, blah
-2 3 1 v
+1 2 v
, blah ]
-2 1 v
+2 v 1
]
v 1 2
@@ -209,13 +209,13 @@ v 1
tuples1 = ( foo
1 v
, bar
-2 1 v
+1 v
, ( blah
2 1 v
, blah
-2 3 1 v
+1 2 v
, blah )
-2 1 v
+2 v 1
)
v 1 2
diff --git a/test/src/indentation.hs.reindent b/test/src/indentation.hs.reindent
index f764170..3a82c98 100644
--- a/test/src/indentation.hs.reindent
+++ b/test/src/indentation.hs.reindent
@@ -46,7 +46,7 @@ v 1 2 3
sideeffect' blah
v 1 3 2
let baz = blah blah
-3 2 1 4 v
+3 2 1 4 v
blah -- manual correction
v 3 2 4 1
gaz = blah
