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