[nongnu] elpa/haskell-tng-mode f67557b 142/385: fix a layout corner case

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit f67557bd6434ee9fe5fa50323efb46c8de67d7b6
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@gmail.com>

    fix a layout corner case
---
 haskell-tng-layout.el                 | 40 +++++++++-----------
 test/haskell-tng-indent-test.el       | 24 +++++++-----
 test/haskell-tng-testutils.el         |  5 ---
 test/src/indentation.hs.append.indent | 70 +++++++++++++++++------------------
 test/src/medley.hs                    |  2 +
 test/src/medley.hs.faceup             |  3 ++
 test/src/medley.hs.layout             |  4 +-
 test/src/medley.hs.lexer              |  4 +-
 test/src/medley.hs.syntax             |  2 +
 9 files changed, 80 insertions(+), 74 deletions(-)

diff --git a/haskell-tng-layout.el b/haskell-tng-layout.el
index f4af977..9d2cd7f 100644
--- a/haskell-tng-layout.el
+++ b/haskell-tng-layout.el
@@ -36,11 +36,9 @@
 
 (require 'haskell-tng-util)
 
-;; FIXME only search up to one line for the WLDO opener, otherwise close it out
-;; with {} This is not valid compiling Haskell code, but it allows SMIE to 
close
-;; off the s-expression.
-
 ;; Easiest cache... full buffer parse with full invalidation on any insertion.
+;;
+;; A list of (OPEN . (CLOSE . SEPS)) positions, one per inferred block.
 (defvar-local haskell-tng-layout:cache nil)
 
 (defun haskell-tng-layout:cache-invalidation (_beg _end _pre-length)
@@ -52,6 +50,7 @@ the layout engine."
 ;; TODO a visual debugging option would be great, showing virtuals as overlays
 
 ;; EXT:NonDecreasingIndentation
+;; EXT:LambdaCase
 
 (defun haskell-tng-layout:virtuals-at-point ()
   "List of virtual `{' `}' and `;' at point, according to the
@@ -61,24 +60,21 @@ Designed to be called repeatedly, managing its own caching."
   (unless haskell-tng-layout:cache
     (haskell-tng-layout:rebuild-cache-full))
 
-  (let ((pos (point)))
-    (catch 'done
-      (let (breaks
-            closes)
-        (dolist (block haskell-tng-layout:cache)
-          (let ((open (car block))
-                (close (cadr block))
-                (lines (cddr block)))
-            ;;(message "BLOCK = %S (%s, %s, %s)" block open close lines)
-            (when (and (<= open pos) (<= pos close))
-              (when (= open pos)
-                (throw 'done '("{")))
-              (when (= close pos)
-                (push "}" closes))
-              (dolist (line lines)
-                (when (= line pos)
-                  (push ";" breaks))))))
-        (append (reverse closes) (reverse breaks))))))
+  (let ((pos (point))
+        opens breaks closes)
+    (dolist (block haskell-tng-layout:cache)
+      (let ((open (car block))
+            (close (cadr block))
+            (lines (cddr block)))
+        (when (and (<= open pos) (<= pos close))
+          (when (= open pos)
+            (push "{" opens))
+          (when (= close pos)
+            (push "}" closes))
+          (dolist (line lines)
+            (when (= line pos)
+              (push ";" breaks))))))
+    (append opens closes breaks)))
 
 (defun haskell-tng-layout:has-virtual-at-point ()
   "t if there is a virtual at POINT"
diff --git a/test/haskell-tng-indent-test.el b/test/haskell-tng-indent-test.el
index a926155..6205932 100644
--- a/test/haskell-tng-indent-test.el
+++ b/test/haskell-tng-indent-test.el
@@ -26,20 +26,17 @@
 ;; Test 1 involves a lot of buffer refreshing and will be very slow.
 
 (ert-deftest haskell-tng-append-indent-file-tests ()
-  ;; (require 'profiler)
-  ;; (profiler-start 'cpu)
-
   (should (have-expected-append-indent (testdata "src/indentation.hs")))
 
   ;;(should (have-expected-append-indent (testdata "src/layout.hs")))
-  ;; this test is slow
-  ;;(should (have-expected-append-indent (testdata "src/medley.hs")))
 
+  ;; this test is slow
+  ;; (require 'profiler)
+  ;; (profiler-start 'cpu)
+  ;; (should (have-expected-append-indent (testdata "src/medley.hs")))
   ;; (profiler-report)
   ;; (profiler-report-write-profile "indentation.profile")
   ;; (profiler-stop)
-
-  ;; To interactively inspect
   ;; (profiler-find-profile "../indentation.profile")
   )
 
@@ -65,7 +62,12 @@
     (pcase mode
       ('append
        (setq lines (split-string (buffer-string) (rx ?\n)))
-       (delete-region (point-min) (point-max))))
+       (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.
+       (save-excursion
+         (insert "\n\n"))))
     (while (pcase mode
              ('append lines)
              (_ (not (eobp))))
@@ -81,7 +83,9 @@
                      (current-column)))
 
         (let ((orig (current-indentation))
-              (line (haskell-tng-testutils:current-line-string))
+              (line (buffer-substring-no-properties
+                     (line-beginning-position)
+                     (line-end-position)))
               (prime (pcase mode
                        ((or 'insert 'append) (RET))
                        ('reindent (TAB))))
@@ -103,7 +107,7 @@
             ('append
              (beginning-of-line)
              (when (not (eobp))
-               (delete-region (point) (point-max))))
+               (delete-region (point) (line-end-position))))
             ('reindent
              (indent-line-to orig)
              (ert-simulate-command '(forward-line)))))))
diff --git a/test/haskell-tng-testutils.el b/test/haskell-tng-testutils.el
index 330e61e..078f642 100644
--- a/test/haskell-tng-testutils.el
+++ b/test/haskell-tng-testutils.el
@@ -44,11 +44,6 @@ Alternatively, if MODE is a buffer object, run TO-STRING 
there instead."
           (write-region got nil golden)
           nil))))
 
-(defun haskell-tng-testutils:current-line-string ()
-  (buffer-substring-no-properties
-   (line-beginning-position)
-   (line-end-position)))
-
 (defun testdata (file)
   (expand-file-name
    file
diff --git a/test/src/indentation.hs.append.indent 
b/test/src/indentation.hs.append.indent
index 690d20d..bd9418a 100644
--- a/test/src/indentation.hs.append.indent
+++ b/test/src/indentation.hs.append.indent
@@ -31,74 +31,74 @@ v                     1 2
 
 v                     1 2
 basic_do = do
-v
+1 v
   foo <- blah blah blah
-v 1
+1 v
   bar <- blah blah
-v 1
+1 v
          blah -- manual correction
-v 2      1
+2 v      1
          blah -- manual correction
-v 2      1
+2 v      1
   sideeffect
-v 1      2
+1 v      2
   sideeffect' blah
-v 1      2
+1 v      2
   let baz = blah blah
-v 2   1  3
+2 1   v  3
             blah -- manual correction
-v 2   3  4  1
+2 3   v  4  1
       gaz = blah
-v 2   1  3  4
+1 2   v  3  4
       haz =
-v 2   1  3  4
+2 3   1 v4  5
         blah
-v 2   3 14  5
+2 3   v 14  5
   pure faz -- manual correction
-v 1   2 34  5
+1 v   2 34  5
 
-v 1   2 34  5
+1 v   2 34  5
 nested_do = -- manual correction
-v
+1 v
   do foo <- blah
-v    1
+1    v
      do bar <- blah -- same level as foo
-v    2  1
+2    1  v
         baz -- same level as bar
-v    2  1
+1    2  v
 
-v    1  2
+1    2  v
 nested_where a b = foo a b
 v
   where -- TODO 2
-v
+1   v
     foo = bar baz -- indented
-v   1
+1   v
     baz = blah blah -- same level as foo
-v   1
+1   v
       where -- manual correction
-v   1
+1   2   v
         gaz a = blah -- indented
-v   2   1
+1   2   v
         faz = blah -- same level as gaz
-v   2   1
+1   2   v
 
-v   1   2
+1   2   v
 -- TODO case statements
-v   1   2
+1   2   v
 -- TODO let / in
-v   1   2
+1   2   v
 
-v   1   2
+1   2   v
 -- TODO coproduct definitions, the | should align with =
-v   1   2
+1   2   v
 
-v   1   2
+1   2   v
 -- TODO lists, records, tuples
-v   1   2
+1   2   v
 
-v   1   2
+1   2   v
 -- TODO long type signatures vs definitions
-v   1   2
+1   2   v
 
-v   1   2
\ No newline at end of file
+1   2   v
\ No newline at end of file
diff --git a/test/src/medley.hs b/test/src/medley.hs
index e0f3b50..7e91619 100644
--- a/test/src/medley.hs
+++ b/test/src/medley.hs
@@ -144,3 +144,5 @@ foo = do
         (+) = _
 
 test = 1 `shouldBe` 1
+
+bar = do -- an incomplete do block
diff --git a/test/src/medley.hs.faceup b/test/src/medley.hs.faceup
index 2dc53af..31e7b83 100644
--- a/test/src/medley.hs.faceup
+++ b/test/src/medley.hs.faceup
@@ -144,3 +144,6 @@
 »        «:haskell-tng:keyword:(»+«:haskell-tng:keyword:)» 
«:haskell-tng:keyword:=» «:haskell-tng:keyword:_»
 
 «:haskell-tng:toplevel:test» «:haskell-tng:keyword:=» 1 `shouldBe` 1
+
+«:haskell-tng:toplevel:bar» «:haskell-tng:keyword:=» «:haskell-tng:keyword:do» 
«m:-- »«x:an incomplete do block
+»
\ No newline at end of file
diff --git a/test/src/medley.hs.layout b/test/src/medley.hs.layout
index 3cfca1a..e87c3c5 100644
--- a/test/src/medley.hs.layout
+++ b/test/src/medley.hs.layout
@@ -144,4 +144,6 @@ module Foo.Bar.Main
         ;(+) = _
 
 }};test = 1 `shouldBe` 1
-}
\ No newline at end of file
+
+;bar = do -- an incomplete do block
+{}}
\ No newline at end of file
diff --git a/test/src/medley.hs.lexer b/test/src/medley.hs.lexer
index e7e7c4d..dfbc55a 100644
--- a/test/src/medley.hs.lexer
+++ b/test/src/medley.hs.lexer
@@ -144,4 +144,6 @@ CONSYM CONID « CONID » « CONID CONID »
 ; « SYMID » = _
 
 } } ; VARID = 1 SYMID 1
-}
+
+; VARID = do
+{ } }
diff --git a/test/src/medley.hs.syntax b/test/src/medley.hs.syntax
index faea55c..614e97c 100644
--- a/test/src/medley.hs.syntax
+++ b/test/src/medley.hs.syntax
@@ -144,3 +144,5 @@ www _ ww>
         (_) _ w>
 >
 wwww _ w $wwwwwwww$ w>
+>
+www _ ww __ ww wwwwwwwwww ww wwwww>