branch: elpa/haskell-tng-mode
commit 85f20b1d0b05edfa2d6c31fd5522dd16151ea990
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
indent coproducts
---
haskell-tng-smie.el | 116 +++++++++++++++++++++++++++++-----
test/haskell-tng-indent-test.el | 11 +++-
test/src/indentation.hs | 4 ++
test/src/indentation.hs.append.indent | 10 ++-
test/src/indentation.hs.insert.indent | 10 ++-
test/src/indentation.hs.layout | 4 ++
test/src/indentation.hs.lexer | 4 ++
test/src/indentation.hs.reindent | 10 ++-
test/src/indentation.hs.sexps | 6 +-
test/src/indentation.hs.syntax | 4 ++
test/src/layout.hs.sexps | 4 +-
11 files changed, 157 insertions(+), 26 deletions(-)
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index ea4a01b..711aeb4 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -70,6 +70,11 @@
(id "$" infixexp) ;; special case
(id "SYMID" infixexp))
+ (adt
+ ("data" id "=" cop))
+ (cop
+ (cop "|" cop))
+
;; WLDOs
(wldo
("module" blk "where" blk)
@@ -93,7 +98,8 @@
)
;; operator precedences
- '((assoc ";" ",")
+ '((assoc "|")
+ (assoc ";" ",")
)
)))
@@ -130,37 +136,70 @@ information, to aid in the creation of new rules."
;; `:after' and a `:before' for `do' which may be at column 20 but virtually at
;; column 0.
(defun haskell-tng-smie:rules (method arg)
- ;; see docs for `smie-rules-function'
+ ;; WORKAROUND https://debbugs.gnu.org/cgi/bugreport.cgi?bug=36434
+ ;;
+ ;; smie-rule-next-p needs smie--after to be defined.
+ ;; smile-rule-parent-p doesn't work
+ ;;
+ ;; TODO fix the SMIE bug
+ (defvar smie--after)
+ (defvar smie--parent)
+
(when haskell-tng-smie:debug
(let ((sym (symbol-at-point)))
(with-current-buffer haskell-tng-smie:debug
- (insert (format "RULES: %S %S %S\n" method arg sym)))))
+ (insert (format "RULES: %S %S %S\n" method arg sym))))
+ (unless (boundp 'smie--parent)
+ (setq smie--parent nil))
+ (when-let (parent (caddr (smie-indent--parent)))
+ (with-current-buffer haskell-tng-smie:debug
+ (insert (format " PARENT: %S\n" parent))))
+ (when-let (grand (caddr (smie-indent--grandparent)))
+ (with-current-buffer haskell-tng-smie:debug
+ (insert (format " GRAND: %S\n" grand))))
+ (when-let (prev (caddr (smie-indent--previous-line-start)))
+ (with-current-buffer haskell-tng-smie:debug
+ (insert (format " PREV: %S\n" prev)))))
- ;; FIXME core indentation rules
(pcase method
(:elem
(pcase arg
((or 'args 'basic) 0)
- ;; TODO 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.
('empty-line-token
- ;; BUG smie-rule-next-p needs smie--after to be defined
+ ;; even if these are set, they can be wrong
(setq smie--after (point))
- (when (smie-rule-next-p ";" "}") ";"))
- ))
+ (setq smie--parent nil)
+
+ (cond
+ ((or (smie-rule-parent-p "|")
+ (and (smie-rule-parent-p "=")
+ (smie-rule-grandparent-p "data"))
+ (smie-rule-previous-line-start-p "|"))
+ "|")
+
+ ((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.
+ ";")
+
+ ((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.
+ ";")
+ ))))
- ;; Patterns of the form
- ;;
- ;; {TOKEN TOKEN HEAD ; A ; B ; ...}
- ;;
- ;; get called with `:list-intro "HEAD"` when indenting positions A and B.
(:list-intro
(pcase arg
- ((or "<-" "=" "$") t)
+ ((or "<-" "$") t)
+ ("=" (not (smie-rule-parent-p "data")))
))
(:after
@@ -183,9 +222,14 @@ information, to aid in the creation of new rules."
;; blah = bloo where
;; bloo = blu
((or "{" "where" "let" "do" "case" "$" "->")
+ ;; TODO { here should only be for WLDOs
(smie-rule-parent))
("\\case" ;; LambdaCase
(smie-rule-parent))
+ ("|"
+ (if (smie-rule-parent-p "=")
+ (smie-rule-parent-column)
+ (smie-rule-separator method)))
))
))
@@ -315,5 +359,43 @@ 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--previous-line-start ()
+ "Like `smie-indent--parent' but for the previous line's first
+ token."
+ (save-excursion
+ (forward-line -1)
+ (let ((pos (point))
+ (tok (funcall smie-forward-token-function)))
+ (list nil pos tok))))
+
+(defun smie-rule-previous-line-start-p (&rest tokens)
+ "Like `smie-rule-parent-p' but for the parent's parent."
+ (member (nth 2 (smie-indent--previous-line-start)) tokens))
+
(provide 'haskell-tng-smie)
;;; haskell-tng-smie.el ends here
diff --git a/test/haskell-tng-indent-test.el b/test/haskell-tng-indent-test.el
index 977bc6e..8b10fca 100644
--- a/test/haskell-tng-indent-test.el
+++ b/test/haskell-tng-indent-test.el
@@ -12,7 +12,8 @@
(require 'haskell-tng-testutils
"test/haskell-tng-testutils.el")
-;; TODO coproduct definitions, the | should align with =
+;; FIXME implement more indentation rules
+;;
;; TODO lists, records, tuples
;; TODO long type signatures vs definitions
;; TODO if/then/else
@@ -70,8 +71,12 @@
(setq lines (split-string (buffer-string) (rx ?\n)))
(delete-region (point-min) (point-max))
- ;; TODO SMIE doesn't request forward tokens from the lexer when the
point
- ;; is at point-max, so add some whitespace at the end.
+ ;; WORKAROUND https://debbugs.gnu.org/cgi/bugreport.cgi?bug=36432
+ ;;
+ ;; SMIE doesn't request forward tokens from the lexer when the point is
+ ;; at point-max, so add some whitespace at the end.
+ ;;
+ ;; TODO fix the bug properly, in SMIE
(save-excursion
(insert "\n\n"))))
(while (pcase mode
diff --git a/test/src/indentation.hs b/test/src/indentation.hs
index 42cb7b4..b981d2f 100644
--- a/test/src/indentation.hs
+++ b/test/src/indentation.hs
@@ -65,3 +65,7 @@ dollars f Nothing = f $
""
dollars f (Just a) = f $ \s ->
a
+
+data Wibble = Wibble Int
+ | Wobble Int
+ | Vibble Int
diff --git a/test/src/indentation.hs.append.indent
b/test/src/indentation.hs.append.indent
index 3d8ddab..3c3e1db 100644
--- a/test/src/indentation.hs.append.indent
+++ b/test/src/indentation.hs.append.indent
@@ -133,4 +133,12 @@ dollars f (Just a) = f $ \s ->
a
2 1 v
-1 2 v
\ No newline at end of file
+1 2 v
+data Wibble = Wibble Int
+v
+ | Wobble Int
+1 v
+ | Vibble Int
+1 v
+
+v 1
\ No newline at end of file
diff --git a/test/src/indentation.hs.insert.indent
b/test/src/indentation.hs.insert.indent
index a82b222..ea7776d 100644
--- a/test/src/indentation.hs.insert.indent
+++ b/test/src/indentation.hs.insert.indent
@@ -131,4 +131,12 @@ dollars f Nothing = f $
dollars f (Just a) = f $ \s ->
1 v
a
-v 1
\ No newline at end of file
+2 1 v
+
+1 2 v
+data Wibble = Wibble Int
+1 v
+ | Wobble Int
+1 v
+ | Vibble Int
+v 1
\ No newline at end of file
diff --git a/test/src/indentation.hs.layout b/test/src/indentation.hs.layout
index a23d743..7014959 100644
--- a/test/src/indentation.hs.layout
+++ b/test/src/indentation.hs.layout
@@ -65,4 +65,8 @@ module Indentation where
""
;dollars f (Just a) = f $ \s ->
a
+
+;data Wibble = Wibble Int
+ | Wobble Int
+ | Vibble Int
}
\ No newline at end of file
diff --git a/test/src/indentation.hs.lexer b/test/src/indentation.hs.lexer
index 81e8b7b..8e81755 100644
--- a/test/src/indentation.hs.lexer
+++ b/test/src/indentation.hs.lexer
@@ -65,4 +65,8 @@ let { VARID = VARID
§
; VARID VARID « CONID VARID » = VARID $ \ VARID ->
VARID
+
+; data CONID = CONID CONID
+| CONID CONID
+| CONID CONID
}
diff --git a/test/src/indentation.hs.reindent b/test/src/indentation.hs.reindent
index a8f3fce..2a22693 100644
--- a/test/src/indentation.hs.reindent
+++ b/test/src/indentation.hs.reindent
@@ -131,4 +131,12 @@ dollars f Nothing = f $
v 1
dollars f (Just a) = f $ \s ->
1 v
- a
\ No newline at end of file
+ a
+2 1 v
+
+v 2 1
+data Wibble = Wibble Int
+1 v
+ | Wobble Int
+1 v
+ | Vibble Int
\ No newline at end of file
diff --git a/test/src/indentation.hs.sexps b/test/src/indentation.hs.sexps
index eea2d64..73ea076 100644
--- a/test/src/indentation.hs.sexps
+++ b/test/src/indentation.hs.sexps
@@ -64,5 +64,9 @@
("") ("")
("")
((dollars) (f) ((Just) (a)) = (f) $ (\)(s) ->
- (a)))))))))))
+ (a)
+
+(data (Wibble) = (Wibble) (Int)
+ | (Wobble) (Int)
+ | (Vibble) (Int))))))))))))
)))
\ No newline at end of file
diff --git a/test/src/indentation.hs.syntax b/test/src/indentation.hs.syntax
index 17e596e..ede9586 100644
--- a/test/src/indentation.hs.syntax
+++ b/test/src/indentation.hs.syntax
@@ -65,3 +65,7 @@ wwwwwww w wwwwwww _ w _>
"">
wwwwwww w (wwww w) _ w _ _w __>
w>
+>
+wwww wwwwww _ wwwwww www>
+ _ wwwwww www>
+ _ wwwwww www>
diff --git a/test/src/layout.hs.sexps b/test/src/layout.hs.sexps
index de8f0a1..44af28c 100644
--- a/test/src/layout.hs.sexps
+++ b/test/src/layout.hs.sexps
@@ -1,7 +1,7 @@
-- Figure 2.1 from the Haskell2010 report
((module (AStack)( (Stack), (push), (pop), (top), (size) ) (where)
-(((data) (Stack) (a) = (Empty)
- (|) (MkStack) (a) ((Stack) (a))
+((data (Stack) (a) = (Empty)
+ | (MkStack) (a) ((Stack) (a))
((push) (::) (a) -> (Stack) (a) -> (Stack) (a))
((push) (x) (s) = (MkStack) (x) (s))
