emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/haskell-tng-mode 794c80b 131/385: better indentation alts


From: ELPA Syncer
Subject: [nongnu] elpa/haskell-tng-mode 794c80b 131/385: better indentation alts
Date: Tue, 5 Oct 2021 23:59:16 -0400 (EDT)

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

    better indentation alts
---
 haskell-tng-smie.el              |  50 ++++----
 test/src/layout.hs.insert.indent |  36 +++---
 test/src/medley.hs.insert.indent | 270 +++++++++++++++++++--------------------
 3 files changed, 181 insertions(+), 175 deletions(-)

diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 36778b8..92bdc9c 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -88,7 +88,7 @@
 ;; 
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'
-;;  (message "INDENT %S %S" method arg)
+  ;;  (message "INDENT %S %S" method arg)
   (pcase method
     (:elem
      (pcase arg
@@ -141,32 +141,38 @@
 (defun haskell-tng-smie:indent-alts ()
   "Returns a list of alternative indentation levels for the
 current line."
-  (save-excursion
-    (let ((the-line (line-number-at-pos))
-          indents)
+  (let ((the-line (line-number-at-pos))
+        indents)
+    (save-excursion
       (when (re-search-backward haskell-tng:regexp:toplevel nil t)
-        (while (< (line-number-at-pos) the-line)
-          ;; FIXME improve the indentation alts
-          ;; TODO add positions of WLDOS
-          ;; TODO +- 2 WLDOS
-          ;; TODO special cases for import (unless grammar handles it)
-          ;; TODO special cases for multiple whitespaces (implies alignment)
-          ;; TODO the-line +- 2
-          (push (current-indentation) indents)
-          (forward-line)))
-
-      ;; alts are easier to use when ordered
-      (setq indents (sort indents '<))
-      ;; TODO consider ordering all alts, and cycling the list so the first alt
-      ;; is the next higher than the current indentation level
-
-      ;; indentation of the next line is common for insert edits, top priority
+        (let ((start (point)))
+          (while (< (line-number-at-pos) the-line)
+            (push (current-indentation) indents) ;; this line's indentation
+            (forward-line))
+          (when (re-search-backward
+                 (rx word-start (| "where" "let" "do" "case") word-end)
+                 start t)
+            ;; TODO the next whitespace level after a WLDO (not a WLDC)
+            (push (+ 2 (current-column)) indents)))))
+
+    (save-excursion
+      (forward-line -1)
+      (when (/= the-line (line-number-at-pos))
+        (push (+ 2 (current-indentation)) indents)))
+
+    ;; alts are easier to use when ordered
+    (setq indents (sort indents '<))
+    ;; TODO consider ordering alts, and cycling the list so the first 
suggestion
+    ;; is the next one higher than the current indentation level.
+
+    ;; indentation of the next line is common for insert edits, top priority
+    (save-excursion
       (forward-line)
       (forward-comment (point-max))
       (when (/= the-line (line-number-at-pos))
-        (push (current-indentation) indents))
+        (push (current-indentation) indents)))
 
-      (-distinct indents))))
+    (-distinct indents)))
 
 (defun haskell-tng-smie:setup ()
   (setq-local smie-indent-basic 2)
diff --git a/test/src/layout.hs.insert.indent b/test/src/layout.hs.insert.indent
index 8fcf9b0..f82da4a 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 1
 module AStack( Stack, push, pop, top, size ) where
-v
+v 1                                            2
 data Stack a = Empty
-2            1   v
+2 3          1   v
              | MkStack a (Stack a)
-1            v
+1            v 2
 
-v            1
+v 1          2
 push :: a -> Stack a -> Stack a
-v
+v 1
 push x s = MkStack x s
-1                  v
+1 2                v
 
-v
+v 1
 size :: Stack a -> Int
-v
+v 1
 size s = length (stkToLst s)  where
-2 v        1
+2 v        1                    3
            stkToLst  Empty         = []
-2          1                           v
+2          1 3                  4      v
            stkToLst (MkStack x s)  = x:xs where xs = stkToLst s
-1          2                                                  v
+1          2 3                              4                 v
 
-1          2                                                  v
+1 2        3                                4                 v
 pop :: Stack a -> (a, Stack a)
-v
+v 1
 pop (MkStack x s)
 2 1 v
   = (x, case s of r -> i r where i x = x) -- (pop Empty) is an error
-1 2   v
+1 2 3 v                      4
 
-v 1
+v 1                          2
 top :: Stack a -> a
-v
+v 1
 top (MkStack x s) = x                     -- (top Empty) is an error
-v
\ No newline at end of file
+v 1
\ No newline at end of file
diff --git a/test/src/medley.hs.insert.indent b/test/src/medley.hs.insert.indent
index 661081d..d980b25 100644
--- a/test/src/medley.hs.insert.indent
+++ b/test/src/medley.hs.insert.indent
@@ -1,292 +1,292 @@
 {-# LANGUAGE OverloadedStrings   #-}
-v
+v 1
 {-# LANGUAGE ScopedTypeVariables #-}
-v
+v 1
 
-v
+v 1
 -- | This file is a medley of various constructs and some corner cases
-v
+v 1
 module Foo.Bar.Main
 2 1              v
   ( Wibble(..), Wobble(Wobb, (!!!)), Woo
-2 1                                    v
+2 1 3                                  v
   -- * Operations
-2 1                                    v
+2 1 3                                  v
   , getFooByBar, getWibbleByWobble
-2 1                v
+2 1 3              v
   , module Bloo.Foo
-1 2               v
+1 2 3             v
 ) where
-v 1
+v 1 2
 
-v 1
+v 1 2
 import           Control.Applicative (many, optional, pure, (<*>), (<|>))
-v
+v 1
 import           Data.Foldable       (traverse_)
-v
+v 1
 import           Data.Functor        ((<$>))
-v
+v 1
 import           Data.List           (intercalate)
-v
+v 1
 import           Data.Monoid         ((<>))
-v
+v 1
 import qualified Options.Monad
-v
+v 1
 import  qualified  Options.Applicative  as  Opts
-v
+v 1
 import qualified Options.Divisible -- wibble (wobble)
-2  1   v
+2 31   v
    as Div
-v  1
+v  1 2
 import qualified ProfFile.App        hiding (as, hiding, qualified)
-v
+v 1
 import           ProfFile.App        (as, hiding, qualified)
-v
+v 1
 import           ProfFile.App        hiding (as, hiding, qualified)
-v
+v 1
 import qualified ProfFile.App        (as, hiding, qualified)
-v
+v 1
 import           System.Exit         (ExitCode (..), exitFailure, qualified,
-1                                     v
+1 2                                   v
                                       Typey,
-1                                     v
+1                                     v 2
                                       wibble,
-1                                     v
+1                                     v 2
                                       Wibble)
-v                                     1
+v                                     1 2
 import           System.FilePath     (replaceExtension, Foo(Bar, (:<)))
-v
+v 1
 import           System.IO           (IOMode (..), hClose, hGetContents,
-1                                     v
+1 2                                   v
                                       hPutStr, hPutStrLn, openFile, stderr,
-1                                     v
+1                                     v 2
                                       stdout, MoarTypey)
-v                                     1
+v                                     1 2
 import           System.Process      (CreateProcess (..), StdStream (..),
-1                                     v
+1 2                                   v
                                       createProcess, proc, waitForProcess)
-1                       v             2
+1                       v             2 3
 
-1                       v             2
+1 2                     v             3
 -- some chars that should be propertized
-v                                     1
+v 1                                   2
 chars = ['c', '\n', '\'']
-1         v
+1 2       v
 
-v
+v 1
 strings = ["", "\"\"", "\n\\ ", "\\"]
-1           v
+1 2         v
 -- knownWrongEscape = "foo"\\"bar"
-1           v
+1 2         v
 
-v
+v 1
 multiline1 = "\
-v       1
+v 2     1
         \ "
-v       1
+v       1 2
 multiline2 = "\
-v        1
+v 2      1
          \"
-1        2     v
+1        2 3   v
 
-v        1
+v 1      2
 difficult = foo' 'a' 2
-1                v
+1 2              v
 
-v
+v 1
 foo = "wobble (wibble)"
-1       v
+1 2     v
 
-v
+v 1
 class Get a s where
-1 v
+1 v             2
   get :: Set s -> a
-1 2                 v
+1 2 3           4   v
 
-1 v
+1 v             2
 instance {-# OVERLAPS #-} Get a (a ': s) where
-2 1 v
+2 1 v                                      3
   get (Ext a _) = a
-1 2                 v
+1 2 3               v                      4
 
-1 v
+1 v                                        2
 instance {-# OVERLAPPABLE #-} Get a s => Get a (b ': s) where
-2 1 v
+2 1 v                                                     3
   get (Ext _ xs) = get xs
-1 2                    v
+1 2 3                  v                                  4
 
-1 v
+1 v                                                       2
 data Options = Options
 2 1              v
   { optionsReportType      :: ReportType
-2 1                        v
+2 1 3                      v
   , optionsProfFile        :: Maybe FilePath
-2 1                        v
+2 1 3                      v
   , optionsOutputFile      :: Maybe FilePath
-2 1                        v
+2 1 3                      v
   , optionsFlamegraphFlags :: [String]
-2 1                        v
+2 1 3                      v
   } deriving (Eq, Show)
-1 v
+1 v 2
 
 v 1
 class  (Eq a) => Ord a  where
-2 1 v
+2 1 v                     3
   (<), (<=), (>=), (>)  :: a -> a -> Bool
-2 1                                    v
+2 1 3                     4            v
   max @Foo, min        :: a -> a -> a
-1 2                                   v
+1 2 3                     4           v
 
-1 v
+1 v                       2
 instance (Eq a) => Eq (Tree a) where
-2 1 v
+2 1 v                            3
   Leaf a         == Leaf b          =  a == b
-2 1                                           v
+2 1 3                            4            v
   (Branch l1 r1) == (Branch l2 r2)  =  (l1==l2) && (r1==r2)
-2 1                                                  v
+2 1 3                            4                   v
   _              == _               =  False
-1 2                                      v
+1 2 3                            4       v
 
-1 v
+1 v                              2
 data ReportType = Alloc   -- ^ Report allocations, percent
-2               1   v
+2 3             1   v
                 | Entries -- ^ Report entries, number
-1               v
+1               v 2
                 | Time    -- ^ Report time spent in closure, percent
-1               v
+1               v 2
                 | Ticks   -- ^ Report ticks, number
-1               v
+1               v 2
                 | Bytes   -- ^ Report bytes allocated, number
-1               v
+1               v 2
                 deriving (Eq, Show)
-1               v
+1               v 2
 
-v               1
+v 1             2
 type family G a where
-2 1 v
+2 1 v             3
   G Int = Bool
-2 1         v
+2 1 3       v     4
   G a   = Char
-1 2         v
+1 2 3       v     4
 
-1 v
+1 v               2
 data Flobble = Flobble
 2 1              v
   deriving (Eq) via (NonNegative (Large Int))
-1 v
+1 v 2
   deriving stock (Floo)
-1 v
+1 v 2
   deriving anyclass (WibblyWoo, OtherlyWoo)
-1 v
+1 v 2
 
 v 1
 newtype Flobby = Flobby
-1                  v
+1 2                v
 
-v
+v 1
 foo ::
-21  v
+213 v
  Wibble -- wibble
-2v  1
+2v 31
     -> Wobble -- wobble
-23  1    v
+23  1 4  v
     -> Wobble -- wobble
-23  1    v
+23  1 4  v
     -> Wobble -- wobble
-23  1    v
+23  1 4  v
     -> (wob :: Wobble)
-23  1    v
+23  1 4  v
     -> (Wobble -- wobble
-23  1     v
+23  1 4   v
     a b c)
-12  3    v
+12  3 4  v
 
-v1  2
+v12 3
 (foo :: (Wibble Wobble)) foo
-12  3                    v
+123 4                    v
 
-v1  2
+v12 3
 newtype TestApp
-2  1    v
+2 31    v
    (logger :: TestLogger)
-1  v
+1  v 2
    (scribe :: TestScribe)
-1  v
+1  v 2
    config
-1  v
+1  v 2
    a
-1  v
+1  v 2
    = TestApp a
-1  2         v
+1  2 3       v
 
-v  1
+v 12
 optionsParser :: Opts.Parser Options
-v
+v 1
 optionsParser = Options
 2 1               v
   <$> (Opts.flag' Alloc (Opts.long "alloc" <> Opts.help "wibble")
-2 3    1          v
+2 3 4  1          v
        <|> Opts.flag' Entries (Opts.long "entry" <> Opts.help "wobble")
-2 3    1              v
+2 3    1 4            v
        <|> Opts.flag' Bytes   (Opts.long "bytes" <> Opts.help "i'm a fish"))
-2 1    3v
+2 1    3v4
   <*> optional
-1 2    3v
+1 2 3  4v
         (Opts.strArgument
 2 3    45 1     v
           (Opts.metavar "MY-FILE" <>
-2 3    45 61    v
+2 3    45 617   v
            Opts.help "meh"))
-1 2    3v 45
+1 2    3v 45 6
 
 1 2   v34 56
 type PhantomThing
-1    v
+1 2  v
 
-v
+v 1
 type SomeApi =
 2 v    1
        "thing" :> Capture "bar" Index :> QueryParam "wibble" Text
-2      3       v                               1
+2      3 4     v                               1
                                                :> QueryParam "wobble" Natural
-1      2                                       v
+1      2                                       v 3
                                                :> Header TracingHeader 
TracingId
-1      2                                       v
+1      2                                       v 3
                                                :> ThingHeader
-1      2                                       v
+1      2                                       v 3
                                                :> Get '[JSON] (The ReadResult)
-2 1    3                                       v
+2 1    3                                       v 4
   :<|> "thing" :> ReqBody '[JSON] Request
-2 v    3              1                        4
+2 v 3  4              1                        5
                       :> Header TracingHeader TracingId
-1 2    3              v                        4
+1 2    3              v 4                      5
                       :> SpecialHeader
-1 2    3              v                        4
+1 2    3              v 4                      5
                       :> Post '[JSON] (The Response)
-1 2    3              v                        4
+1 2    3              v 4                      5
 
 v 1    2              3                        4
 deriving instance FromJSONKey StateName
-v
+v 1
 deriving anyclass instance FromJSON Base
-v
+v 1
 deriving newtype instance FromJSON Treble
-1        v
+1 2      v
 
-v
+v 1
 foo = do
 2 1     v
   bar :: Wibble <- baz
-2 1                  v
+2 1 3   4            v
   where baz = _
-2 3     1       v
+2 3 4   1       v
   -- checking that comments are ignored in layout
-2 3     1       v
+2 3 4   1       v
   -- and that a starting syntax entry is ok
-2 3     1       v
+2 3 4   1       v
         (+) = _
-1 2     3       v
+1 2 3   4 5     v
 
-1 2     3       v
+1 2 3   4       v
 test = 1 `shouldBe` 1
-v
\ No newline at end of file
+v 1
\ No newline at end of file



reply via email to

[Prev in Thread] Current Thread [Next in Thread]