branch: elpa/haskell-tng-mode commit a830fcbc12ca37b200cc9f102103c0f9b3012539 Author: Tseen She <ts33n....@gmail.com> Commit: Tseen She <ts33n....@gmail.com>
reindention test --- haskell-tng-smie.el | 15 ++- test/haskell-tng-indent-test.el | 80 ++++++----- test/src/layout.hs.reindent | 38 ++++++ test/src/medley.hs.reindent | 292 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 386 insertions(+), 39 deletions(-) diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el index 0d10bc3..06067fe 100644 --- a/haskell-tng-smie.el +++ b/haskell-tng-smie.el @@ -106,6 +106,13 @@ information, to aid in the creation of new rules." (haskell-tng-smie:debug #'indent-for-tab-command)) ;; https://www.gnu.org/software/emacs/manual/html_mono/elisp.html#SMIE-Indentation +;; +;; The concept of "virtual indentation" can be confusing. This function is +;; called multiple times for a single indentation command. `:before' does not +;; always mean that we are indenting the next token, but could be a request for +;; the virtual indentation of the previous token. For example, consider a `do' +;; block, we will get an `:after' and a `:before' on the `do' which may be at +;; column 20 but virtually at column 0. (defun haskell-tng-smie:rules (method arg) ;; see docs for `smie-rules-function' (when haskell-tng-smie:debug @@ -117,9 +124,7 @@ information, to aid in the creation of new rules." ('basic smie-indent-basic) )) - ;; TODO implement more indentation rules - - ;; 1. when writing do notation, should we align with the last do line or aim for continuations? sync with alts + ;; FIXME implement the core indentation rules (:after (pcase arg ("where" @@ -152,8 +157,10 @@ information, to aid in the creation of new rules." ;; TAB+TAB and RETURN+TAB (eq this-command last-command) (member last-command haskell-tng-smie:return))) - ;; avoid recalculating the prime indentation level + ;; avoid recalculating the prime indentation level (application of smie rules) (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) diff --git a/test/haskell-tng-indent-test.el b/test/haskell-tng-indent-test.el index d8d6d14..08da3b0 100644 --- a/test/haskell-tng-indent-test.el +++ b/test/haskell-tng-indent-test.el @@ -12,7 +12,6 @@ (require 'haskell-tng-testutils "test/haskell-tng-testutils.el") -(ert-deftest haskell-tng-indent-file-tests () ;; Three indentation regression tests are possible: ;; ;; 1. newline-and-indent with the rest of the file deleted (append) @@ -26,75 +25,74 @@ ;; ;; Test 1 involves a lot of buffer refreshing and will be very slow. +(ert-deftest haskell-tng-newline-indent-file-tests () (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 - - ;; FIXME type 3 tests without alternatives ) -;; TODO enable this test and get it passing, which requires a TAB command that -;; will insert whitespace and move point to end. Workaround is to use abbrevs or -;; yasnippets for things like "import" that have fixed indentations. -;; -;; (ert-deftest haskell-tng-indent-custom-tests () -;; (with-temp-buffer -;; (insert-file-contents (testdata "src/medley.hs")) -;; (haskell-tng-mode) -;; ;; import TAB should jump to column 17 -;; (goto-char 511) -;; (ert-simulate-command '(forward-word)) -;; (ert-simulate-command '(indent-for-tab-command)) -;; (ert-simulate-command '(indent-for-tab-command)) -;; (should (equal (point) 528)) -;; )) +(ert-deftest haskell-tng-reindent-file-tests () + (should (have-expected-reindent-insert (testdata "src/layout.hs"))) + (should (have-expected-reindent-insert (testdata "src/medley.hs"))) + + ;; FIXME a test file specifically for common indentation situations to + ;; define a spec. + ) (defun current-line-string () (buffer-substring-no-properties (line-beginning-position) (- (line-beginning-position 2) 1))) -(defun haskell-tng-indent-test:newline-indent-insert () +(defun haskell-tng-indent-test:indent-insert (return-mode) (let (indents) (while (not (eobp)) - (end-of-line) ;; the command loop is necessary for this/last-command (cl-flet ((RET () + (end-of-line) (ert-simulate-command '(newline-and-indent)) (current-column)) (TAB () (ert-simulate-command '(indent-for-tab-command)) (current-column))) - (let ((line (current-line-string)) - (prime (RET)) + (let ((orig (current-indentation)) + (line (current-line-string)) + (prime (if return-mode (RET) (TAB))) alts) (while (and (TAB) (not (eq (current-column) prime)) (not (member (current-column) alts))) (push (current-column) alts)) - (push `(,line . (,prime . ,(reverse alts))) indents) - ;; unfortunately killing resets this-command so we don't test double + (push `(, return-mode ,line . (,prime . ,(reverse alts))) indents) + ;; unfortunately killing resets this-command so we can't test double ;; newline insertions, which could accidentally trigger alts only. - (kill-whole-line)))) + (if return-mode + (kill-whole-line) + (indent-line-to orig) + (ert-simulate-command '(forward-line)))))) (reverse indents))) (defun haskell-tng-indent-test:indents-to-string (indents) "INDENTS is a list of INDENT. -INDENT is a non-empty list of (LINE . (INDENT . ALTS)) where LINE -is the string line of code before the indentation, INDENT is the -integer suggested next line indentation column and ALTS is a list -of integer alternative indentations." +INDENT is a non-empty list of (RETURN-MODE . (LINE . (INDENT . +ALTS))) where RETURN-MODE is t for newline insertions (i.e. LINE +is a string of the previous line) and nil for reindent (i.e. LINE +is a string of the current line). + +INDENT is the integer suggested next line indentation column and +ALTS is a list of integer alternative indentations." (s-join "\n" (-flatten (-map #'haskell-tng-indent-test:indent-to-string indents)))) (defun haskell-tng-indent-test:indent-to-string (indent) - (let* ((line (car indent)) - (prime (cadr indent)) - (alts (cddr indent)) - (widest (-max (cdr indent))) + (let* ((return-mode (car indent)) + (line (cadr indent)) + (prime (caddr indent)) + (alts (cdddr indent)) + (widest (-max (cddr indent))) repr) (--dotimes (+ 1 widest) (push @@ -107,7 +105,10 @@ of integer alternative indentations." "."))) (t " ")) repr)) - (list line (s-join "" (reverse repr))))) + (let ((indents (s-join "" (reverse repr)))) + (if return-mode + (list line indents) + (list indents line))))) (defun have-expected-newline-indent-insert (file) (haskell-tng-testutils:assert-file-contents @@ -115,7 +116,16 @@ of integer alternative indentations." #'haskell-tng-mode (lambda () (haskell-tng-indent-test:indents-to-string - (haskell-tng-indent-test:newline-indent-insert))) + (haskell-tng-indent-test:indent-insert t))) "insert.indent")) +(defun have-expected-reindent-insert (file) + (haskell-tng-testutils:assert-file-contents + file + #'haskell-tng-mode + (lambda () + (haskell-tng-indent-test:indents-to-string + (haskell-tng-indent-test:indent-insert nil))) + "reindent")) + ;;; haskell-tng-indent-test.el ends here diff --git a/test/src/layout.hs.reindent b/test/src/layout.hs.reindent new file mode 100644 index 0000000..d690dfc --- /dev/null +++ b/test/src/layout.hs.reindent @@ -0,0 +1,38 @@ +v +-- Figure 2.1 from the Haskell2010 report +v 1 +module AStack( Stack, push, pop, top, size ) where +2 v 1 3 +data Stack a = Empty +1 2 v + | MkStack a (Stack a) +v 1 2 + +v 1 2 +push :: a -> Stack a -> Stack a +v 1 +push x s = MkStack x s +v 1 + +v 1 +size :: Stack a -> Int +v 2 1 +size s = length (stkToLst s) where +2 3 1 v 4 + stkToLst Empty = [] +v 1 2 3 + stkToLst (MkStack x s) = x:xs where xs = stkToLst s +1 2 3 4 v + +v 1 2 +pop :: Stack a -> (a, Stack a) +v 1 +pop (MkStack x s) +v 1 + = (x, case s of r -> i r where i x = x) -- (pop Empty) is an error +v 1 2 3 + +v 1 +top :: Stack a -> a +v 1 +top (MkStack x s) = x -- (top Empty) is an error \ No newline at end of file diff --git a/test/src/medley.hs.reindent b/test/src/medley.hs.reindent new file mode 100644 index 0000000..481b99b --- /dev/null +++ b/test/src/medley.hs.reindent @@ -0,0 +1,292 @@ +v +{-# LANGUAGE OverloadedStrings #-} +v 1 +{-# LANGUAGE ScopedTypeVariables #-} +v 1 + +v 1 +-- | This file is a medley of various constructs and some corner cases +v 1 +module Foo.Bar.Main +2 1 v + ( Wibble(..), Wobble(Wobb, (!!!)), Woo +2 1 v + -- * Operations +2 1 v + , getFooByBar, getWibbleByWobble +1 v 2 + , module Bloo.Foo +1 v 2 +) where +v 1 2 + +1 v +import Control.Applicative (many, optional, pure, (<*>), (<|>)) +v 1 +import Data.Foldable (traverse_) +v 1 +import Data.Functor ((<$>)) +v 1 +import Data.List (intercalate) +v 1 +import Data.Monoid ((<>)) +v 1 +import qualified Options.Monad +v 1 +import qualified Options.Applicative as Opts +v 21 +import qualified Options.Divisible -- wibble (wobble) +1 2 v + as Div +v 1 2 +import qualified ProfFile.App hiding (as, hiding, qualified) +v 1 +import ProfFile.App (as, hiding, qualified) +v 1 +import ProfFile.App hiding (as, hiding, qualified) +v 1 +import qualified ProfFile.App (as, hiding, qualified) +v 2 1 +import System.Exit (ExitCode (..), exitFailure, qualified, +1 2 v + Typey, +1 v 2 + wibble, +1 v 2 + Wibble) +v 1 2 +import System.FilePath (replaceExtension, Foo(Bar, (:<))) +v 2 1 +import System.IO (IOMode (..), hClose, hGetContents, +1 2 v + hPutStr, hPutStrLn, openFile, stderr, +1 v 2 + stdout, MoarTypey) +v 1 2 +import System.Process (CreateProcess (..), StdStream (..), +1 2 v + createProcess, proc, waitForProcess) +1 v 2 3 + +v 1 2 +-- some chars that should be propertized +v 1 2 +chars = ['c', '\n', '\''] +v 1 + +v 1 +strings = ["", "\"\"", "\n\\ ", "\\"] +v 1 +-- knownWrongEscape = "foo"\\"bar" +v 1 + +v 2 1 +multiline1 = "\ +1 2 v 3 + \ " +3 v 425 1 +multiline2 = "\ +1 2 v 3 + \" +2 v 3 4 1 + +v 1 2 +difficult = foo' 'a' 2 +v 1 + +v 1 +foo = "wobble (wibble)" +v 1 + +v 1 +class Get a s where +1 2 v 3 + get :: Set s -> a +1 v 2 3 + +v 1 +instance {-# OVERLAPS #-} Get a (a ': s) where +1 2 v 3 + get (Ext a _) = a +1 v 2 3 + +v 1 +instance {-# OVERLAPPABLE #-} Get a s => Get a (b ': s) where +1 2 v 3 + get (Ext _ xs) = get xs +1 v 2 3 + +v 1 +data Options = Options +2 1 v + { optionsReportType :: ReportType +2 1 v + , optionsProfFile :: Maybe FilePath +1 v 2 + , optionsOutputFile :: Maybe FilePath +1 v 2 + , optionsFlamegraphFlags :: [String] +1 v 2 + } deriving (Eq, Show) +v 1 2 + +v 1 +class (Eq a) => Ord a where +2 1 v 3 + (<), (<=), (>=), (>) :: a -> a -> Bool +v 1 2 3 + max @Foo, min :: a -> a -> a +1 v 2 3 + +v 1 +instance (Eq a) => Eq (Tree a) where +2 1 v 3 + Leaf a == Leaf b = a == b +v 1 2 3 + (Branch l1 r1) == (Branch l2 r2) = (l1==l2) && (r1==r2) +v 1 2 3 + _ == _ = False +1 v 2 3 + +v 2 1 +data ReportType = Alloc -- ^ Report allocations, percent +2 3 1 v + | Entries -- ^ Report entries, number +1 v 2 + | Time -- ^ Report time spent in closure, percent +1 v 2 + | Ticks -- ^ Report ticks, number +1 v 2 + | Bytes -- ^ Report bytes allocated, number +1 v 2 + deriving (Eq, Show) +v 1 2 + +v 1 2 +type family G a where +2 1 v 3 + G Int = Bool +v 1 2 3 + G a = Char +1 v 2 3 + +v 1 +data Flobble = Flobble +2 1 v + deriving (Eq) via (NonNegative (Large Int)) +1 v 2 + deriving stock (Floo) +1 v 2 + deriving anyclass (WibblyWoo, OtherlyWoo) +v 1 2 + +v 1 +newtype Flobby = Flobby +v 1 + +v12 +foo :: +1 2 v + Wibble -- wibble +v2 31 + -> Wobble -- wobble +v2 1 3 + -> Wobble -- wobble +v2 1 3 + -> Wobble -- wobble +v2 1 3 + -> (wob :: Wobble) +v2 1 3 + -> (Wobble -- wobble +12 3 4 v + a b c) +v1 2 3 + +v 1 2 +(foo :: (Wibble Wobble)) foo +v 1 2 + +v 21 +newtype TestApp +2 31 v + (logger :: TestLogger) +1 v 2 + (scribe :: TestScribe) +1 v 2 + config +1 v 2 + a +v 1 2 + = TestApp a +v 1 2 + +v 12 +optionsParser :: Opts.Parser Options +v 1 +optionsParser = Options +2 3 1 v + <$> (Opts.flag' Alloc (Opts.long "alloc" <> Opts.help "wibble") +2 3 4 1 v + <|> Opts.flag' Entries (Opts.long "entry" <> Opts.help "wobble") +2 1 v 3 + <|> Opts.flag' Bytes (Opts.long "bytes" <> Opts.help "i'm a fish")) +2 v 314 + <*> optional +2 3 4 5v 1 + (Opts.strArgument +2 3 45 61 v + (Opts.metavar "MY-FILE" <> +1 2 34 5 6 v + Opts.help "meh")) +1 2 v34 56 7 + +v 1 2 +type PhantomThing +v 1 + +v 2 1 +type SomeApi = +2 v 1 + "thing" :> Capture "bar" Index :> QueryParam "wibble" Text +2 3 4 v 1 + :> QueryParam "wobble" Natural +1 2 v 3 + :> Header TracingHeader TracingId +1 2 v 3 + :> ThingHeader +2 1 3 v 4 + :> Get '[JSON] (The ReadResult) +2 3 1 v 4 + :<|> "thing" :> ReqBody '[JSON] Request +2 v 3 4 1 5 + :> Header TracingHeader TracingId +1 2 3 v 4 5 + :> SpecialHeader +1 2 3 v 4 5 + :> Post '[JSON] (The Response) +v 1 2 3 4 5 + +v 1 2 +deriving instance FromJSONKey StateName +v 1 +deriving anyclass instance FromJSON Base +v 1 +deriving newtype instance FromJSON Treble +v 1 + +v 1 +foo = do +2 1 v 3 + bar :: Wibble <- baz +v 2 3 1 + where baz = _ +1 2 3 v + -- checking that comments are ignored in layout +1 2 3 v + -- and that a starting syntax entry is ok +v 1 2 + (+) = _ +1 2 3 4 5 v + +v 1 2 +test = 1 `shouldBe` 1 \ No newline at end of file