branch: elpa/haskell-tng-mode
commit 083e80a4b4dfabee5fa08125b9bf2d09fdf9ac8a
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
assert on alternative indentation order
---
haskell-tng-smie.el | 3 +-
test/haskell-tng-indent-test.el | 7 +-
test/src/layout.hs.insert.indent | 22 ++--
test/src/medley.hs.insert.indent | 222 +++++++++++++++++++--------------------
4 files changed, 130 insertions(+), 124 deletions(-)
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 0a7cb6c..5fd149e 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -88,7 +88,6 @@
;;
https://www.gnu.org/software/emacs/manual/html_mono/elisp.html#SMIE-Indentation
(defun haskell-tng-smie:rules (method arg)
;; see docs for `smie-rules-function'
- ;; FIXME implement prime indentation
;; (message "INDENT %S %S" method arg)
(pcase method
(:elem
@@ -96,6 +95,8 @@
('basic smie-indent-basic)
))
+ ;; TODO implement more indentation rules
+
(:after
(pcase arg
("where"
diff --git a/test/haskell-tng-indent-test.el b/test/haskell-tng-indent-test.el
index acb6560..f1e62f5 100644
--- a/test/haskell-tng-indent-test.el
+++ b/test/haskell-tng-indent-test.el
@@ -29,6 +29,7 @@
(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
)
;; TODO enable this test and get it passing, which requires a TAB command that
@@ -97,7 +98,11 @@ of integer alternative indentations."
(push
(cond
((eq it prime) "v")
- ((member it alts) ".")
+ ((member it alts)
+ (let ((i (-elem-index it alts)))
+ (if (< i 9)
+ (number-to-string (+ 1 i))
+ ".")))
(t " "))
repr))
(list line (s-join "" (reverse repr)))))
diff --git a/test/src/layout.hs.insert.indent b/test/src/layout.hs.insert.indent
index 22d0aa6..8fcf9b0 100644
--- a/test/src/layout.hs.insert.indent
+++ b/test/src/layout.hs.insert.indent
@@ -3,35 +3,35 @@ v
module AStack( Stack, push, pop, top, size ) where
v
data Stack a = Empty
-. . v
+2 1 v
| MkStack a (Stack a)
-. v
+1 v
-v .
+v 1
push :: a -> Stack a -> Stack a
v
push x s = MkStack x s
-. v
+1 v
v
size :: Stack a -> Int
v
size s = length (stkToLst s) where
-. v .
+2 v 1
stkToLst Empty = []
-. . v
+2 1 v
stkToLst (MkStack x s) = x:xs where xs = stkToLst s
-. . v
+1 2 v
-. . v
+1 2 v
pop :: Stack a -> (a, Stack a)
v
pop (MkStack x s)
-. . v
+2 1 v
= (x, case s of r -> i r where i x = x) -- (pop Empty) is an error
-. . v
+1 2 v
-v .
+v 1
top :: Stack a -> a
v
top (MkStack x s) = x -- (top Empty) is an error
diff --git a/test/src/medley.hs.insert.indent b/test/src/medley.hs.insert.indent
index cc4147d..5c5e66b 100644
--- a/test/src/medley.hs.insert.indent
+++ b/test/src/medley.hs.insert.indent
@@ -7,19 +7,19 @@ v
-- | This file is a medley of various constructs and some corner cases
v
module Foo.Bar.Main
-. . v
+2 1 v
( Wibble(..), Wobble(Wobb, (!!!)), Woo
-. . v
+2 1 v
-- * Operations
-. . v
+2 1 v
, getFooByBar, getWibbleByWobble
-. . v
+2 1 v
, module Bloo.Foo
-. . v
+2 1 v
) where
-v .
+v 1
-v .
+v 1
import Control.Applicative (many, optional, pure, (<*>), (<|>))
v
import Data.Foldable (traverse_)
@@ -35,9 +35,9 @@ v
import qualified Options.Applicative as Opts
v
import qualified Options.Divisible -- wibble (wobble)
-. . v
+2 1 v
as Div
-v .
+v 1
import qualified ProfFile.App hiding (as, hiding, qualified)
v
import ProfFile.App (as, hiding, qualified)
@@ -47,228 +47,228 @@ v
import qualified ProfFile.App (as, hiding, qualified)
v
import System.Exit (ExitCode (..), exitFailure, qualified,
-. v
+1 v
Typey,
-. v
+1 v
wibble,
-. v
+1 v
Wibble)
-v .
+v 1
import System.FilePath (replaceExtension, Foo(Bar, (:<)))
v
import System.IO (IOMode (..), hClose, hGetContents,
-. v
+1 v
hPutStr, hPutStrLn, openFile, stderr,
-. v
+1 v
stdout, MoarTypey)
-v .
+v 1
import System.Process (CreateProcess (..), StdStream (..),
-. v
+1 v
createProcess, proc, waitForProcess)
-. v .
+1 v 2
-. v .
+1 v 2
-- some chars that should be propertized
-v .
+v 1
chars = ['c', '\n', '\'']
-. v
+1 v
v
difficult = foo' 'a' 2
-. v
+1 v
v
foo = "wobble (wibble)"
-. v
+1 v
v
class Get a s where
-. v
+1 v
get :: Set s -> a
-. . v
+1 2 v
-. v
+1 v
instance {-# OVERLAPS #-} Get a (a ': s) where
-. . v
+2 1 v
get (Ext a _) = a
-. . v
+1 2 v
-. v
+1 v
instance {-# OVERLAPPABLE #-} Get a s => Get a (b ': s) where
-. . v
+2 1 v
get (Ext _ xs) = get xs
-. . v
+1 2 v
-. v
+1 v
data Options = Options
-. . v
+2 1 v
{ optionsReportType :: ReportType
-. . v
+2 1 v
, optionsProfFile :: Maybe FilePath
-. . v
+2 1 v
, optionsOutputFile :: Maybe FilePath
-. . v
+2 1 v
, optionsFlamegraphFlags :: [String]
-. . v
+2 1 v
} deriving (Eq, Show)
-. v
+1 v
-v .
+v 1
class (Eq a) => Ord a where
-. . v
+2 1 v
(<), (<=), (>=), (>) :: a -> a -> Bool
-. . v
+2 1 v
max @Foo, min :: a -> a -> a
-. . v
+1 2 v
-. v
+1 v
instance (Eq a) => Eq (Tree a) where
-. . v
+2 1 v
Leaf a == Leaf b = a == b
-. . v
+2 1 v
(Branch l1 r1) == (Branch l2 r2) = (l1==l2) && (r1==r2)
-. . v
+2 1 v
_ == _ = False
-. . v
+1 2 v
-. v
+1 v
data ReportType = Alloc -- ^ Report allocations, percent
-. . v
+2 1 v
| Entries -- ^ Report entries, number
-. v
+1 v
| Time -- ^ Report time spent in closure, percent
-. v
+1 v
| Ticks -- ^ Report ticks, number
-. v
+1 v
| Bytes -- ^ Report bytes allocated, number
-. v
+1 v
deriving (Eq, Show)
-. v
+1 v
-v .
+v 1
type family G a where
-. . v
+2 1 v
G Int = Bool
-. . v
+2 1 v
G a = Char
-. . v
+1 2 v
-. v
+1 v
data Flobble = Flobble
-. . v
+2 1 v
deriving (Eq) via (NonNegative (Large Int))
-. v
+1 v
deriving stock (Floo)
-. v
+1 v
deriving anyclass (WibblyWoo, OtherlyWoo)
-. v
+1 v
-v .
+v 1
newtype Flobby = Flobby
-. v
+1 v
v
foo ::
-.. v
+21 v
Wibble -- wibble
-.v .
+2v 1
-> Wobble -- wobble
-.. . v
+32 1 v
-> Wobble -- wobble
-.. . v
+32 1 v
-> Wobble -- wobble
-.. . v
+32 1 v
-> (wob :: Wobble)
-.. . v
+32 1 v
-> (Wobble -- wobble
-.. . v
+32 1 v
a b c)
-.. . v
+13 2 v
-v. .
+v2 1
(foo :: (Wibble Wobble)) foo
-.. . v
+13 2 v
-v. .
+v2 1
newtype TestApp
-. . v
+2 1 v
(logger :: TestLogger)
-. v
+1 v
(scribe :: TestScribe)
-. v
+1 v
config
-. v
+1 v
a
-. v
+1 v
= TestApp a
-. . v
+1 2 v
-v .
+v 1
optionsParser :: Opts.Parser Options
v
optionsParser = Options
-. . v
+2 1 v
<$> (Opts.flag' Alloc (Opts.long "alloc" <> Opts.help "wibble")
-. . . v
+3 2 1 v
<|> Opts.flag' Entries (Opts.long "entry" <> Opts.help "wobble")
-. . . v
+3 2 1 v
<|> Opts.flag' Bytes (Opts.long "bytes" <> Opts.help "i'm a fish"))
-. . .v
+3 1 2v
<*> optional
-. . .v
+3 1 2v
(Opts.strArgument
-. . .. . v
+5 3 42 1 v
(Opts.metavar "MY-FILE" <>
-. . .. .. v
+6 4 53 21 v
Opts.help "meh"))
-. . .v ..
+1 4 5v 32
-. . v.. ..
+1 5 v64 32
type PhantomThing
-. v
+1 v
v
type SomeApi =
-. v .
+2 v 1
"thing" :> Capture "bar" Index :> QueryParam "wibble" Text
-. . v .
+3 2 v 1
:> QueryParam "wobble" Natural
-. . v
+2 1 v
:> Header TracingHeader
TracingId
-. . v
+2 1 v
:> ThingHeader
-. . v
+2 1 v
:> Get '[JSON] (The ReadResult)
-. . . v
+3 1 2 v
:<|> "thing" :> ReqBody '[JSON] Request
-. v . . .
+4 v 3 1 2
:> Header TracingHeader TracingId
-. . . v .
+4 1 3 v 2
:> SpecialHeader
-. . . v .
+4 1 3 v 2
:> Post '[JSON] (The Response)
-. . . v .
+1 2 4 v 3
-v . . . .
+v 2 4 1 3
deriving instance FromJSONKey StateName
v
deriving anyclass instance FromJSON Base
v
deriving newtype instance FromJSON Treble
-. v
+1 v
v
foo = bar
-. . v
+2 1 v
where baz = _
-. . . v
+3 2 1 v
-- checking that comments are ignored in layout
-. . . v
+3 2 1 v
-- and that a starting syntax entry is ok
-. . . v
+3 2 1 v
(+) = _
-. . . v
+1 3 2 v
-. . v
+1 2 v
test = 1 `shouldBe` 1
v
\ No newline at end of file
