Move qualified import tests to hls-refactor-plugin

Author: fendor

haskell-language-server.cabal

@@ -532,7 +532,6 @@ test-suite func-test
     Config
     Format
     FunctionalBadProject
-    FunctionalCodeAction
     HieBios
     Progress
     Test.Hls.Command

hls-test-utils/src/Test/Hls/Util.hs

@@ -25,6 +25,7 @@ module Test.Hls.Util
     , knownBrokenOnWindows
     , knownBrokenForGhcVersions
     , knownBrokenInEnv
+    , knownBrokenInSpecificEnv
     , onlyWorkForGhcVersions
     -- * Extract code actions
     , fromAction
@@ -123,12 +124,18 @@ hostOS
     | isMac = MacOS
     | otherwise = Linux
 
--- | Mark as broken if /any/ of environmental spec mathces the current environment.
+-- | Mark as broken if /any/ of the environmental specs matches the current environment.
 knownBrokenInEnv :: [EnvSpec] -> String -> TestTree -> TestTree
 knownBrokenInEnv envSpecs reason
     | any matchesCurrentEnv envSpecs = expectFailBecause reason
     | otherwise = id
 
+-- | Mark as broken if /all/ environmental specs match the current environment.
+knownBrokenInSpecificEnv :: [EnvSpec] -> String -> TestTree -> TestTree
+knownBrokenInSpecificEnv envSpecs reason
+    | all matchesCurrentEnv envSpecs = expectFailBecause reason
+    | otherwise = id
+
 knownBrokenOnWindows :: String -> TestTree -> TestTree
 knownBrokenOnWindows = knownBrokenInEnv [HostOS Windows]
 

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

@@ -528,21 +528,43 @@ insertImportTests = testGroup "insert import"
       "ModuleDeclAndImports.hs"
       "ModuleDeclAndImports.expected.hs"
       "import Data.Monoid"
+  , importQualifiedTests
+  ]
+
+importQualifiedTests :: TestTree
+importQualifiedTests = testGroup "import qualified prefix suggestions"
+  [ checkImport'
+      "qualified import works with 3.8 code action kinds"
+      "ImportQualified.hs"
+      "ImportQualified.expected.hs"
+      "import qualified Control.Monad as Control"
+      ["import Control.Monad (when)"]
+  , checkImport'
+      "qualified import in postfix position works with 3.8 code action kinds"
+      "ImportPostQualified.hs"
+      "ImportPostQualified.expected.hs"
+      "import Control.Monad qualified as Control"
+      ["import qualified Control.Monad as Control", "import Control.Monad (when)"]
   ]
 
 checkImport :: String -> FilePath -> FilePath -> T.Text -> TestTree
 checkImport testComment originalPath expectedPath action =
+  checkImport' testComment originalPath expectedPath action []
+
+checkImport' :: String -> FilePath -> FilePath -> T.Text -> [T.Text] -> TestTree
+checkImport' testComment originalPath expectedPath action excludedActions =
   testSessionWithExtraFiles "import-placement" testComment $ \dir ->
     check (dir </> originalPath) (dir </> expectedPath) action
   where
     check :: FilePath -> FilePath -> T.Text -> Session ()
     check originalPath expectedPath action = do
       oSrc <- liftIO $ readFileUtf8 originalPath
-      eSrc <- liftIO $  readFileUtf8 expectedPath
+      eSrc <- liftIO $ readFileUtf8 expectedPath
       originalDoc <- createDoc originalPath "haskell" oSrc
       _ <- waitForDiagnostics
       shouldBeDoc <- createDoc expectedPath "haskell" eSrc
       actionsOrCommands <- getAllCodeActions originalDoc
+      for_ excludedActions (\a -> liftIO $ assertNoActionWithTitle a actionsOrCommands)
       chosenAction <- liftIO $ pickActionWithTitle action actionsOrCommands
       executeCodeAction chosenAction
       originalDocAfterAction <- documentContents originalDoc
