[nongnu] elpa/haskell-tng-mode 5f423b9 100/385: some alts in the indentation test

[ELPA Syncer]

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

    some alts in the indentation test
---
 haskell-tng-smie.el              |  48 +++-----
 test/haskell-tng-indent-test.el  |  34 ++++--
 test/src/layout.hs.insert.indent |  38 +++----
 test/src/medley.hs.insert.indent | 240 +++++++++++++++++++--------------------
 4 files changed, 179 insertions(+), 181 deletions(-)

diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 1e5de6f..5a887c7 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -102,51 +102,35 @@
           (smie-rule-parent)))))
 
 (defvar-local haskell-tng-smie:indenting nil
-  "Stores if the last command was an indentation.
-
-This works around `this-command' / `last-command' being nil in
-the tests and also covering the multitude of indentation commands
-that will inevitably call `smie-indent'.")
-(defun haskell-tng-smie:indent-invalidation (_beg _end _pre-length)
-  (setq haskell-tng-smie:indenting nil))
+  )
 
 (defun haskell-tng-smie:indent-cycle ()
   "Returns the next alternative indentation level from a ring."
-  ;; detecting newline then TAB, or double TAB, is really hard... needs to not
-  ;; consider double newline. TODO make the detection better.
-  (message "CHECKING INDENT CYCLE %s" haskell-tng-smie:indenting)
-
-  (if (not haskell-tng-smie:indenting)
-      (setq haskell-tng-smie:indenting 't)
-
-    (when (and
-         (eq major-mode 'haskell-tng-mode) ;; smie-indent-functions is global
-         (eq this-command last-command)
-         nil)
+  (when (and
+         (not (eq this-command #'newline-and-indent))
+         (eq this-command last-command))
+    ;; TODO invalidate the cycle
     ;; TODO implement
-    (message "CALLING INDENT CYCLE FROM %s" this-command)
-    2)))
+    ;; (message "CALLING INDENT CYCLE FROM %s" this-command)
+    2))
 
 (defun haskell-tng-smie:setup ()
   (setq-local smie-indent-basic 2)
 
-  (add-to-list
+  (add-hook
    'after-change-functions
-   #'haskell-tng-layout:cache-invalidation)
+   #'haskell-tng-layout:cache-invalidation
+   nil 'local)
 
-  (add-to-list
+  (add-hook
    'after-change-functions
-   #'haskell-tng-lexer:state-invalidation)
+   #'haskell-tng-lexer:state-invalidation
+   nil 'local)
 
-  (add-to-list
+  (add-hook
    'smie-indent-functions
-   #'haskell-tng-smie:indent-cycle)
-
-  ;; FIXME this isn't the correct invalidation as it will fire while cycling
-  ;; through TAB.
-  (add-to-list
-   'after-change-functions
-   #'haskell-tng-smie:indent-invalidation)
+   #'haskell-tng-smie:indent-cycle
+   nil 'local)
 
   (smie-setup
    haskell-tng-smie:grammar
diff --git a/test/haskell-tng-indent-test.el b/test/haskell-tng-indent-test.el
index 75fef90..536e12e 100644
--- a/test/haskell-tng-indent-test.el
+++ b/test/haskell-tng-indent-test.el
@@ -4,6 +4,7 @@
 ;; License: GPL 3 or any later version
 
 (require 'ert)
+(require 'ert-x)
 (require 's)
 
 (require 'haskell-tng-mode)
@@ -41,13 +42,14 @@
       (end-of-line)
       (let ((indent (list (current-line-string)))
             alts)
-        (call-interactively #'newline-and-indent)
+        ;; simulating the command loop is necessary for this-command and
+        ;; last-command to work correctly.
+        (ert-simulate-command '(newline-and-indent))
         (push (current-column) indent)
 
-        ;; TODO a better way to get the alts
-        (while (< (length alts) 1)
-          (message "LOOPING %s %s" this-command last-command)
-          (call-interactively #'indent-for-tab-command)
+        ;; FIXME a better way to get the full cycle of alts, with a limit
+        (while (< (length alts) 2)
+          (ert-simulate-command '(indent-for-tab-command))
           (push (current-column) alts))
 
         (setq indent
@@ -55,6 +57,8 @@
                (append (reverse indent) (reverse alts))))
 
         (push indent indents)
+        ;; unfortunately killing resets this-command so we don't test double
+        ;; newline insertions, which could accidentally trigger alts only.
         (kill-whole-line)))
     (reverse indents)))
 
@@ -69,11 +73,21 @@ of integer alternative indentations."
                 (-map #'haskell-tng-indent-test:indent-to-string indents))))
 
 (defun haskell-tng-indent-test:indent-to-string (indent)
-  (let ((line (car indent))
-        (indent (cadr indent))
-        (_alts (cddr indent)))
-    ;; FIXME show alts
-    (list line (concat (s-repeat indent " ") "v"))))
+  (let* ((line (car indent))
+         (prime (cadr indent))
+         (alts (cddr indent))
+         (widest (-max (cdr indent)))
+         repr)
+    (list line
+          (s-join ""
+           (reverse
+            (dotimes (i (+ 1 widest) repr)
+              (push
+               (cond
+                ((eq i prime) "v")
+                ((member i alts) ".")
+                (t " "))
+               repr)))))))
 
 (defun have-expected-newline-indent-insert (file)
   (haskell-tng-testutils:assert-file-contents
diff --git a/test/src/layout.hs.insert.indent b/test/src/layout.hs.insert.indent
index 2116fc7..ad57c30 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
+v .
 module AStack( Stack, push, pop, top, size ) where
-v
+v .
 data Stack a = Empty
-                 v
+  .              v
              | MkStack a (Stack a)
-             v
+  .          v
 
-v
+v .
 push :: a -> Stack a -> Stack a
-v
+v .
 push x s = MkStack x s
-                   v
+  .                v
 
-v
+v .
 size :: Stack a -> Int
-v
+v .
 size s = length (stkToLst s)  where
-v
+v .
            stkToLst  Empty         = []
-                                       v
+  .                                    v
            stkToLst (MkStack x s)  = x:xs where xs = stkToLst s
-                                                              v
+  .                                                           v
 
-                                                              v
+  .                                                           v
 pop :: Stack a -> (a, Stack a)
-v
+v .
 pop (MkStack x s)
-    v
+  . v
   = (x, case s of r -> i r where i x = x) -- (pop Empty) is an error
-      v
+  .   v
 
-v
+v .
 top :: Stack a -> a
-v
+v .
 top (MkStack x s) = x                     -- (top Empty) is an error
-v
\ No newline at end of file
+v .
\ No newline at end of file
diff --git a/test/src/medley.hs.insert.indent b/test/src/medley.hs.insert.indent
index 8876a40..99b97b2 100644
--- a/test/src/medley.hs.insert.indent
+++ b/test/src/medley.hs.insert.indent
@@ -1,161 +1,161 @@
 {-# LANGUAGE OverloadedStrings   #-}
-v
+v .
 {-# LANGUAGE ScopedTypeVariables #-}
-v
+v .
 
-v
+v .
 -- | This file is a medley of various constructs and some corner cases
-v
+v .
 module Foo.Bar.Main
-               v
+  .            v
   ( Wibble(..), Wobble(Wobb, (!!!)), Woo
-                                       v
+  .                                    v
   -- * Operations
-                                       v
+  .                                    v
   , getFooByBar, getWibbleByWobble
-                   v
+  .                v
   , module Bloo.Foo
-                v
+  .             v
   ) where
-v
+v .
 
-v
+v .
 import           Control.Applicative (many, optional, pure, (<*>), (<|>))
-v
+v .
 import           Data.Foldable       (traverse_)
-v
+v .
 import           Data.Functor        ((<$>))
-v
+v .
 import           Data.List           (intercalate)
-v
+v .
 import           Data.Monoid         ((<>))
-v
+v .
 import qualified Options.Monad
-v
+v .
 import  qualified  Options.Applicative  as  Opts
-v
+v .
 import qualified Options.Divisible -- wibble (wobble)
-       v
+  .    v
    as Div
-v
+v .
 import qualified ProfFile.App        hiding (as, hiding, qualified)
-v
+v .
 import           ProfFile.App        (as, hiding, qualified)
-v
+v .
 import           ProfFile.App        hiding (as, hiding, qualified)
-v
+v .
 import qualified ProfFile.App        (as, hiding, qualified)
-v
+v .
 import           System.Exit         (ExitCode (..), exitFailure, qualified,
-                                      v
+  .                                   v
                                       Typey,
-                                      v
+  .                                   v
                                       wibble,
-                                      v
+  .                                   v
                                       Wibble)
-v
+v .
 import           System.FilePath     (replaceExtension, Foo(Bar, (:<))
-                                      v
+  .                                   v
 import           System.IO           (IOMode (..), hClose, hGetContents,
-                                      v
+  .                                   v
                                       hPutStr, hPutStrLn, openFile, stderr,
-                                      v
+  .                                   v
                                       stdout, MoarTypey)
-v
+v .
 import           System.Process      (CreateProcess (..), StdStream (..),
-                                      v
+  .                                   v
                                       createProcess, proc, waitForProcess)
-                        v
+  .                     v
 
-                        v
+  .                     v
 -- some chars that should be propertized
-v
+v .
 chars = ['c', '\n', '\'']
-          v
+  .       v
 
-v
+v .
 difficult = foo' 'a' 2
-                 v
+  .              v
 
-v
+v .
 foo = "wobble (wibble)"
-        v
+  .     v
 
-v
+v .
 class Get a s where
-                                      v
+  .                                   v
   get :: Set s -> a
-                    v
+  .                 v
 
   v
 instance {-# OVERLAPS #-} Get a (a ': s) where
   v
   get (Ext a _) = a
-                    v
+  .                 v
 
   v
 instance {-# OVERLAPPABLE #-} Get a s => Get a (b ': s) where
   v
   get (Ext _ xs) = get xs
-                       v
+  .                    v
 
   v
 data Options = Options
-                 v
+  .              v
   { optionsReportType      :: ReportType
-                           v
+  .                        v
   , optionsProfFile        :: Maybe FilePath
-                           v
+  .                        v
   , optionsOutputFile      :: Maybe FilePath
-                           v
+  .                        v
   , optionsFlamegraphFlags :: [String]
-                           v
+  .                        v
   } deriving (Eq, Show)
   v
 
-v
+v .
 class  (Eq a) => Ord a  where
   v
   (<), (<=), (>=), (>)  :: a -> a -> Bool
-                                       v
+  .                                    v
   max @Foo, min        :: a -> a -> a
-                                      v
+  .                                   v
 
   v
 instance (Eq a) => Eq (Tree a) where
   v
   Leaf a         == Leaf b          =  a == b
-                                              v
+  .                                           v
   (Branch l1 r1) == (Branch l2 r2)  =  (l1==l2) && (r1==r2)
-                                                     v
+  .                                                  v
   _              == _               =  False
-                                         v
+  .                                      v
 
   v
 data ReportType = Alloc   -- ^ Report allocations, percent
-                    v
+  .                 v
                 | Entries -- ^ Report entries, number
-                v
+  .             v
                 | Time    -- ^ Report time spent in closure, percent
-                v
+  .             v
                 | Ticks   -- ^ Report ticks, number
-                v
+  .             v
                 | Bytes   -- ^ Report bytes allocated, number
-                v
+  .             v
                 deriving (Eq, Show)
-                v
+  .             v
 
-v
+v .
 type family G a where
   v
   G Int = Bool
-            v
+  .         v
   G a   = Char
-            v
+  .         v
 
   v
 data Flobble = Flobble
-                 v
+  .              v
   deriving (Eq) via (NonNegative (Large Int))
   v
   deriving stock (Floo)
@@ -163,112 +163,112 @@ data Flobble = Flobble
   deriving anyclass (WibblyWoo, OtherlyWoo)
   v
 
-v
+v .
 newtype Flobby = Flobby
-                   v
+  .                v
 
-v
+v .
 foo ::
-    v
+  . v
  Wibble -- wibble
- v
+ v.
     -> Wobble -- wobble
-         v
+  .      v
     -> Wobble -- wobble
-         v
+  .      v
     -> Wobble -- wobble
-         v
+  .      v
     -> (wob :: Wobble)
-         v
+  .      v
     -> (Wobble -- wobble
-          v
+  .       v
     a b c)
-         v
+  .      v
 
-v
+v .
 (foo :: (Wibble Wobble)) foo
-                         v
+  .                      v
 
-v
+v .
 newtype TestApp
-        v
+  .     v
    (logger :: TestLogger)
-   v
+  .v
    (scribe :: TestScribe)
-   v
+  .v
    config
-   v
+  .v
    a
-   v
+  .v
    = TestApp a
-             v
+  .          v
 
-v
+v .
 optionsParser :: Opts.Parser Options
-v
+v .
 optionsParser = Options
-                  v
+  .               v
   <$> (Opts.flag' Alloc (Opts.long "alloc" <> Opts.help "wibble")
-                  v
+  .               v
        <|> Opts.flag' Entries (Opts.long "entry" <> Opts.help "wobble")
-                      v
+  .                   v
        <|> Opts.flag' Bytes   (Opts.long "bytes" <> Opts.help "i'm a fish"))
-        v
+  .     v
   <*> optional
-        v
+  .     v
         (Opts.strArgument
-                v
+  .             v
           (Opts.metavar "MY-FILE" <>
-                v
+  .             v
            Opts.help "meh"))
-        v
+  .     v
 
-      v
+  .   v
 type PhantomThing
-     v
+  .  v
 
-v
+v .
 type SomeApi =
   v
        "thing" :> Capture "bar" Index :> QueryParam "wibble" Text
-               v
+  .            v
                                                :> QueryParam "wobble" Natural
-                                               v
+  .                                            v
                                                :> Header TracingHeader 
TracingId
-                                               v
+  .                                            v
                                                :> ThingHeader
-                                               v
+  .                                            v
                                                :> Get '[JSON] (The ReadResult)
-                                               v
+  .                                            v
   :<|> "thing" :> ReqBody '[JSON] Request
   v
                       :> Header TracingHeader TracingId
-                      v
+  .                   v
                       :> SpecialHeader
-                      v
+  .                   v
                       :> Post '[JSON] (The Response)
-                      v
+  .                   v
 
-v
+v .
 deriving instance FromJSONKey StateName
-v
+v .
 deriving anyclass instance FromJSON Base
-v
+v .
 deriving newtype instance FromJSON Treble
-         v
+  .      v
 
-v
+v .
 foo = bar
-        v
+  .     v
   where baz = _
-                v
+  .             v
   -- checking that comments are ignored in layout
-                v
+  .             v
   -- and that a starting syntax entry is ok
-                v
+  .             v
         (+) = _
-                v
+  .             v
 
-        v
+  .     v
 test = 1 `shouldBe` 1
-                                      v
\ No newline at end of file
+  .                                   v
\ No newline at end of file