[nongnu] elpa/haskell-tng-mode f085f16 097/385: indentation regression tests

[ELPA Syncer]

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

    indentation regression tests
---
 test/haskell-tng-indent-test.el  |  86 ++++++------
 test/src/layout.hs.insert.indent |  38 ++++++
 test/src/medley.hs.insert.indent | 274 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 359 insertions(+), 39 deletions(-)

diff --git a/test/haskell-tng-indent-test.el b/test/haskell-tng-indent-test.el
index d4f41bd..52eb640 100644
--- a/test/haskell-tng-indent-test.el
+++ b/test/haskell-tng-indent-test.el
@@ -12,61 +12,69 @@
          "test/haskell-tng-testutils.el")
 
 (ert-deftest haskell-tng-indent-file-tests ()
-  ;; Four indentation regression tests are possible:
+  ;; Three indentation regression tests are possible:
   ;;
-  ;;   1. newline-and-indent when writing code
-  ;;   2. ... with subsequent indent-line-function cycles
-  ;;   3. indent-line-function at the beginning of an existing line
-  ;;   4. ... with subsequent indent-line-function cycles
+  ;;   1. newline-and-indent with the rest of the file deleted (append)
+  ;;   2. newline-and-indent with the rest of the file intact (insert)
+  ;;   3. indent-line-function at the beginning of each line (re-indent)
+  ;;
+  ;; each with alternative indentation suggestions.
   ;;
   ;; Expectations could use lines of symbols such as | and . or digits to
-  ;; indicate where the indentation(s) go. 1 and 2 are the most interesting so
-  ;; could be combined into one test. 3 and 4 could also be combined.
-
-  ;; (should (have-expected-newline-indent (testdata "src/layout.hs")))
-  ;; (should (have-expected-indent (testdata "src/layout.hs")))
-
-  ;; (should (have-expected-newline-indent (testdata "src/medley.hs")))
-  ;; (should (have-expected-indent (testdata "src/medley.hs")))
+  ;; indicate where the indentation(s) go.
+  ;;
+  ;; Test 1 involves a lot of buffer refreshing and will be very slow.
 
+  (should (have-expected-newline-indent-insert (testdata "src/layout.hs")))
+  (should (have-expected-newline-indent-insert (testdata "src/medley.hs")))
+  ;; TODO more tests
   )
 
-(defun haskell-tng-indent-test:newline-indents ()
-  ;; FIXME
-  )
+(defun current-line-string ()
+  (buffer-substring-no-properties
+   (line-beginning-position)
+   (- (line-beginning-position 2) 1)))
+(defun next-line-string ()
+  (buffer-substring-no-properties
+   (line-beginning-position 2)
+   (- (line-beginning-position 3) 1)))
 
-(defun haskell-tng-indent-test:indents ()
-  ;; FIXME
-  )
+(defun haskell-tng-indent-test:newline-indent-insert ()
+  (let (indents)
+    (while (not (eobp))
+      (end-of-line)
+      (let ((indent (list (current-line-string)))
+            (next (next-line-string)))
+        (newline-and-indent)
+        (push (current-column) indent)
+        ;; FIXME alts go here
+        (push (reverse indent) indents)
+        (kill-whole-line)))
+    (reverse indents)))
 
 (defun haskell-tng-indent-test:indents-to-string (indents)
-  "INDENTS is a list of INDENT which are a non-empty list of
-column numbers indicating the suggested indentation levels. The
-head entry is the newline-and-indent and the rest are the
-indent-line-function cycles."
-  ;; FIXME
-  )
+  "INDENTS is a list of INDENT.
 
-(defun haskell-tng-indent-test:indent-to-string (indent)
-  ;; FIXME
-  )
+INDENT is a non-empty list of (LINE . (INDENT . ALTS)) where LINE
+is the string line of code before the indentation, INDENT is the
+integer suggested next line indentation column and ALTS is a list
+of integer alternative indentations."
+  (s-join "\n" (-flatten
+                (-map #'haskell-tng-indent-test:indent-to-string indents))))
 
-(defun have-expected-newline-indent (file)
-  (haskell-tng-testutils:assert-file-contents
-   file
-   #'haskell-tng-mode
-   (lambda ()
-     (haskell-tng-indent-test:indents-to-string
-      (haskell-tng-indent-test:newline-indents)))
-   "newline-indent"))
+(defun haskell-tng-indent-test:indent-to-string (indent)
+  (let ((line (car indent))
+        (indent (cadr indent))
+        (alts (cddr indent)))
+    (list line (concat (s-repeat indent " ") "v"))))
 
-(defun have-expected-indent (file)
+(defun have-expected-newline-indent-insert (file)
   (haskell-tng-testutils:assert-file-contents
    file
    #'haskell-tng-mode
    (lambda ()
      (haskell-tng-indent-test:indents-to-string
-      (haskell-tng-indent-test:indents)))
-   "indent"))
+      (haskell-tng-indent-test:newline-indent-insert)))
+   "insert.indent"))
 
 ;;; haskell-tng-indent-test.el ends here
