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
