haskell#3017 Fix CodeAction title, adjust tests

Author: batkot

plugins/hls-class-plugin/README.md

@@ -3,7 +3,8 @@
 The class plugin provides handy operations about class, includes:
 
 1. Code action to add minimal class definition methods.
-2. Type lens about missing type signatures for instance methods.
+2. Code action to all missing class methods.
+3. Type lens about missing type signatures for instance methods.
 
 ## Demo
 

plugins/hls-class-plugin/hls-class-plugin.cabal

@@ -77,3 +77,4 @@ test-suite tests
     , hls-test-utils     ^>=1.4
     , lens
     , lsp-types
+    , text

plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs

@@ -230,13 +230,12 @@ foo range sigs = ("all missing methods", methodGroups)
                         , inRange range (getSrcSpan $ bindName sig)
                        ]
 
-
 -- Return (name text, signature text)
 minDefToMethodGroups :: Range -> [InstanceBindTypeSig] -> BooleanFormula Name -> [Suggestion]
 minDefToMethodGroups range sigs minDef = suggestions
     where
         makeSuggestion methodGroup = 
-            let name = mconcat $ intersperse "," $ fst <$> methodGroup
+            let name = mconcat $ intersperse "," $ (\x -> "'" <> x <> "'") . fst <$> methodGroup
             in  (name, methodGroup)
 
         suggestions = makeSuggestion <$> go minDef

plugins/hls-class-plugin/test/Main.hs

@@ -12,6 +12,7 @@ module Main
 import           Control.Lens            (Prism', prism', (^.), (^..), (^?))
 import           Control.Monad           (void)
 import           Data.Maybe
+import qualified Data.Text               as T
 import qualified Ide.Plugin.Class        as Class
 import qualified Language.LSP.Types.Lens as J
 import           System.FilePath
@@ -31,23 +32,21 @@ tests = testGroup
 codeActionTests :: TestTree
 codeActionTests = testGroup
   "code actions"
-  [ testCase "Produces addMinimalMethodPlaceholders code actions for one instance" $ do
-      runSessionWithServer classPlugin testDataDir $ 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 '==' with signature(s)"
-          , Just "Add placeholders for '/='"
-          , Just "Add placeholders for '/=' with signature(s)"
-          ]
+  [ expectCodeActionsAvailable "Produces addMinimalMethodPlaceholders code actions for one instance" "T1"
+      [ "Add placeholders for '=='"
+      , "Add placeholders for '==' with signature(s)"
+      , "Add placeholders for '/='"
+      , "Add placeholders for '/=' with signature(s)"
+      , "Add placeholders for all missing methods"
+      , "Add placeholders for all missing methods with signature(s)"
+      ]
   , goldenWithClass "Creates a placeholder for '=='" "T1" "eq" $ \(eqAction:_) -> do
       executeCodeAction eqAction
   , goldenWithClass "Creates a placeholder for '/='" "T1" "ne" $ \(_:_:neAction:_) -> do
       executeCodeAction neAction
-  , goldenWithClass "Creates a placeholder for 'fmap'" "T2" "fmap" $ \(_:_:_:_:fmapAction:_) -> do
+  , goldenWithClass "Creates a placeholder for both '==' and '/='" "T1" "all" $ \(_:_:_:_:allMethodsAction:_) -> do
+      executeCodeAction allMethodsAction
+  , goldenWithClass "Creates a placeholder for 'fmap'" "T2" "fmap" $ \(_:_:_:_:_:_:fmapAction:_) -> do
       executeCodeAction fmapAction
   , goldenWithClass "Creates a placeholder for multiple methods 1" "T3" "1" $ \(mmAction:_) -> do
       executeCodeAction mmAction
@@ -70,6 +69,11 @@ codeActionTests = testGroup
       executeCodeAction eqWithSig
   , goldenWithClass "Only insert pragma once" "InsertPragmaOnce" "" $ \(_:multi:_) -> do
       executeCodeAction multi
+  , expectCodeActionsAvailable "No code action available when minimal requirements meet" "MinimalDefinitionMeet" []
+  , expectCodeActionsAvailable "Add placeholders for all missing methods is unavailable when all methods are required" "AllMethodsRequired" 
+      [ "Add placeholders for 'f','g'"
+      , "Add placeholders for 'f','g' with signature(s)"
+      ]
   ]
 
 codeLensTests :: TestTree
@@ -99,7 +103,6 @@ _CACodeAction = prism' InR $ \case
   InR action -> Just action
   _          -> Nothing
 
-
 goldenCodeLens :: TestName -> FilePath -> Int -> TestTree
 goldenCodeLens title path idx =
     goldenWithHaskellDoc classPlugin title testDataDir path "expected" "hs" $ \doc -> do
@@ -115,5 +118,17 @@ goldenWithClass title path desc act =
     act actions
     void $ skipManyTill anyMessage (getDocumentEdit doc)
 
+expectCodeActionsAvailable :: TestName -> FilePath -> [T.Text] -> TestTree
+expectCodeActionsAvailable title path actionTitles = 
+  testCase title $ do
+    runSessionWithServer classPlugin testDataDir $ do 
+      doc <- openDoc (path <.> "hs") "haskell"
+      _ <- waitForDiagnosticsFromSource doc "typecheck"
+      caResults <- getAllCodeActions doc
+      liftIO $ map (^? _CACodeAction . J.title) caResults
+        @?= expectedActions
+    where
+      expectedActions = Just <$> actionTitles
+
 testDataDir :: FilePath
 testDataDir = "test" </> "testdata"

plugins/hls-class-plugin/test/testdata/AllMethodsRequired.hs

@@ -0,0 +1,9 @@
+module AllMethodsRequired where
+
+class Test a where
+  f :: a
+  g :: a
+  {-# MINIMAL f,g #-}
+
+instance Test [a] where
+

plugins/hls-class-plugin/test/testdata/MinimalDefinitionMeet.hs

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

plugins/hls-class-plugin/test/testdata/T1.all.expected.hs

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