Add tests for class plugin

Author: Ailrun

haskell-language-server.cabal

@@ -405,6 +405,7 @@ test-suite func-test
 
   main-is:            Main.hs
   other-modules:
+    Class
     Command
     Completion
     Config

test/functional/Class.hs

@@ -0,0 +1,73 @@
+{-# LANGUAGE LambdaCase #-}
+-- {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Class
+  ( tests
+  )
+where
+
+import           Control.Lens                    hiding ((<.>))
+import           Control.Monad.IO.Class          (MonadIO(liftIO))
+import qualified Data.ByteString.Lazy            as BS
+import qualified Data.Text.Encoding              as T
+import           Language.Haskell.LSP.Test
+import           Language.Haskell.LSP.Types      hiding (_title, _command)
+import qualified Language.Haskell.LSP.Types.Lens as J
+import           System.FilePath
+import           Test.Hls.Util
+import           Test.Tasty
+import           Test.Tasty.Golden
+import           Test.Tasty.HUnit
+
+tests :: TestTree
+tests = testGroup
+  "class"
+  [ testCase "Produces addMinimalMethodPlaceholders code actions for one instance" $ do
+      runSession hlsCommand fullCaps classPath $ do
+        doc <- openDoc "T1.hs" "haskell"
+        _ <- waitForDiagnosticsFromSource doc "typecheck"
+        caResults <- getAllCodeActions doc
+        liftIO $ map (^? _CACodeAction . J.title) caResults
+          @?=
+          [ Just "Add placeholders for '=='"
+          , Just "Add placeholders for '/='"
+          ]
+  , glodenTest "Creates a placeholder for '=='" "T1" "eq"
+    $ \(eqAction:_) -> do
+      executeCodeAction eqAction
+  , glodenTest "Creates a placeholder for '/='" "T1" "ne"
+    $ \(_:neAction:_) -> do
+      executeCodeAction neAction
+  , glodenTest "Creates a placeholder for 'fmap'" "T2" "fmap"
+    $ \(_:_:fmapAction:_) -> do
+      executeCodeAction fmapAction
+  , glodenTest "Creates a placeholder for multiple methods 1" "T3" "1"
+    $ \(mmAction:_) -> do
+      executeCodeAction mmAction
+  , glodenTest "Creates a placeholder for multiple methods 2" "T3" "2"
+    $ \(_:mmAction:_) -> do
+      executeCodeAction mmAction
+  ]
+
+_CACodeAction :: Prism' CAResult CodeAction
+_CACodeAction = prism' CACodeAction $ \case
+  CACodeAction action -> Just action
+  _                   -> Nothing
+
+classPath :: FilePath
+classPath = "test" </> "testdata" </> "class"
+
+glodenTest :: String -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree
+glodenTest name fp deco execute
+  = goldenVsStringDiff name goldenGitDiff (classPath </> fp <.> deco <.> "expected" <.> "hs")
+    $ runSession hlsCommand fullCaps classPath
+    $ do
+      doc <- openDoc (fp <.> "hs") "haskell"
+      _ <- waitForDiagnosticsFromSource doc "typecheck"
+      actions <- concatMap (^.. _CACodeAction) <$> getAllCodeActions doc
+      execute actions
+      BS.fromStrict . T.encodeUtf8 <$> getDocumentEdit doc
+
+goldenGitDiff :: FilePath -> FilePath -> [String]
+goldenGitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]

test/functional/Main.hs

@@ -1,5 +1,6 @@
 module Main where
 
+import Class
 import Command
 import Completion
 import Config
@@ -36,7 +37,8 @@ main =
         [antXMLRunner, rerunningTests [listingTests, consoleTestReporter]]
         $ testGroup
             "haskell-language-server"
-            [ Command.tests
+            [ Class.tests
+            , Command.tests
             , Completion.tests
             , Config.tests
             , Deferred.tests

test/testdata/class/T1.eq.expected.hs

@@ -0,0 +1,6 @@
+module T1 where
+
+data X = X
+
+instance Eq X where
+  (==) = _

test/testdata/class/T1.hs

@@ -0,0 +1,5 @@
+module T1 where
+
+data X = X
+
+instance Eq X where

test/testdata/class/T1.ne.expected.hs

@@ -0,0 +1,6 @@
+module T1 where
+
+data X = X
+
+instance Eq X where
+  (/=) = _

test/testdata/class/T2.fmap.expected.hs

@@ -0,0 +1,13 @@
+module T2 where
+
+data X a
+  = A a
+  | B
+
+instance
+  (Eq a) => Eq (X a)
+ where
+
+instance
+  Functor X where
+  fmap = _

test/testdata/class/T2.hs

@@ -0,0 +1,12 @@
+module T2 where
+
+data X a
+  = A a
+  | B
+
+instance
+  (Eq a) => Eq (X a)
+ where
+
+instance
+  Functor X

test/testdata/class/T3.1.expected.hs

@@ -0,0 +1,13 @@
+module T3 where
+
+class Test a where
+  f :: a
+  f = h
+  g :: a
+  h :: a
+  h = f
+  {-# MINIMAL f, g | g, h #-}
+
+instance Test [a] where
+  f = _
+  g = _

test/testdata/class/T3.2.expected.hs

@@ -0,0 +1,13 @@
+module T3 where
+
+class Test a where
+  f :: a
+  f = h
+  g :: a
+  h :: a
+  h = f
+  {-# MINIMAL f, g | g, h #-}
+
+instance Test [a] where
+  g = _
+  h = _