emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/haskell-tng-mode 88b17d4 137/385: started indentation rule


From: ELPA Syncer
Subject: [nongnu] elpa/haskell-tng-mode 88b17d4 137/385: started indentation rules
Date: Tue, 5 Oct 2021 23:59:17 -0400 (EDT)

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

    started indentation rules
---
 haskell-tng-layout.el                 |   2 +
 haskell-tng-smie.el                   | 117 ++++++++-------
 test/haskell-tng-indent-test.el       |   2 -
 test/haskell-tng-layout-test.el       |   2 +
 test/haskell-tng-sexp-test.el         |   4 +-
 test/src/indentation.hs               |  47 ++++--
 test/src/indentation.hs.insert.indent | 122 ++++++++++-----
 test/src/indentation.hs.layout        |  49 ++++++
 test/src/indentation.hs.reindent      | 120 +++++++++++----
 test/src/indentation.hs.sexps         |  49 ++++++
 test/src/layout.hs.insert.indent      |  38 ++---
 test/src/layout.hs.reindent           |  36 ++---
 test/src/medley.hs.insert.indent      | 274 +++++++++++++++++-----------------
 test/src/medley.hs.reindent           | 256 +++++++++++++++----------------
 14 files changed, 684 insertions(+), 434 deletions(-)

diff --git a/haskell-tng-layout.el b/haskell-tng-layout.el
index 9e31ac4..0a4f311 100644
--- a/haskell-tng-layout.el
+++ b/haskell-tng-layout.el
@@ -45,6 +45,8 @@ the layout engine."
 
 ;; TODO a visual debugging option would be great, showing virtuals as overlays
 
