diff --git a/haskell-indentation.el b/haskell-indentation.el index 7d24cc099..80e566c4d 100644 --- a/haskell-indentation.el +++ b/haskell-indentation.el @@ -794,11 +794,10 @@ parser. If parsing ends here, set indentation to left-indent." (haskell-indentation-add-left-indent) (haskell-indentation-add-indentation current-indent) (throw 'parse-end nil)) - (let ((current-indent (current-column))) - (funcall parser) - (when (equal current-token "where") - (haskell-indentation-with-starter - #'haskell-indentation-expression-layout nil)))) + (funcall parser) + (when (equal current-token "where") + (haskell-indentation-with-starter + #'haskell-indentation-expression-layout nil))) (defun haskell-indentation-guard () "Parse \"guard\" statement." @@ -833,35 +832,34 @@ parser. If parsing ends here, set indentation to left-indent." (defun haskell-indentation-expression () "Parse an expression until an unknown token is encountered." - (let ((current-indent (current-column))) - (catch 'return - (while t - (cond - ((memq current-token '(value operator)) - (haskell-indentation-read-next-token)) - ((eq current-token 'end-tokens) - (cond ((string= following-token "where") - (haskell-indentation-add-where-pre-indent)) ; before a where - ((haskell-indentation-expression-token-p following-token) - (haskell-indentation-add-indentation - current-indent))) ; a normal expression - (throw 'return nil)) - (t (let ((parser (assoc current-token - haskell-indentation-expression-list))) - (when (null parser) - (throw 'return nil)) ; not expression token, so exit - (funcall (cdr parser)) ; run parser - (when (and (eq current-token 'end-tokens) - (string= (car parser) "let") - (= haskell-indentation-layout-offset current-indent) - (haskell-indentation-expression-token-p following-token)) - ;; inside a layout, after a let construct - ;; for example: "do let a = 20" - (haskell-indentation-add-layout-indent) - (throw 'parse-end nil)) - ;; after an 'open' expression such as 'if', exit - (unless (member (car parser) '("(" "[" "{" "case")) - (throw 'return nil))))))))) + (catch 'return + (while t + (cond + ((memq current-token '(value operator)) + (haskell-indentation-read-next-token)) + ((eq current-token 'end-tokens) + (cond ((string= following-token "where") + (haskell-indentation-add-where-pre-indent)) ; before a where + ((haskell-indentation-expression-token-p following-token) + (haskell-indentation-add-indentation + current-indent))) ; a normal expression + (throw 'return nil)) + (t (let ((parser (assoc current-token + haskell-indentation-expression-list))) + (when (null parser) + (throw 'return nil)) ; not expression token, so exit + (funcall (cdr parser)) ; run parser + (when (and (eq current-token 'end-tokens) + (string= (car parser) "let") + (= haskell-indentation-layout-offset current-indent) + (haskell-indentation-expression-token-p following-token)) + ;; inside a layout, after a let construct + ;; for example: "do let a = 20" + (haskell-indentation-add-layout-indent) + (throw 'parse-end nil)) + ;; after an 'open' expression such as 'if', exit + (unless (member (car parser) '("(" "[" "{" "case")) + (throw 'return nil)))))))) (defun haskell-indentation-separated (parser separator &optional stmt-separator) "Evaluate PARSER separated by SEPARATOR and STMT-SEPARATOR. diff --git a/tests/haskell-indentation-tests.el b/tests/haskell-indentation-tests.el index 8c7dc2043..c0e3a78f1 100644 --- a/tests/haskell-indentation-tests.el +++ b/tests/haskell-indentation-tests.el @@ -149,7 +149,7 @@ macro quotes them for you." function = Record { field = 123 }" (1 0) - (2 0 11)) + (2 0 2)) (hindent-test "2 Handle underscore in identifiers"" function = do @@ -157,7 +157,7 @@ function = do z" (1 0) (2 2) - (3 0 2 10)) + (3 0 2 4)) (hindent-test "2u Handle underscore in identifiers"" function = do @@ -165,7 +165,7 @@ function = do z" (1 0) (2 2) - (3 0 2 9)) + (3 0 2 4)) (hindent-test "2a Handle apostrophe in identifiers"" function = do @@ -173,7 +173,7 @@ function = do z" (1 0) (2 2) - (3 0 2 12)) + (3 0 2 4)) (hindent-test "2au Handle apostrophe in identifiers"" function = do @@ -181,7 +181,7 @@ function = do z" (1 0) (2 2) - (3 0 2 11)) + (3 0 2 4)) (hindent-test "3 Import statememnt symbol list 1"" import Control.Concurrent @@ -206,7 +206,7 @@ fun = [ x | y , z ]" (1 0) (2 10) - (3 0 6)) + (3 0 2)) (hindent-test "5a* List comprehension"" fun = [ x | y, @@ -274,7 +274,7 @@ fun = x ++" fun = x ++ z" (1 0) - (2 0 6)) + (2 0 2)) (hindent-test "11 Guards with commas"" clunky env var1 var2 @@ -283,7 +283,7 @@ clunky env var1 var2 (1 0) (2 2) (3 2) - (4 0 17)) + (4 0 4)) (hindent-test "11u Guards with commas"" clunky env var1 var2 @@ -292,7 +292,7 @@ clunky env var1 var2 (1 0) (2 2) (3 2) - (4 0 16)) + (4 0 4)) (hindent-test "12 \"do\" as expression"" fun = do { putStrLn \"X\"; @@ -576,8 +576,8 @@ foo = do return ()" (1 0) (2 2) - (3 0 2 17) - (4 0 2 17)) + (3 0 2 4) + (4 0 2 4)) (hindent-test "25a* support scoped type declarations" " foo = do @@ -619,13 +619,13 @@ foo = do f = a (a 'A) (a 'A) " - (2 0 4)) + (2 0 2)) (hindent-test "28b character literal (escape sequence)" " f = '\\\\' " - (2 0 4)) + (2 0 2)) (hindent-test "28c name starting with a quote" " @@ -638,7 +638,7 @@ function (Operation 'Init) = do test = [randomQQ| This is a quasiquote with the word in |] " - (2 0 7)) + (2 0 2)) (hindent-test "29b quasiquote multiple lines" " test = [randomQQ| This is @@ -646,20 +646,24 @@ test = [randomQQ| This is with the word in |] " - (4 0 7)) + (4 0 2)) + (hindent-test "30* parse '[] identifier correctly" " instance Callable '[] " (1 2)) + (hindent-test "31* allow type class declaration without methods" " class Foo a where instance Bar Int " (2 0)) + (hindent-test "32 allow type operators" " data (:.) a b = a :. b " (2 0 16)) + (hindent-test "33* parse #else in CPP" " #ifdef FLAG foo = () @@ -716,7 +720,7 @@ s = do a <- \"multiline\\ \\ line 2\" " - (4 0 2 7)) + (4 0 2 4)) (hindent-test "39 do not crash after two multiline literals in do block" " servePost = do @@ -725,13 +729,13 @@ servePost = do b <- queryT \"comma is important: , \\ \\ line 2 \" " - (6 0 2 7)) + (6 0 2 4)) (hindent-test "40 parse error in multiline tuple" " a = ( 1 , " (2 4) - (3 6)) + (3 2)) (hindent-test "41 open do inside a list" " x = asum [ withX $ do @@ -857,8 +861,8 @@ fact n = (1 0) (2 2) (3 4) - (4 4) - (5 0 2 4 18)) + (4 0 2 4 9) + (5 0 2 4 9)) (ert-deftest haskell-indentation-ret-indents () (switch-to-buffer (get-buffer-create "source.hs"))