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