+;; EXT:NonDecreasingIndentation
+
 (defun haskell-tng-layout:virtuals-at-point ()
   "List of virtual `{' `}' and `;' at point, according to the
 Haskell2010 Layout rules.
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 9c8baa6..95d965d 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -123,25 +123,36 @@ information, to aid in the creation of new rules."
   ;; see docs for `smie-rules-function'
   (when haskell-tng-smie:debug
     (with-current-buffer haskell-tng-smie:debug
-      (insert (format "INDENT %S %S\n" method arg))))
+      (insert (format "RULES: %S %S\n" method arg))))
+
+  ;; FIXME core indentation rules
   (pcase method
+
     (:elem
      (pcase arg
-       ('basic smie-indent-basic)
+       ((or 'empty-line-token 'args) 0)
+       ))
+
+    (:list-intro
+     ;; TODO could consult a local table that is populated by an external tool
+     ;; containing the parameter requirements for function calls to let us know
+     ;; if it's a single statement or many.
+     (pcase arg
+       ;; FIXME this should return bool
+       ((or "CONID" "VARID" "}" "<-" "=") 0)
        ))
 
-    ;; FIXME implement the core indentation rules
     (:after
      (pcase arg
-       ("where"
-        ;; TODO `module' doesn't trigger when writing a fresh file, it's coming
-        ;; up as before/after `{'.
-        (if (smie-rule-parent-p "module")
-            '(column . 0)
-          smie-indent-basic))
-       ((or "::" "=" "let" "do" "of" "{")
-        smie-indent-basic)
+       ((or "let" "do" "=") 2)
+       ("where" (if (smie-rule-parent-p "module") 0 2))
        ))
+
+    (:before
+     (pcase arg
+       ((or "{" "where" "do") (smie-rule-parent))
+       ))
+
     ))
 
 (defconst haskell-tng-smie:return
@@ -155,65 +166,65 @@ information, to aid in the creation of new rules."
   ;; (including a recursive call to `smie-indent-calculate') and put them into 
a
   ;; ring that we cycle, or we push/pop with recalculation. We choose the
   ;; latter, because cache invalidation is easier.
-  (if (member this-command haskell-tng-smie:return)
+  (if (or (member this-command haskell-tng-smie:return)
+          (not
+           (or (eq this-command last-command)
+               (member last-command haskell-tng-smie:return))))
       (setq haskell-tng-smie:indentations nil)
-    (when (and
-           (null haskell-tng-smie:indentations)
-           (or
-            ;; TAB+TAB and RETURN+TAB
-            (eq this-command last-command)
-            (member last-command haskell-tng-smie:return)))
-      ;; avoid recalculating the prime indentation level (application of smie 
rules)
+    ;; TAB+TAB or RETURN+TAB
+    (when (null haskell-tng-smie:indentations)
       (let ((prime (current-column)))
-        ;; Note that reindenting loses the original indentation level. This is
-        ;; by design: users can always undo / revert.
         (setq haskell-tng-smie:indentations
               (append
-               ;; TODO backtab, does the cycle in reverse (use a local flag)
+               ;; TODO backtab cycle in reverse
                (-remove-item prime (haskell-tng-smie:indent-alts))
                (list prime))))))
+  (when haskell-tng-smie:debug
+    (when-let (alts haskell-tng-smie:indentations)
+      (with-current-buffer haskell-tng-smie:debug
+        (insert (format "ALTS: %S\n" alts)))))
   (pop haskell-tng-smie:indentations))
 
 (defun haskell-tng-smie:indent-alts ()
   "Returns a list of alternative indentation levels for the
 current line."
-  (let ((the-line (line-number-at-pos))
+  (let ((pos (point))
         indents)
     (save-excursion
-      (when (re-search-backward
-             (rx-to-string `(| ,haskell-tng:rx:toplevel (= 2 ?\n)))
-             nil t)
-        (let ((start (point)))
-          (while (< (line-number-at-pos) the-line)
-            (push (current-indentation) indents) ;; this line's indentation
-            (forward-line))
-          (when (re-search-backward
-                 (rx word-start (| "where" "let" "do" "case") word-end)
-                 start t)
-            ;; TODO the next whitespace level after a WLDO (not a WLDC), not +2
-            (push (+ 2 (current-column)) indents)))))
-
-    (save-excursion
-      (forward-line -1)
-      (when (/= the-line (line-number-at-pos))
-        (push (+ 2 (current-indentation)) indents)))
+      (end-of-line 0)
+      (re-search-backward haskell-tng:regexp:toplevel nil t)
+      (when-let (new (haskell-tng-smie:relevant-alts pos))
+        (setq indents (append new indents))))
 
     ;; alts are easier to use when ordered
     (setq indents (sort indents '<))
-    ;; TODO consider ordering alts, and cycling the list so the first 
suggestion
-    ;; is the next one higher than the current indentation level.
 
-    ;; TODO indentation to current WLDO alignment should be a top priority
-
-    ;; indentation of the next line is common for insert edits, top priority
-    (save-excursion
-      (forward-line)
-      (forward-comment (point-max))
-      (when (/= the-line (line-number-at-pos))
-        (push (current-indentation) indents)))
+    ;; previous / next line should be top priority alts
+    (--each '(1 -1)
+      (save-excursion
+        (forward-line it)
+        (when-let (new (haskell-tng-smie:relevant-alts (point-at-eol)))
+          (setq indents (append new indents)))))
 
     (-distinct indents)))
 
+(defun haskell-tng-smie:relevant-alts (bound)
+  "A list of indentation levels from point to BOUND."
+  (let ((start (point))
+        relevant)
+    (while (< (point) bound)
+      (when (not
+             (looking-at
+              (rx (* space) (| "where" "let" "do") word-end)))
+        (push (current-indentation) relevant))
+      (forward-line))
+    (goto-char start)
+    (while (< (point) bound)
+      (when (haskell-tng-layout:virtuals-at-point)
+        (push (current-column) relevant))
+      (forward-char))
+    relevant))
+
 (defun haskell-tng-smie:setup ()
   (setq-local smie-indent-basic 2)
 
@@ -236,7 +247,11 @@ current line."
    haskell-tng-smie:grammar
    #'haskell-tng-smie:rules
    :forward-token #'haskell-tng-lexer:forward-token
-   :backward-token #'haskell-tng-lexer:backward-token))
+   :backward-token #'haskell-tng-lexer:backward-token)
+
+  ;; disables blinking paren matching based on grammar
+  (setq smie-closer-alist nil)
+  )
 
 ;; SMIE wishlist, in order of desirability:
 ;;
diff --git a/test/haskell-tng-indent-test.el b/test/haskell-tng-indent-test.el
index 2734c83..a66fda2 100644
--- a/test/haskell-tng-indent-test.el
+++ b/test/haskell-tng-indent-test.el
@@ -30,8 +30,6 @@
 
   (should (have-expected-newline-indent-insert (testdata "src/layout.hs")))
   (should (have-expected-newline-indent-insert (testdata "src/medley.hs")))
-  ;; TODO more tests
-  ;; 
https://raw.githubusercontent.com/kadena-io/chainweb-node/master/test/Chainweb/Test/TreeDB.hs
   )
 
 (ert-deftest haskell-tng-reindent-file-tests ()
diff --git a/test/haskell-tng-layout-test.el b/test/haskell-tng-layout-test.el
index 16f0588..a69c46a 100644
--- a/test/haskell-tng-layout-test.el
+++ b/test/haskell-tng-layout-test.el
@@ -15,6 +15,8 @@
   ;; the Haskell2010 test case
   (should (have-expected-layout (testdata "src/layout.hs")))
 
+  (should (have-expected-layout (testdata "src/indentation.hs")))
+
   (should (have-expected-layout (testdata "src/medley.hs")))
   )
 
diff --git a/test/haskell-tng-sexp-test.el b/test/haskell-tng-sexp-test.el
index e263d77..4785227 100644
--- a/test/haskell-tng-sexp-test.el
+++ b/test/haskell-tng-sexp-test.el
@@ -21,10 +21,10 @@
 ;; tokens.
 
 (ert-deftest haskell-tng-sexp-file-tests ()
-  ;; some bizarre output here:
-  ;; 1. `size' definition has an s-exp that extends to the end of `top'
   (should (have-expected-sexps (testdata "src/layout.hs")))
 
+  (should (have-expected-sexps (testdata "src/indentation.hs")))
+
   (should (have-expected-sexps (testdata "src/grammar.hs")))
 
   ;; to the extent that they aren't even useful
diff --git a/test/src/indentation.hs b/test/src/indentation.hs
index e66d171..94a8cd2 100644
--- a/test/src/indentation.hs
+++ b/test/src/indentation.hs
@@ -3,19 +3,46 @@
 --   Bugs and unexpected behaviour in (re-)indentation may be documented here.
 module Indentation where
 
--- A basic `do` block using virtual indentation to suggest the whitespace
+import Foo.Bar
+import Foo.Baz hiding ( gaz,
+                        baz
+                      )
+
 basic_do = do
-  -- TODO do should have virtual indentation of 0, so this is at 2
-  foo = blah blah blah
-  -- TODO should suggest that bar is a binding
-  bar = blah blah
-        blah -- manual continuation, should be 1st alt TODO
-        blah -- continue what we were doing, should be the SMIE rule
+  foo <- blah blah blah
+  bar <- blah blah -- TODO same level as foo
+         blah -- TODO manual correction
+         blah -- continue the blah
+  sideeffect -- manual correction
+  sideeffect' blah
+  let baz = blah blah
+            blah -- TODO manual correction
+      gaz = blah -- TODO same level as baz
+      haz =      -- TODO same level as gaz
+        blah
+  let -- manual correction
+    waz =
+      blah blah
+  pure faz -- manual correction
+
+nested_do =
+  do foo <- blah
+     do bar <- blah -- TODO same level as foo
+        baz -- TODO same level as bar
 
--- TODO `do` with manual layout
--- TODO nested `do`
+nested_where a b = foo a b
+  where -- TODO 2
+    foo = bar baz -- TODO indented
+    baz = blah blah -- TODO same level as foo
+      where -- manual correction
+        gaz a = blah -- TODO indented
+        faz = blah -- TODO same level as gaz
 
+-- TODO case statements
+-- TODO let / in
 
 -- TODO coproduct definitions, the | should align with =
 
--- TODO lists
+-- TODO lists, records, tuples
+
+-- TODO long type signatures vs definitions
diff --git a/test/src/indentation.hs.insert.indent 
b/test/src/indentation.hs.insert.indent
index cfb7ced..e9943df 100644
--- a/test/src/indentation.hs.insert.indent
+++ b/test/src/indentation.hs.insert.indent
@@ -1,42 +1,96 @@
 -- | Idealised indentation scenarios.
-v 1
+v
 --
-v 1
+v
 --   Bugs and unexpected behaviour in (re-)indentation may be documented here.
-v 1
+v
 module Indentation where
-v 1                  2
+v
 
-v 1
--- A basic `do` block using virtual indentation to suggest the whitespace
-v 1           2
+v
+import Foo.Bar
+v
+import Foo.Baz hiding ( gaz,
+1                       v
+                        baz
+2                     1 v
+                      )
+v                     1 2
+
+v                     1 2
 basic_do = do
-2 1          v
-  -- TODO do should have virtual indentation of 0, so this is at 2
-2 1 3       4v
-  foo = blah blah blah
-2 1 3       4v
-  -- TODO should suggest that bar is a binding
-2 1 3       4v
-  bar = blah blah
-2 3 4   1   5v
-        blah -- manual continuation, should be 1st alt TODO
-1 2     v 3 4
-        blah -- continue what we were doing, should be the SMIE rule
-1 2     v 3 4
-
-1 2     v
--- TODO `do` with manual layout
-1 2     v  3
--- TODO nested `do`
-1 2     v         3
-
-1 2     v
-
-1 2     v
+1 v
+  foo <- blah blah blah
+2 1      v
+  bar <- blah blah -- TODO same level as foo
+2 1      v
+         blah -- TODO manual correction
+1 2      v
+         blah -- continue the blah
+2 1      v
+  sideeffect -- manual correction
+1 v      2
+  sideeffect' blah
+2 v   1  3
+  let baz = blah blah
+3 2   1  4  v
+            blah -- TODO manual correction
+2 3   1  4  v
+      gaz = blah -- TODO same level as baz
+2 3   1  4  v
+      haz =      -- TODO same level as gaz
+2 3   1 v4  5
+        blah
+2 1   3 v4  5
+  let -- manual correction
+2 1 v 3 45  6
+    waz =
+2 3 1 v 45  6
+      blah blah
+2 1 3 v 45  6
+  pure faz -- manual correction
+1 v 2 3 45  6
+
+1 v 2 3 45  6
+nested_do =
+1 v  2
+  do foo <- blah
+3    1  2   v
+     do bar <- blah -- TODO same level as foo
+3    2  1      v
+        baz -- TODO same level as bar
+1    2  v
+
+1    2  v
+nested_where a b = foo a b
+1                  v
+  where -- TODO 2
+1   v
+    foo = bar baz -- TODO indented
+2   1     v
+    baz = blah blah -- TODO same level as foo
+2   1     v
+      where -- manual correction
+1   2   v
+        gaz a = blah -- TODO indented
+2   3   1       v
+        faz = blah -- TODO same level as gaz
+2   3   1     v
+
+1   2   3     v
+-- TODO case statements
+1   2   3     v
+-- TODO let / in
+1   2   3     v
+
+1   2   3     v
 -- TODO coproduct definitions, the | should align with =
-1 2     v
+1   2   3     v
+
+1   2   3     v
+-- TODO lists, records, tuples
+1   2   3     v
 
-1 2     v
--- TODO lists
-1 2     v
\ No newline at end of file
+1   2   3     v
+-- TODO long type signatures vs definitions
+1   2   3     v
\ No newline at end of file
diff --git a/test/src/indentation.hs.layout b/test/src/indentation.hs.layout
new file mode 100644
index 0000000..7ae9fdc
--- /dev/null
+++ b/test/src/indentation.hs.layout
@@ -0,0 +1,49 @@
+-- | Idealised indentation scenarios.
+--
+--   Bugs and unexpected behaviour in (re-)indentation may be documented here.
+module Indentation where
+
+{import Foo.Bar
+;import Foo.Baz hiding ( gaz,
+                        baz
+                      )
+
+;basic_do = do
+  {foo <- blah blah blah
+  ;bar <- blah blah -- TODO same level as foo
+         blah -- TODO manual correction
+         blah -- continue the blah
+  ;sideeffect -- manual correction
+  ;sideeffect' blah
+  ;let {baz = blah blah
+            blah -- TODO manual correction
+      ;gaz = blah -- TODO same level as baz
+      ;haz =      -- TODO same level as gaz
+        blah
+  };let -- manual correction
+    {waz =
+      blah blah
+  };pure faz -- manual correction
+
+};nested_do =
+  do {foo <- blah
+     ;do {bar <- blah -- TODO same level as foo
+        ;baz -- TODO same level as bar
+
+}};nested_where a b = foo a b
+  where -- TODO 2
+    {foo = bar baz -- TODO indented
+    ;baz = blah blah -- TODO same level as foo
+      where -- manual correction
+        {gaz a = blah -- TODO indented
+        ;faz = blah -- TODO same level as gaz
+
+-- TODO case statements
+-- TODO let / in
+
+-- TODO coproduct definitions, the | should align with =
+
+-- TODO lists, records, tuples
+
+-- TODO long type signatures vs definitions
+}}}
\ No newline at end of file
diff --git a/test/src/indentation.hs.reindent b/test/src/indentation.hs.reindent
index 21edc49..954d243 100644
--- a/test/src/indentation.hs.reindent
+++ b/test/src/indentation.hs.reindent
@@ -1,42 +1,96 @@
 v
 -- | Idealised indentation scenarios.
-v 1
+v
 --
-v 1
+v
 --   Bugs and unexpected behaviour in (re-)indentation may be documented here.
-v 1
+v
 module Indentation where
-v 1                  2
+v
 
-1 v
--- A basic `do` block using virtual indentation to suggest the whitespace
-1 v           2
+v
+import Foo.Bar
+v                       1
+import Foo.Baz hiding ( gaz,
+1                     2 v
+                        baz
+2                     v 1
+                      )
+v                     1 2
+
+v 1                   2 3
 basic_do = do
-2 1 v        3
-  -- TODO do should have virtual indentation of 0, so this is at 2
-2 1 v       3
-  foo = blah blah blah
-1 v 2       3
-  -- TODO should suggest that bar is a binding
-v 2 3   1   4
-  bar = blah blah
-2 3 4   1   5v
-        blah -- manual continuation, should be 1st alt TODO
-1 2     v 3 4
-        blah -- continue what we were doing, should be the SMIE rule
-1 2     v 3 4
-
-1 2     v
--- TODO `do` with manual layout
-1 2     v  3
--- TODO nested `do`
-1 2     v         3
-
-1 2     v
-
-1 2     v
+1 v
+  foo <- blah blah blah
+v 1      2
+  bar <- blah blah -- TODO same level as foo
+2 1      v
+         blah -- TODO manual correction
+2 1      v
+         blah -- continue the blah
+v 2      1
+  sideeffect -- manual correction
+v 1   2  3
+  sideeffect' blah
+v 1      3  2
+  let baz = blah blah
+3 2   1  4  v
+            blah -- TODO manual correction
+v 3   2  4  1
+      gaz = blah -- TODO same level as baz
+v 3   1 24  5
+      haz =      -- TODO same level as gaz
+3 2   1 v4  5
+        blah
+3 v 2 4 15  6
+  let -- manual correction
+3 1 v 2 45  6
+    waz =
+3 2 1 v 45  6
+      blah blah
+2 v 3 1 45  6
+  pure faz -- manual correction
+1 v 2 3 45  6
+
+v 2 314 56  7
+nested_do =
+v       1
+  do foo <- blah
+v    1  2
+     do bar <- blah -- TODO same level as foo
+v    2  1
+        baz -- TODO same level as bar
+1    2  v
+
+v    1  2
+nested_where a b = foo a b
+1 v 2
+  where -- TODO 2
+1   v
+    foo = bar baz -- TODO indented
+v   1
+    baz = blah blah -- TODO same level as foo
+2   v   1
+      where -- manual correction
+1   2   v
+        gaz a = blah -- TODO indented
+v   2   1
+        faz = blah -- TODO same level as gaz
+2   3   1     v
+
+v   1   2
+-- TODO case statements
+v   1   2
+-- TODO let / in
+1   2   3     v
+
+v   1   2
 -- TODO coproduct definitions, the | should align with =
-1 2     v
+1   2   3     v
+
+v   1   2
+-- TODO lists, records, tuples
+1   2   3     v
 
-1 2     v
--- TODO lists
\ No newline at end of file
+v   1   2
+-- TODO long type signatures vs definitions
\ No newline at end of file
diff --git a/test/src/indentation.hs.sexps b/test/src/indentation.hs.sexps
new file mode 100644
index 0000000..832c262
--- /dev/null
+++ b/test/src/indentation.hs.sexps
@@ -0,0 +1,49 @@
+-- | Idealised indentation scenarios.
+--
+--   Bugs and unexpected behaviour in re-indentation may be documented here.
+((module (Indentation) (where)
+
+(((import) ((Foo).)(Bar))
+(((import) ((Foo).)(Baz)) (hiding) ( (gaz),
+                        (baz)
+                      ))
+
+((basic_do) = (do
+  ((foo) <- (blah) (blah) (blah)
+  ((bar) <- (blah) (blah) -- TODO same level as foo
+         (blah) -- TODO manual correction
+         (blah)) -- continue the blah
+  (sideeffect) -- manual correction
+  ((sideeffect') (blah))
+  (let ((baz) = (blah) (blah)
+            (blah) -- TODO manual correction
+      ((gaz) = (blah)) -- TODO same level as baz
+      ((haz) =      -- TODO same level as gaz
+        (blah))
+  )let -- manual correction
+    ((waz) =
+      (blah) (blah)
+  )(pure) (faz)) -- manual correction
+
+)(nested_do) =
+  (do (((foo) <- (blah)
+     (do ((bar) <- (blah) -- TODO same level as foo
+        (baz) -- TODO same level as bar
+
+)))(nested_where) (a) (b) = (foo) (a) (b)
+  (where) -- TODO 2
+    (((foo) = (bar) (baz) -- TODO indented
+    ((baz) = (blah) (blah)) -- TODO same level as foo
+      (where) -- manual correction
+        ((gaz) (a) = (blah) -- TODO indented
+        ((faz) = (blah)) -- TODO same level as gaz
+
+-- TODO case statements
+-- TODO let / in
+
+-- TODO coproduct definitions, the | should align with =
+
+-- TODO lists, records, tuples
+
+-- TODO long type signatures vs definitions
+))))))))))
\ No newline at end of file
diff --git a/test/src/layout.hs.insert.indent b/test/src/layout.hs.insert.indent
index 9b65f98..b037540 100644
--- a/test/src/layout.hs.insert.indent
+++ b/test/src/layout.hs.insert.indent
@@ -1,38 +1,38 @@
 -- Figure 2.1 from the Haskell2010 report
-v 1
+v
 module AStack( Stack, push, pop, top, size ) where
-v 1                                            2
+v
 data Stack a = Empty
-2 3          1   v
+1            2 v
              | MkStack a (Stack a)
-1            v 2
+1            v
 
-v 1          2
+v            1
 push :: a -> Stack a -> Stack a
-v 1
+v
 push x s = MkStack x s
-1 2                v
+1          v
 
-v 1
+v
 size :: Stack a -> Int
-v 1
+v
 size s = length (stkToLst s)  where
-2 v        1                    3
+1 v        2
            stkToLst  Empty         = []
-2          1 3                  4      v
+3          1                         v          2
            stkToLst (MkStack x s)  = x:xs where xs = stkToLst s
-1          2 3                              4                 v
+3          2                                    1    v
 
-1 2        3                                                  v
+1          2                                    3    v
 pop :: Stack a -> (a, Stack a)
-v 1
+v
 pop (MkStack x s)
-2 1 v
+1 5 v             4              3      2
   = (x, case s of r -> i r where i x = x) -- (pop Empty) is an error
-1 2 3 v                      4
+5 4 v             3              2      1
 
-v 1
+v 1               2              3      4
 top :: Stack a -> a
-v 1
+v
 top (MkStack x s) = x                     -- (top Empty) is an error
-v 1
\ No newline at end of file
+v
\ No newline at end of file
diff --git a/test/src/layout.hs.reindent b/test/src/layout.hs.reindent
index d690dfc..9a6af85 100644
--- a/test/src/layout.hs.reindent
+++ b/test/src/layout.hs.reindent
@@ -1,38 +1,38 @@
 v
 -- Figure 2.1 from the Haskell2010 report
-v 1
+v
 module AStack( Stack, push, pop, top, size ) where
-2 v          1                                 3
+v            1
 data Stack a = Empty
-1 2              v
+1              v
              | MkStack a (Stack a)
-v            1 2
+v            1
 
-v 1          2
+v            1
 push :: a -> Stack a -> Stack a
-v 1
+v
 push x s = MkStack x s
-v 1
+v
 
-v 1
+v
 size :: Stack a -> Int
-v 2        1
+v          1
 size s = length (stkToLst s)  where
-2 3        1 v                  4
+1          v                                    2
            stkToLst  Empty         = []
-v          1 2                  3
+v          1
            stkToLst (MkStack x s)  = x:xs where xs = stkToLst s
-1          2 3                              4                 v
+3          2                                    1    v
 
-v 1        2
+v          1                                    2
 pop :: Stack a -> (a, Stack a)
-v 1
+v 4               3              2      1
 pop (MkStack x s)
-v 1
+v
   = (x, case s of r -> i r where i x = x) -- (pop Empty) is an error
-v 1 2                        3
+v 4               3              2      1
 
-v 1
+v 1               2              3      4
 top :: Stack a -> a
-v 1
+v
 top (MkStack x s) = x                     -- (top Empty) is an error
\ No newline at end of file
diff --git a/test/src/medley.hs.insert.indent b/test/src/medley.hs.insert.indent
index efc98ba..d494c3c 100644
--- a/test/src/medley.hs.insert.indent
+++ b/test/src/medley.hs.insert.indent
@@ -1,292 +1,292 @@
 {-# LANGUAGE OverloadedStrings   #-}
-v 1
+v
 {-# LANGUAGE ScopedTypeVariables #-}
-v 1
+v
 
-v 1
+v
 -- | This file is a medley of various constructs and some corner cases
-v 1
+v
 module Foo.Bar.Main
-2 1              v
+1 2            v
   ( Wibble(..), Wobble(Wobb, (!!!)), Woo
-2 1 3                                  v
+2 1                                  v
   -- * Operations
-2 1 3                                  v
+2 1                                  v
   , getFooByBar, getWibbleByWobble
-2 1 3              v
+2 1              v
   , module Bloo.Foo
-1 2 3             v
+2 1             v
 ) where
-v 1 2
+v 1
 
 v 1
 import           Control.Applicative (many, optional, pure, (<*>), (<|>))
-v 1
+v
 import           Data.Foldable       (traverse_)
-v 1
+v
 import           Data.Functor        ((<$>))
-v 1
+v
 import           Data.List           (intercalate)
-v 1
+v
 import           Data.Monoid         ((<>))
-v 1
+v
 import qualified Options.Monad
-v 1
+v
 import  qualified  Options.Applicative  as  Opts
-v 1
+v
 import qualified Options.Divisible -- wibble (wobble)
-2 31   v
+v  1
    as Div
-v  1 2
+v  1
 import qualified ProfFile.App        hiding (as, hiding, qualified)
-v 1
+v
 import           ProfFile.App        (as, hiding, qualified)
-v 1
+v
 import           ProfFile.App        hiding (as, hiding, qualified)
-v 1
+v
 import qualified ProfFile.App        (as, hiding, qualified)
-v 1
+v
 import           System.Exit         (ExitCode (..), exitFailure, qualified,
-1 2                                   v
+1                                     v
                                       Typey,
-1                                     v 2
+1                                     v
                                       wibble,
-1                                     v 2
+1                                     v
                                       Wibble)
-v                                     1 2
+v                                     1
 import           System.FilePath     (replaceExtension, Foo(Bar, (:<)))
-v 1
+v
 import           System.IO           (IOMode (..), hClose, hGetContents,
-1 2                                   v
+1                                     v
                                       hPutStr, hPutStrLn, openFile, stderr,
-1                                     v 2
+1                                     v
                                       stdout, MoarTypey)
-v                                     1 2
+v                                     1
 import           System.Process      (CreateProcess (..), StdStream (..),
-1 2                                   v
+1                                     v
                                       createProcess, proc, waitForProcess)
-1                       v             2 3
+2                       v             1
 
-1 2                     v             3
+1                       v             2
 -- some chars that should be propertized
-v 1                                   2
+v                                     1
 chars = ['c', '\n', '\'']
-1 2       v
+1       v
 
-v 1
+v
 strings = ["", "\"\"", "\n\\ ", "\\"]
-1 2         v
+1         v
 -- knownWrongEscape = "foo"\\"bar"
-1 2         v
+1         v
 
-v 1
+v
 multiline1 = "\
-v 2     1
+v       1
         \ "
-v       1 2
+v       1
 multiline2 = "\
-v 2      1
+v        1
          \"
-1        2 3   v
+2        1   v
 
-v 1      2
+v        1
 difficult = foo' 'a' 2
-1 2              v
+1           v
 
-v 1
+v
 foo = "wobble (wibble)"
-1 2     v
+1     v
 
-v 1
+v
 class Get a s where
-1 v             2
+1 v
   get :: Set s -> a
-1 2 3           4   v
+2 1               v
 
 1 v
 instance {-# OVERLAPS #-} Get a (a ': s) where
-2 1 v                                      3
+1 v
   get (Ext a _) = a
-1 2 3               v                      4
+2 1               v
 
 1 v
 instance {-# OVERLAPPABLE #-} Get a s => Get a (b ': s) where
-2 1 v                                                     3
+1 v
   get (Ext _ xs) = get xs
-1 2 3                  v                                  4
+2 1                v
 
 1 v
 data Options = Options
-2 1              v
+1 2            v
   { optionsReportType      :: ReportType
-2 1 3                      v
+2 1                        v
   , optionsProfFile        :: Maybe FilePath
-2 1 3                      v
+2 1                        v
   , optionsOutputFile      :: Maybe FilePath
-2 1 3                      v
+2 1                        v
   , optionsFlamegraphFlags :: [String]
-2 1 3                      v
+2 1                        v
   } deriving (Eq, Show)
-1 v 2
+1 v
 
 v 1
 class  (Eq a) => Ord a  where
-2 1 v                     3
+1 v
   (<), (<=), (>=), (>)  :: a -> a -> Bool
-2 1 3                     4            v
+2 1                                  v
   max @Foo, min        :: a -> a -> a
-1 2 3                     4           v
+2 1                                 v
 
 1 v
 instance (Eq a) => Eq (Tree a) where
-2 1 v                            3
+1 v
   Leaf a         == Leaf b          =  a == b
-2 1 3                            4            v
+2 1                                         v
   (Branch l1 r1) == (Branch l2 r2)  =  (l1==l2) && (r1==r2)
-2 1 3                            4                   v
+2 1                                                v
   _              == _               =  False
-1 2 3                            4       v
+2 1                                    v
 
 1 v
 data ReportType = Alloc   -- ^ Report allocations, percent
-2 3             1   v
+1               2 v
                 | Entries -- ^ Report entries, number
-1               v 2
+1               v
                 | Time    -- ^ Report time spent in closure, percent
-1               v 2
+1               v
                 | Ticks   -- ^ Report ticks, number
-1               v 2
+1               v
                 | Bytes   -- ^ Report bytes allocated, number
-1               v 2
+1               v
                 deriving (Eq, Show)
-1               v 2
+1               v
 
-v 1             2
+v               1
 type family G a where
-2 1 v             3
+1 v
   G Int = Bool
-2 1 3       v     4
+2 1       v
   G a   = Char
-1 2 3       v     4
+2 1       v
 
 1 v
 data Flobble = Flobble
-2 1              v
+1 2            v
   deriving (Eq) via (NonNegative (Large Int))
-1 v 2
+1 v
   deriving stock (Floo)
-1 v 2
+1 v
   deriving anyclass (WibblyWoo, OtherlyWoo)
-1 v 2
+1 v
 
 v 1
 newtype Flobby = Flobby
-1 2                v
+1                v
 
-v 1
+v
 foo ::
-213 v
+v1
  Wibble -- wibble
-2v 31
+2v  1
     -> Wobble -- wobble
-23  1 4  v
+23  1  v
     -> Wobble -- wobble
-23  1 4  v
+23  1  v
     -> Wobble -- wobble
-23  1 4  v
+23  1  v
     -> (wob :: Wobble)
-23  1 4  v
+23  1  v
     -> (Wobble -- wobble
-23  1 4   v
+23  1   v
     a b c)
-12  3 4  v
+23  1  v
 
-v 1 2
+v1  2
 (foo :: (Wibble Wobble)) foo
-1 2 3                    v
+12  3                    v
 
-v 1
+v1  2
 newtype TestApp
-2 31    v
+v  1
    (logger :: TestLogger)
-1  v 2
+1  v
    (scribe :: TestScribe)
-1  v 2
+1  v
    config
-1  v 2
+1  v
    a
-1  v 2
+1  v
    = TestApp a
-1  2 3       v
+2  1 v
 
-v 12
+v  1
 optionsParser :: Opts.Parser Options
-v 1
+v
 optionsParser = Options
-2 1               v
+1 2             v
   <$> (Opts.flag' Alloc (Opts.long "alloc" <> Opts.help "wibble")
-2 3 4  1          v
+3 1    2          v
        <|> Opts.flag' Entries (Opts.long "entry" <> Opts.help "wobble")
-2 3    1 4            v
+2 3    1              v
        <|> Opts.flag' Bytes   (Opts.long "bytes" <> Opts.help "i'm a fish"))
-2 1    3v4
+3 2   v1
   <*> optional
-1 2 3  4v
+3 1   v42
         (Opts.strArgument
-2 3    45 1     v
+3 4    51 2   v
           (Opts.metavar "MY-FILE" <>
-2 3    45 617   v
+3 4    56 12    v
            Opts.help "meh"))
-1 2    3v 45 6
+2 3    4v 51
 
-1 2   v    3
+1 2   v34 56
 type PhantomThing
-1 2  v
+1    v
 
-v 1
+v
 type SomeApi =
-2 v    1
+1 v    2
        "thing" :> Capture "bar" Index :> QueryParam "wibble" Text
-2      3 4     v                               1
+2      v                                       1
                                                :> QueryParam "wobble" Natural
-1      2                                       v 3
+1      2                                       v
                                                :> Header TracingHeader 
TracingId
-1      2                                       v 3
+1      2                                       v
                                                :> ThingHeader
-1      2                                       v 3
+1      2                                       v
                                                :> Get '[JSON] (The ReadResult)
-2 1    3                                       v 4
+2 1    3                                       v
   :<|> "thing" :> ReqBody '[JSON] Request
-2 v 3  4              1                        5
+2 v    3              1                        4
                       :> Header TracingHeader TracingId
-1 2    3              v 4                      5
+1 2    3              v                        4
                       :> SpecialHeader
-1 2    3              v 4                      5
+1 2    3              v                        4
                       :> Post '[JSON] (The Response)
-1 2    3              v 4                      5
+1 2    3              v                        4
 
-v 1                   2
+v 1    2              3                        4
 deriving instance FromJSONKey StateName
-v 1
+v
 deriving anyclass instance FromJSON Base
-v 1
+v
 deriving newtype instance FromJSON Treble
-1 2      v
+v
 
-v 1
+v
 foo = do
-2 1     v
+1 v
   bar :: Wibble <- baz
-2 1 3   4            v
+3 1     2          v
   where baz = _
-2 3 4   1       v
+3 2     1     v
   -- checking that comments are ignored in layout
-2 3 4   1       v
+2 1     3     v
   -- and that a starting syntax entry is ok
-2 3 4   1       v
+3 1     2     v
         (+) = _
-1 2 3   4 5     v
+2 3     1     v
 
-1 2     3       v
+1 2     3     v
 test = 1 `shouldBe` 1
-v 1
\ No newline at end of file
+v
\ No newline at end of file
diff --git a/test/src/medley.hs.reindent b/test/src/medley.hs.reindent
index 481b99b..ab74c25 100644
--- a/test/src/medley.hs.reindent
+++ b/test/src/medley.hs.reindent
@@ -1,292 +1,292 @@
 v
 {-# LANGUAGE OverloadedStrings   #-}
-v 1
+v
 {-# LANGUAGE ScopedTypeVariables #-}
-v 1
+v
 
-v 1
+v
 -- | This file is a medley of various constructs and some corner cases
 v 1
 module Foo.Bar.Main
-2 1              v
+1 2            v
   ( Wibble(..), Wobble(Wobb, (!!!)), Woo
 2 1 v
   -- * Operations
 2 1 v
   , getFooByBar, getWibbleByWobble
-1 v 2
+1 v
   , module Bloo.Foo
-1 v 2
+1 v
 ) where
-v 1 2
+v 1
 
-1 v
-import           Control.Applicative (many, optional, pure, (<*>), (<|>))
 v 1
+import           Control.Applicative (many, optional, pure, (<*>), (<|>))
+v
 import           Data.Foldable       (traverse_)
-v 1
+v
 import           Data.Functor        ((<$>))
-v 1
+v
 import           Data.List           (intercalate)
-v 1
+v
 import           Data.Monoid         ((<>))
-v 1
+v
 import qualified Options.Monad
-v 1
+v
 import  qualified  Options.Applicative  as  Opts
-v 21
+v  1
 import qualified Options.Divisible -- wibble (wobble)
-1 2    v
+v
    as Div
-v  1 2
+v  1
 import qualified ProfFile.App        hiding (as, hiding, qualified)
-v 1
+v
 import           ProfFile.App        (as, hiding, qualified)
-v 1
+v
 import           ProfFile.App        hiding (as, hiding, qualified)
-v 1
+v
 import qualified ProfFile.App        (as, hiding, qualified)
-v 2                                   1
+v                                     1
 import           System.Exit         (ExitCode (..), exitFailure, qualified,
-1 2                                   v
+1                                     v
                                       Typey,
-1                                     v 2
+1                                     v
                                       wibble,
-1                                     v 2
+1                                     v
                                       Wibble)
-v                                     1 2
+v                                     1
 import           System.FilePath     (replaceExtension, Foo(Bar, (:<)))
-v 2                                   1
+v                                     1
 import           System.IO           (IOMode (..), hClose, hGetContents,
-1 2                                   v
+1                                     v
                                       hPutStr, hPutStrLn, openFile, stderr,
-1                                     v 2
+1                                     v
                                       stdout, MoarTypey)
-v                                     1 2
+v                                     1
 import           System.Process      (CreateProcess (..), StdStream (..),
-1 2                                   v
+1                                     v
                                       createProcess, proc, waitForProcess)
-1                       v             2 3
+2                       v             1
 
-v 1                                   2
+v                                     1
 -- some chars that should be propertized
-v 1                                   2
+v                                     1
 chars = ['c', '\n', '\'']
-v 1
+v
 
-v 1
+v
 strings = ["", "\"\"", "\n\\ ", "\\"]
-v 1
+v
 -- knownWrongEscape = "foo"\\"bar"
-v 1
+v
 
-v 2     1
+v       1
 multiline1 = "\
-1 2        v       3
+1          v       2
         \ "
-3 v     425        1
+v       12
 multiline2 = "\
-1 2        v        3
+1          v        2
          \"
-2 v      3 4        1
+v        1
 
-v 1      2
+v        1
 difficult = foo' 'a' 2
-v 1
+v
 
-v 1
+v
 foo = "wobble (wibble)"
-v 1
+v
 
 v 1
 class Get a s where
-1 2 v           3
+1 v
   get :: Set s -> a
-1 v 2           3
+1 v
 
 v 1
 instance {-# OVERLAPS #-} Get a (a ': s) where
-1 2 v                                      3
+1 v
   get (Ext a _) = a
-1 v 2                                      3
+1 v
 
 v 1
 instance {-# OVERLAPPABLE #-} Get a s => Get a (b ': s) where
-1 2 v                                                     3
+1 v
   get (Ext _ xs) = get xs
-1 v 2                                                     3
+1 v
 
 v 1
 data Options = Options
-2 1              v
+1 2            v
   { optionsReportType      :: ReportType
 2 1 v
   , optionsProfFile        :: Maybe FilePath
-1 v 2
+1 v
   , optionsOutputFile      :: Maybe FilePath
-1 v 2
+1 v
   , optionsFlamegraphFlags :: [String]
-1 v 2
+1 v
   } deriving (Eq, Show)
-v 1 2
+v 1
 
 v 1
 class  (Eq a) => Ord a  where
-2 1 v                     3
+1 v
   (<), (<=), (>=), (>)  :: a -> a -> Bool
-v 1 2                     3
+v 1
   max @Foo, min        :: a -> a -> a
-1 v 2                     3
+1 v
 
 v 1
 instance (Eq a) => Eq (Tree a) where
-2 1 v                            3
+1 v
   Leaf a         == Leaf b          =  a == b
-v 1 2                            3
+v 1
   (Branch l1 r1) == (Branch l2 r2)  =  (l1==l2) && (r1==r2)
-v 1 2                            3
+v 1
   _              == _               =  False
-1 v 2                            3
+1 v
 
 v 2             1
 data ReportType = Alloc   -- ^ Report allocations, percent
-2 3             1   v
+1               2 v
                 | Entries -- ^ Report entries, number
-1               v 2
+1               v
                 | Time    -- ^ Report time spent in closure, percent
-1               v 2
+1               v
                 | Ticks   -- ^ Report ticks, number
-1               v 2
+1               v
                 | Bytes   -- ^ Report bytes allocated, number
-1               v 2
+1               v
                 deriving (Eq, Show)
-v               1 2
+v               1
 
 v 1             2
 type family G a where
-2 1 v             3
+1 v
   G Int = Bool
-v 1 2             3
+v 1
   G a   = Char
-1 v 2             3
+1 v
 
 v 1
 data Flobble = Flobble
-2 1              v
+1 2            v
   deriving (Eq) via (NonNegative (Large Int))
-1 v 2
+1 v
   deriving stock (Floo)
-1 v 2
+1 v
   deriving anyclass (WibblyWoo, OtherlyWoo)
-v 1 2
+v 1
 
 v 1
 newtype Flobby = Flobby
-v 1
+v
 
-v12
+v1
 foo ::
-1 2 v
+v   1
  Wibble -- wibble
-v2 31
+v1  2
     -> Wobble -- wobble
-v2  1 3
+v2  1
     -> Wobble -- wobble
-v2  1 3
+v2  1
     -> Wobble -- wobble
-v2  1 3
+v2  1
     -> (wob :: Wobble)
-v2  1 3
+v2  1
     -> (Wobble -- wobble
-12  3 4   v
+23  1   v
     a b c)
-v1  2 3
+v2  1
 
-v 1 2
+v1  2
 (foo :: (Wibble Wobble)) foo
-v 1 2
+v1  2
 
-v 21
+v2 13
 newtype TestApp
-2 31    v
+v  1
    (logger :: TestLogger)
-1  v 2
+1  v
    (scribe :: TestScribe)
-1  v 2
+1  v
    config
-1  v 2
+1  v
    a
-v  1 2
+v  1
    = TestApp a
-v  1 2
+v  1
 
-v 12
+v  1
 optionsParser :: Opts.Parser Options
 v 1
 optionsParser = Options
-2 3    1        v
+1      2        v
   <$> (Opts.flag' Alloc (Opts.long "alloc" <> Opts.help "wibble")
-2 3 4  1    v
+3 1    2    v
        <|> Opts.flag' Entries (Opts.long "entry" <> Opts.help "wobble")
-2 1    v 3
+2 1    v
        <|> Opts.flag' Bytes   (Opts.long "bytes" <> Opts.help "i'm a fish"))
-2 v    314
+3 v    12
   <*> optional
-2 3 4  5v 1
+3 1   v4  2
         (Opts.strArgument
-2 3    45 61    v
+3 4    51  2  v
           (Opts.metavar "MY-FILE" <>
-1 2    34 5 6   v
+2 3    45 1     v
            Opts.help "meh"))
-1 2   v34 56 7
+2 3   v45 61
 
-v 1        2
+v 1    23 45
 type PhantomThing
-v 1
+v
 
-v 2    1
+v      1
 type SomeApi =
-2 v                                            1
+1 v                                            2
        "thing" :> Capture "bar" Index :> QueryParam "wibble" Text
-2      3 4     v                               1
+2      v                                       1
                                                :> QueryParam "wobble" Natural
-1      2                                       v 3
+1      2                                       v
                                                :> Header TracingHeader 
TracingId
-1      2                                       v 3
+1      2                                       v
                                                :> ThingHeader
-2 1    3                                       v 4
+2 1    3                                       v
                                                :> Get '[JSON] (The ReadResult)
-2      3              1                        v 4
+2      3              1                        v
   :<|> "thing" :> ReqBody '[JSON] Request
-2 v 3  4              1                        5
+2 v    3              1                        4
                       :> Header TracingHeader TracingId
-1 2    3              v 4                      5
+1 2    3              v                        4
                       :> SpecialHeader
-1 2    3              v 4                      5
+1 2    3              v                        4
                       :> Post '[JSON] (The Response)
-v 1    2              3 4                      5
+v 2    3              1                        4
 
-v 1                   2
+v 1    2              3                        4
 deriving instance FromJSONKey StateName
-v 1
+v
 deriving anyclass instance FromJSON Base
-v 1
+v
 deriving newtype instance FromJSON Treble
-v 1
+v
 
 v 1
 foo = do
-2 1 v   3
+1 v     2
   bar :: Wibble <- baz
-v 2 3   1
+v 1
   where baz = _
-1 2 3   v
+2 1     v
   -- checking that comments are ignored in layout
-1 2 3   v
+2 1     v
   -- and that a starting syntax entry is ok
-v 1 2
+v 1     2
         (+) = _
-1 2 3   4 5     v
+2 3     1     v
 
 v 1     2
 test = 1 `shouldBe` 1
\ No newline at end of file



reply via email to

[Prev in Thread] Current Thread [Next in Thread]