[nongnu] elpa/haskell-tng-mode 85f20b1 154/385: indent coproducts

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 85f20b1d0b05edfa2d6c31fd5522dd16151ea990
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@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))