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