[nongnu] elpa/haskell-tng-mode 2320b89 167/385: alternative to smie-rules-* in :elem and :list-intro

[ELPA Syncer]

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