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