branch: elpa/haskell-tng-mode
commit 01ea0b83d5130d85e036a84fc862e108fa61e820
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
heuristic alternative indentation levels
---
haskell-tng-rx.el | 3 +
haskell-tng-smie.el | 57 +++++----
test/haskell-tng-indent-test.el | 57 ++++-----
test/src/layout.hs.insert.indent | 36 +++---
test/src/medley.hs.insert.indent | 266 +++++++++++++++++++--------------------
5 files changed, 216 insertions(+), 203 deletions(-)
diff --git a/haskell-tng-rx.el b/haskell-tng-rx.el
index 165da7e..d8cac08 100644
--- a/haskell-tng-rx.el
+++ b/haskell-tng-rx.el
@@ -44,6 +44,7 @@ give false positives." `(|
(: ,(if hack
'(| symbol-start word-end point)
'(| symbol-start word-end))
+ ;; EXT:UnicodeSyntax (also grammar)
(| ".." "::" ":" "=" "|" "<-" "->" "@" "~" "=>")
,(if hack
'(| symbol-end word-start point)
@@ -89,6 +90,8 @@ give false positives." `(|
(rx-to-string `(: word-start ,haskell-tng:rx:varid)))
(defconst haskell-tng:regexp:symid
(rx-to-string haskell-tng:rx:symid))
+(defconst haskell-tng:regexp:toplevel
+ (rx-to-string haskell-tng:rx:toplevel))
(provide 'haskell-tng-rx)
;;; haskell-tng-rx.el ends here
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 6139fbc..bfec21e 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -62,13 +62,13 @@
;; WLDOs
(wldo
- (block "where" block)
- ("let" block "in")
- ("do" block)
- ("case" id "of" block))
- (block
- ("{" block "}")
- (block ";" block)
+ (blk "where" blk)
+ ("let" blk "in")
+ ("do" blk)
+ ("case" id "of" blk))
+ (blk
+ ("{" blk "}")
+ (blk ";" blk)
(id "=" id)
(id "<-" id)
(id "->" id)
@@ -90,7 +90,7 @@
;;
https://github.com/elixir-editors/emacs-elixir/blob/master/test/test-helper.el#L52-L63
(defun haskell-tng-smie:rules (method arg)
;; see docs for `smie-rules-function'
- ;; TODO implement indentation
+ ;; FIXME implement prime indentation
(pcase (cons method arg)
(`(:elem . basic) smie-indent-basic)
(`(,_ . ",") (smie-rule-separator method))
@@ -101,7 +101,7 @@
(and (not (smie-rule-bolp)) (smie-rule-prev-p "else")
(smie-rule-parent)))))
-(defconst haskell-tng-smie:dont-cycle '(newline-and-indent)
+(defconst haskell-tng-smie:return '(newline-and-indent)
"Users with custom newlines should add their command.")
(defvar-local haskell-tng-smie:indentations nil)
@@ -110,26 +110,39 @@
;; There is a design choice here: either we compute all the indentation
levels
;; (including a recursive call to `smie-indent-calculate') and put them into
a
;; ring that we cycle, or we push/pop with recalculation. We choose the
- ;; latter, because cache invalidation is unclear for the former
- (if (or (not (eq this-command last-command))
- (member this-command haskell-tng-smie:dont-cycle))
+ ;; latter, because cache invalidation is easier.
+ (if (member this-command haskell-tng-smie:return)
(setq haskell-tng-smie:indentations nil)
-
- (when (null haskell-tng-smie:indentations)
+ (when (and
+ (null haskell-tng-smie:indentations)
+ (or
+ ;; TAB+TAB and RETURN+TAB
+ (eq this-command last-command)
+ (member last-command haskell-tng-smie:return)))
;; avoid recalculating the prime indentation level
(let ((prime (current-column)))
(setq haskell-tng-smie:indentations
- (append (-remove-item prime (haskell-tng-smie:indent-alts))
- (list prime)))))
-
- (pop haskell-tng-smie:indentations)))
+ (append
+ ;; TODO backtab, does the cycle in reverse (use a local flag)
+ (-remove-item prime (haskell-tng-smie:indent-alts))
+ (list prime))))))
+ (pop haskell-tng-smie:indentations))
(defun haskell-tng-smie:indent-alts ()
"Returns a list of alternative indentation levels for the
- current line."
- ;; FIXME implement
- '(2)
- )
+current line."
+ (save-excursion
+ (let ((end (line-number-at-pos))
+ indents)
+ (when (re-search-backward haskell-tng:regexp:toplevel nil t)
+ (while (< (line-number-at-pos) end)
+ ;; TODO add positions of WLDOS
+ ;; TODO special cases for import (unless grammar handles it)
+ ;; TODO special cases for multiple whitespaces (implies alignment)
+ ;; TODO end +- 2
+ (push (current-indentation) indents)
+ (forward-line))
+ (-distinct (-sort '< indents))))))
(defun haskell-tng-smie:setup ()
(setq-local smie-indent-basic 2)
diff --git a/test/haskell-tng-indent-test.el b/test/haskell-tng-indent-test.el
index 536e12e..10622bb 100644
--- a/test/haskell-tng-indent-test.el
+++ b/test/haskell-tng-indent-test.el
@@ -40,26 +40,25 @@
(let (indents)
(while (not (eobp))
(end-of-line)
- (let ((indent (list (current-line-string)))
- alts)
- ;; 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)
-
- ;; 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
- (delete-dups
- (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)))
+ ;; the command loop is necessary for this/last-command
+ (cl-flet ((RET ()
+ (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))
+ 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
+ ;; newline insertions, which could accidentally trigger alts only.
+ (kill-whole-line))))
(reverse indents)))
(defun haskell-tng-indent-test:indents-to-string (indents)
@@ -78,16 +77,14 @@ of integer alternative indentations."
(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)))))))
+ (--dotimes (+ 1 widest)
+ (push
+ (cond
+ ((eq it prime) "v")
+ ((member it alts) ".")
+ (t " "))
+ repr))
+ (list line (s-join "" (reverse 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 ad57c30..a0aa39a 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 .
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 99b97b2..475b574 100644
--- a/test/src/medley.hs.insert.indent
+++ b/test/src/medley.hs.insert.indent
@@ -1,274 +1,274 @@
{-# 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 .
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
+. v
instance {-# OVERLAPS #-} Get a (a ': s) where
- v
+. v
get (Ext a _) = a
- . v
+. . v
- v
+. v
instance {-# OVERLAPPABLE #-} Get a s => Get a (b ': s) where
- v
+. v
get (Ext _ xs) = get xs
- . v
+. . 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
+. v
(<), (<=), (>=), (>) :: a -> a -> Bool
- . v
+. . v
max @Foo, min :: a -> a -> a
- . v
+. . v
- v
+. v
instance (Eq a) => Eq (Tree a) where
- v
+. 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
+. 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
+. v
G Int = Bool
- . v
+. . v
G a = Char
- . v
+. . v
- v
+. v
data Flobble = Flobble
- . v
+. v
deriving (Eq) via (NonNegative (Large Int))
- v
+. v
deriving stock (Floo)
- v
+. v
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
+. 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
+. 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