diff --git a/test/src/layout.hs.insert.indent b/test/src/layout.hs.insert.indent
new file mode 100644
index 0000000..2116fc7
--- /dev/null
+++ b/test/src/layout.hs.insert.indent
@@ -0,0 +1,38 @@
+-- Figure 2.1 from the Haskell2010 report
+v
+module AStack( Stack, push, pop, top, size ) where
+v
+data Stack a = Empty
+                 v
+             | MkStack a (Stack a)
+             v
+
+v
+push :: a -> Stack a -> Stack a
+v
+push x s = MkStack x s
+                   v
+
+v
+size :: Stack a -> Int
+v
+size s = length (stkToLst s)  where
+v
+           stkToLst  Empty         = []
+                                       v
+           stkToLst (MkStack x s)  = x:xs where xs = stkToLst s
+                                                              v
+
+                                                              v
+pop :: Stack a -> (a, Stack a)
+v
+pop (MkStack x s)
+    v
+  = (x, case s of r -> i r where i x = x) -- (pop Empty) is an error
+      v
+
+v
+top :: Stack a -> a
+v
+top (MkStack x s) = x                     -- (top Empty) is an error
+v
\ No newline at end of file
diff --git a/test/src/medley.hs.insert.indent b/test/src/medley.hs.insert.indent
new file mode 100644
index 0000000..8876a40
--- /dev/null
+++ b/test/src/medley.hs.insert.indent
@@ -0,0 +1,274 @@
+{-# LANGUAGE OverloadedStrings   #-}
+v
+{-# LANGUAGE ScopedTypeVariables #-}
+v
+
+v
+-- | This file is a medley of various constructs and some corner cases
+v
+module Foo.Bar.Main
+               v
+  ( Wibble(..), Wobble(Wobb, (!!!)), Woo
+                                       v
+  -- * Operations
+                                       v
+  , getFooByBar, getWibbleByWobble
+                   v
+  , module Bloo.Foo
+                v
+  ) where
+v
+
+v
+import           Control.Applicative (many, optional, pure, (<*>), (<|>))
+v
+import           Data.Foldable       (traverse_)
+v
+import           Data.Functor        ((<$>))
+v
+import           Data.List           (intercalate)
+v
+import           Data.Monoid         ((<>))
+v
+import qualified Options.Monad
+v
+import  qualified  Options.Applicative  as  Opts
+v
+import qualified Options.Divisible -- wibble (wobble)
+       v
+   as Div
+v
+import qualified ProfFile.App        hiding (as, hiding, qualified)
+v
+import           ProfFile.App        (as, hiding, qualified)
+v
+import           ProfFile.App        hiding (as, hiding, qualified)
+v
+import qualified ProfFile.App        (as, hiding, qualified)
+v
+import           System.Exit         (ExitCode (..), exitFailure, qualified,
+                                      v
+                                      Typey,
+                                      v
+                                      wibble,
+                                      v
+                                      Wibble)
+v
+import           System.FilePath     (replaceExtension, Foo(Bar, (:<))
+                                      v
+import           System.IO           (IOMode (..), hClose, hGetContents,
+                                      v
+                                      hPutStr, hPutStrLn, openFile, stderr,
+                                      v
+                                      stdout, MoarTypey)
+v
+import           System.Process      (CreateProcess (..), StdStream (..),
+                                      v
+                                      createProcess, proc, waitForProcess)
+                        v
+
+                        v
+-- some chars that should be propertized
+v
+chars = ['c', '\n', '\'']
+          v
+
+v
+difficult = foo' 'a' 2
+                 v
+
+v
+foo = "wobble (wibble)"
+        v
+
+v
+class Get a s where
+                                      v
+  get :: Set s -> a
+                    v
+
+  v
+instance {-# OVERLAPS #-} Get a (a ': s) where
+  v
+  get (Ext a _) = a
+                    v
+
+  v
+instance {-# OVERLAPPABLE #-} Get a s => Get a (b ': s) where
+  v
+  get (Ext _ xs) = get xs
+                       v
+
+  v
+data Options = Options
+                 v
+  { optionsReportType      :: ReportType
+                           v
+  , optionsProfFile        :: Maybe FilePath
+                           v
+  , optionsOutputFile      :: Maybe FilePath
+                           v
+  , optionsFlamegraphFlags :: [String]
+                           v
+  } deriving (Eq, Show)
+  v
+
+v
+class  (Eq a) => Ord a  where
+  v
+  (<), (<=), (>=), (>)  :: a -> a -> Bool
+                                       v
+  max @Foo, min        :: a -> a -> a
+                                      v
+
+  v
+instance (Eq a) => Eq (Tree a) where
+  v
+  Leaf a         == Leaf b          =  a == b
+                                              v
+  (Branch l1 r1) == (Branch l2 r2)  =  (l1==l2) && (r1==r2)
+                                                     v
+  _              == _               =  False
+                                         v
+
+  v
+data ReportType = Alloc   -- ^ Report allocations, percent
+                    v
+                | Entries -- ^ Report entries, number
+                v
+                | Time    -- ^ Report time spent in closure, percent
+                v
+                | Ticks   -- ^ Report ticks, number
+                v
+                | Bytes   -- ^ Report bytes allocated, number
+                v
+                deriving (Eq, Show)
+                v
+
+v
+type family G a where
+  v
+  G Int = Bool
+            v
+  G a   = Char
+            v
+
+  v
+data Flobble = Flobble
+                 v
+  deriving (Eq) via (NonNegative (Large Int))
+  v
+  deriving stock (Floo)
+  v
+  deriving anyclass (WibblyWoo, OtherlyWoo)
+  v
+
+v
+newtype Flobby = Flobby
+                   v
+
+v
+foo ::
+    v
+ Wibble -- wibble
+ v
+    -> Wobble -- wobble
+         v
+    -> Wobble -- wobble
+         v
+    -> Wobble -- wobble
+         v
+    -> (wob :: Wobble)
+         v
+    -> (Wobble -- wobble
+          v
+    a b c)
+         v
+
+v
+(foo :: (Wibble Wobble)) foo
+                         v
+
+v
+newtype TestApp
+        v
+   (logger :: TestLogger)
+   v
+   (scribe :: TestScribe)
+   v
+   config
+   v
+   a
+   v
+   = TestApp a
+             v
+
+v
+optionsParser :: Opts.Parser Options
+v
+optionsParser = Options
+                  v
+  <$> (Opts.flag' Alloc (Opts.long "alloc" <> Opts.help "wibble")
+                  v
+       <|> Opts.flag' Entries (Opts.long "entry" <> Opts.help "wobble")
+                      v
+       <|> Opts.flag' Bytes   (Opts.long "bytes" <> Opts.help "i'm a fish"))
+        v
+  <*> optional
+        v
+        (Opts.strArgument
+                v
+          (Opts.metavar "MY-FILE" <>
+                v
+           Opts.help "meh"))
+        v
+
+      v
+type PhantomThing
+     v
+
+v
+type SomeApi =
+  v
+       "thing" :> Capture "bar" Index :> QueryParam "wibble" Text
+               v
+                                               :> QueryParam "wobble" Natural
+                                               v
+                                               :> Header TracingHeader 
TracingId
+                                               v
+                                               :> ThingHeader
+                                               v
+                                               :> Get '[JSON] (The ReadResult)
+                                               v
+  :<|> "thing" :> ReqBody '[JSON] Request
+  v
+                      :> Header TracingHeader TracingId
+                      v
+                      :> SpecialHeader
+                      v
+                      :> Post '[JSON] (The Response)
+                      v
+
+v
+deriving instance FromJSONKey StateName
+v
+deriving anyclass instance FromJSON Base
+v
+deriving newtype instance FromJSON Treble
+         v
+
+v
+foo = bar
+        v
+  where baz = _
+                v
+  -- checking that comments are ignored in layout
+                v
+  -- and that a starting syntax entry is ok
+                v
+        (+) = _
+                v
+
+        v
+test = 1 `shouldBe` 1
+                                      v
\ No newline at end of file