[nongnu] elpa/haskell-tng-mode a830fcb 135/385: reindention test

[ELPA Syncer]

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