Merge pull request #1019 from gracjan/pr-shallow-indentation

Support shallow indentation

Author: gracjan

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.

tests/haskell-indentation-tests.el

@@ -149,39 +149,39 @@ 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
   (_x) <- return ()
  z"
               (1 0)
               (2 2)
-              (3 0 2 10))
+              (3 0 2 4))
 
 (hindent-test "2u Handle underscore in identifiers""
 function = do
   (_x) ← return ()
  z"
               (1 0)
               (2 2)
-              (3 0 2 9))
+              (3 0 2 4))
 
 (hindent-test "2a Handle apostrophe in identifiers""
 function = do
   (_'x') <- return ()
  z"
               (1 0)
               (2 2)
-              (3 0 2 12))
+              (3 0 2 4))
 
 (hindent-test "2au Handle apostrophe in identifiers""
 function = do
   (_'x') ← return ()
  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,28 +638,32 @@ 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
           a quasiquote
           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"))