@@ -3734,6 +3756,21 @@ pickActionWithTitle title actions = do
         , title == actionTitle
         ]
 
+assertNoActionWithTitle :: T.Text -> [Command |? CodeAction] -> IO ()
+assertNoActionWithTitle title actions = do
+  assertBool ("Unexpected code action " <> show title <> " in " <> show titles) (null matches)
+  pure ()
+  where
+    titles =
+        [ actionTitle
+        | InR CodeAction { _title = actionTitle } <- actions
+        ]
+    matches =
+        [ action
+        | InR action@CodeAction { _title = actionTitle } <- actions
+        , title == actionTitle
+        ]
+
 findCodeActions :: TextDocumentIdentifier -> Range -> [T.Text] -> Session [CodeAction]
 findCodeActions = findCodeActions' (==) "is not a superset of"
 

plugins/hls-refactor-plugin/test/data/import-placement/ImportPostQualified.expected.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# OPTIONS_GHC -Wprepositive-qualified-module #-}
+import Control.Monad qualified as Control
+main :: IO ()
+main = Control.when True $ putStrLn "hello"

test/testdata/CodeActionImportPostQualified.hs renamed to plugins/hls-refactor-plugin/test/data/import-placement/ImportPostQualified.hs

@@ -0,0 +1,3 @@
+import qualified Control.Monad as Control
+main :: IO ()
+main = Control.when True $ putStrLn "hello"

plugins/hls-refactor-plugin/test/data/import-placement/ImportQualified.expected.hs

@@ -3,7 +3,6 @@ module Main where
 import           Config
 import           Format
 import           FunctionalBadProject
-import           FunctionalCodeAction
 import           HieBios
 import           Progress
 import           Test.Hls
@@ -13,7 +12,6 @@ main = defaultTestRunner $ testGroup "haskell-language-server"
     [ Config.tests
     , ignoreInEnv [HostOS Windows, GhcVer GHC90, GhcVer GHC92] "Tests gets stuck in ci" $ Format.tests
     , FunctionalBadProject.tests
-    , FunctionalCodeAction.tests
     , HieBios.tests
     , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Tests gets stuck in ci" $ Progress.tests
     ]

test/testdata/CodeActionImportQualified.hs renamed to plugins/hls-refactor-plugin/test/data/import-placement/ImportQualified.hs

@@ -18,7 +18,6 @@ import           Data.Text                          (Text, pack)
 import           Ide.Types
 import           Language.LSP.Protocol.Capabilities
 import qualified Language.LSP.Protocol.Lens         as L
-import           System.FilePath                    ((</>))
 import           Test.Hls
 import           Test.Hls.Command
 import           Test.Hls.Flags
@@ -29,10 +28,10 @@ tests =
     testGroup
         "window/workDoneProgress"
         [ testCase "sends indefinite progress notifications" $
-            runSession hlsCommand progressCaps "test/testdata" $ do
-                let path = "diagnostics" </> "Foo.hs"
+            runSession hlsCommand progressCaps "test/testdata/diagnostics" $ do
+                let path = "Foo.hs"
                 _ <- openDoc path "haskell"
-                expectProgressMessages [pack ("Setting up testdata (for " ++ path ++ ")"), "Processing", "Indexing"] []
+                expectProgressMessages [pack ("Setting up diagnostics (for " ++ path ++ ")"), "Processing", "Indexing"] []
         , requiresEvalPlugin $ testCase "eval plugin sends progress reports" $
             runSession hlsCommand progressCaps "plugins/hls-eval-plugin/test/testdata" $ do
               doc <- openDoc "T1.hs" "haskell"

test/functional/FunctionalCodeAction.hs

@@ -0,0 +1,5 @@
+cradle:
+  direct:
+    arguments:
+    - Foo
+    - -Wmissing-signatures

test/functional/Main.hs

@@ -0,0 +1,4 @@
+cradle:
+  direct:
+    arguments:
+    - Format