Tests that code actions don't appear when Wingman is enabled

Author: isovector

Diff for: hls-test-utils/src/Test/Hls/Util.hs

@@ -10,6 +10,7 @@ module Test.Hls.Util
   (
       codeActionSupportCaps
     , expectCodeAction
+    , dontExpectCodeAction
     , expectDiagnostic
     , expectNoMoreDiagnostics
     , expectSameLocations
@@ -45,6 +46,7 @@ import           Control.Lens                    ((^.))
 import           Control.Monad
 import           Control.Monad.IO.Class
 import qualified Data.Aeson                      as A
+import           Data.Bool                       (bool)
 import           Data.Default
 import           Data.List                       (intercalate)
 import           Data.List.Extra                 (find)
@@ -315,6 +317,10 @@ fromCommand _             = error "Not a command"
 onMatch :: [a] -> (a -> Bool) -> String -> IO a
 onMatch as predicate err = maybe (fail err) return (find predicate as)
 
+noMatch :: [a] -> (a -> Bool) -> String -> IO ()
+noMatch [] _ _ = pure ()
+noMatch as predicate err = bool (pure ()) (fail err) (any predicate as)
+
 inspectDiagnostic :: [Diagnostic] -> [T.Text] -> IO Diagnostic
 inspectDiagnostic diags s = onMatch diags (\ca -> all (`T.isInfixOf` (ca ^. L.message)) s) err
     where err = "expected diagnostic matching '" ++ show s ++ "' but did not find one"
@@ -331,6 +337,14 @@ inspectCodeAction cars s = fromAction <$> onMatch cars predicate err
 expectCodeAction :: [Command |? CodeAction] -> [T.Text] -> IO ()
 expectCodeAction cars s = void $ inspectCodeAction cars s
 
+dontExpectCodeAction :: [Command |? CodeAction] -> [T.Text] -> IO ()
+dontExpectCodeAction cars s =
+  noMatch cars predicate err
+    where predicate (InR ca) = all (`T.isInfixOf` (ca ^. L.title)) s
+          predicate _        = False
+          err = "expected code action matching '" ++ show s ++ "' but did not find one"
+
+
 inspectCommand :: [Command |? CodeAction] -> [T.Text] -> IO Command
 inspectCommand cars s = fromCommand <$> onMatch cars predicate err
     where predicate (InL command) = all  (`T.isInfixOf` (command ^. L.title)) s

Diff for: test/functional/FunctionalCodeAction.hs

@@ -422,6 +422,15 @@ typedHoleTests = testGroup "typed hole code actions" [
                     , "foo x = maxBound"
                     ]
 
+      , testCase "doesn't work when wingman is active" $
+        runSession hlsCommand fullCaps "test/testdata" $ do
+            doc <- openDoc "TypedHoles.hs" "haskell"
+            _ <- waitForDiagnosticsFromSource doc "typecheck"
+            cas <- getAllCodeActions doc
+            liftIO $ do
+                dontExpectCodeAction cas ["replace _ with minBound"]
+                dontExpectCodeAction cas ["replace _ with foo _"]
+
       , testCase "shows more suggestions" $
             runSession hlsCommand fullCaps "test/testdata" $ do
                 disableWingman
@@ -446,6 +455,16 @@ typedHoleTests = testGroup "typed hole code actions" [
                         , "  where"
                         , "    stuff (A a) = A (a + 1)"
                         ]
+
+      , testCase "doesnt show more suggestions when wingman is active" $
+            runSession hlsCommand fullCaps "test/testdata" $ do
+                doc <- openDoc "TypedHoles2.hs" "haskell"
+                _ <- waitForDiagnosticsFromSource doc "typecheck"
+                cas <- getAllCodeActions doc
+
+                liftIO $ do
+                    dontExpectCodeAction cas ["replace _ with foo2 _"]
+                    dontExpectCodeAction cas ["replace _ with A _"]
     ]
 
 signatureTests :: TestTree