diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index cc151c25ff..f307944b73 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -240,7 +240,8 @@ extendImportHandler' ideState ExtendImport {..} extendImport (T.unpack <$> thingParent) (T.unpack newThing) (makeDeltaAst imp) Nothing -> do - let n = newImport importName sym importQual False + let qns = (,) <$> importQual <*> Just (qualifiedImportStyle df) + n = newImport importName sym qns False sym = if isNothing importQual then Just it else Nothing it = case thingParent of Nothing -> newThing @@ -1417,8 +1418,8 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos | otherwise -> [] where moduleText = moduleNameText identInfo -suggestNewImport :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] -suggestNewImport packageExportsMap ps fileContents Diagnostic{_message} +suggestNewImport :: DynFlags -> ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] +suggestNewImport df packageExportsMap ps fileContents Diagnostic{_message} | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg , qual <- extractQualifiedModuleName msg @@ -1430,16 +1431,17 @@ suggestNewImport packageExportsMap ps fileContents Diagnostic{_message} , Just (range, indent) <- newImportInsertRange ps fileContents , extendImportSuggestions <- matchRegexUnifySpaces msg "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" - = let suggestions = nubSortBy simpleCompareImportSuggestion - (constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions) in + = let qis = qualifiedImportStyle df + suggestions = nubSortBy simpleCompareImportSuggestion + (constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions qis) in map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions where L _ HsModule {..} = astA ps -suggestNewImport _ _ _ _ = [] +suggestNewImport _ _ _ _ _ = [] constructNewImportSuggestions - :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [ImportSuggestion] -constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrdBy simpleCompareImportSuggestion + :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> QualifiedImportStyle -> [ImportSuggestion] +constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules qis = nubOrdBy simpleCompareImportSuggestion [ suggestion | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing] -- strip away qualified module names from the unknown name , identInfo <- maybe [] Set.toList $ (lookupOccEnv (getExportsMap exportsMap) (mkVarOrDataOcc name)) <> (lookupOccEnv (getExportsMap exportsMap) (mkTypeOcc name)) -- look up the modified unknown name in the export map @@ -1451,7 +1453,7 @@ constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = renderNewImport :: IdentInfo -> [ImportSuggestion] renderNewImport identInfo | Just q <- qual - = [ImportSuggestion importanceScore (quickFixImportKind "new.qualified") (newQualImport m q)] + = [ImportSuggestion importanceScore (quickFixImportKind "new.qualified") (newQualImport m q qis)] | otherwise = [ImportSuggestion importanceScore (quickFixImportKind' "new" importStyle) (newUnqualImport m (renderImportStyle importStyle) False) | importStyle <- NE.toList $ importStyles identInfo] ++ @@ -1629,10 +1631,10 @@ checkPragma name = check newImport :: T.Text -- ^ module name -> Maybe T.Text -- ^ the symbol - -> Maybe T.Text -- ^ qualified name + -> Maybe (T.Text, QualifiedImportStyle) -- ^ qualified name and style -> Bool -- ^ the symbol is to be imported or hidden -> NewImport -newImport modName mSymbol mQual hiding = NewImport impStmt +newImport modName mSymbol mQualNameStyle hiding = NewImport impStmt where symImp | Just symbol <- mSymbol @@ -1641,14 +1643,18 @@ newImport modName mSymbol mQual hiding = NewImport impStmt | otherwise = "" impStmt = "import " - <> maybe "" (const "qualified ") mQual - <> modName + <> qualifiedModName (snd <$> mQualNameStyle) <> (if hiding then " hiding" else "") <> symImp <> maybe "" (\qual -> if modName == qual then "" else " as " <> qual) mQual + mQual = fst <$> mQualNameStyle + qualifiedModName Nothing = modName + qualifiedModName (Just QualifiedImportPrefix) = "qualified " <> modName + qualifiedModName (Just QualifiedImportPostfix) = modName <> " qualified" -newQualImport :: T.Text -> T.Text -> NewImport -newQualImport modName qual = newImport modName Nothing (Just qual) False + +newQualImport :: T.Text -> T.Text -> QualifiedImportStyle -> NewImport +newQualImport modName qual qis = newImport modName Nothing (Just (qual, qis)) False newUnqualImport :: T.Text -> T.Text -> Bool -> NewImport newUnqualImport modName symbol = newImport modName (Just symbol) Nothing diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/ImportUtils.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/ImportUtils.hs index e192fba98c..7afe7e5bb0 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/ImportUtils.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/ImportUtils.hs @@ -4,11 +4,14 @@ module Development.IDE.Plugin.Plugins.ImportUtils quickFixImportKind, renderImportStyle, unImportStyle, - importStyles + importStyles, + QualifiedImportStyle(..), + qualifiedImportStyle ) where import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.Text as T +import Development.IDE.GHC.Compat import Development.IDE.Plugin.CodeAction.ExactPrint (wildCardSymbol) import Development.IDE.Types.Exports import Language.LSP.Types (CodeActionKind (..)) @@ -83,3 +86,13 @@ quickFixImportKind' x (ImportAllConstructors _) = CodeActionUnknown $ "quickfix. quickFixImportKind :: T.Text -> CodeActionKind quickFixImportKind x = CodeActionUnknown $ "quickfix.import." <> x + +-- | Possible import styles for qualified imports +data QualifiedImportStyle = QualifiedImportPostfix | QualifiedImportPrefix + deriving Show + +qualifiedImportStyle :: DynFlags -> QualifiedImportStyle +qualifiedImportStyle df | hasImportQualifedPostEnabled && hasPrePositiveQualifiedWarning = QualifiedImportPostfix + | otherwise = QualifiedImportPrefix + where hasImportQualifedPostEnabled = xopt ImportQualifiedPost df + hasPrePositiveQualifiedWarning = wopt Opt_WarnPrepositiveQualifiedModule df diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index f1a28821af..475f34da3a 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -27,6 +27,8 @@ tests :: TestTree tests = testGroup "code actions" [ #if hls_refactor importTests + , ignoreInEnv [HostOS Windows, GhcVer GHC94] "Diagnostic failure for Windows-ghc9.4.2" importQualifiedTests + , ignoreInEnv [HostOS Windows, GhcVer GHC94] "Diagnostic failure for Windows-ghc9.4.2" importQualifiedPostTests , packageTests , redundantImportTests , renameTests @@ -80,7 +82,7 @@ renameTests = testGroup "rename suggestions" [ importTests :: TestTree importTests = testGroup "import suggestions" [ - testCase "works with 3.8 code action kinds" $ runSession hlsCommand fullCaps "test/testdata" $ do + testCase "import works with 3.8 code action kinds" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImport.hs" "haskell" -- No Formatting: let config = def { formattingProvider = "none" } @@ -103,6 +105,58 @@ importTests = testGroup "import suggestions" [ liftIO $ contents @?= "import Control.Monad\nmain :: IO ()\nmain = when True $ putStrLn \"hello\"" ] +importQualifiedTests :: TestTree +importQualifiedTests = testGroup "import qualified prefix suggestions" [ + testCase "qualified import works with 3.8 code action kinds" $ runSession hlsCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportQualified.hs" "haskell" + -- No Formatting: + let config = def { formattingProvider = "none" } + sendConfigurationChanged (toJSON config) + + (diag:_) <- waitForDiagnosticsFrom doc + liftIO $ diag ^. L.message @?= "Not in scope: ‘Control.when’\nNo module named ‘Control’ is imported." + + actionsOrCommands <- getAllCodeActions doc + let actns = map fromAction actionsOrCommands + + let importQualifiedSuggestion = "import qualified Control.Monad as Control" + importControlMonadQualified <- liftIO $ inspectCodeAction actionsOrCommands [importQualifiedSuggestion] + liftIO $ do + dontExpectCodeAction actionsOrCommands ["import Control.Monad (when)"] + length actns >= 10 @? "There are some actions" + + executeCodeAction importControlMonadQualified + + contents <- documentContents doc + liftIO $ contents @?= "import qualified Control.Monad as Control\nmain :: IO ()\nmain = Control.when True $ putStrLn \"hello\"\n" + ] + +importQualifiedPostTests :: TestTree +importQualifiedPostTests = testGroup "import qualified postfix suggestions" [ + testCase "qualified import in postfix position works with 3.8 code action kinds" $ runSession hlsCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportPostQualified.hs" "haskell" + -- No Formatting: + let config = def { formattingProvider = "none" } + sendConfigurationChanged (toJSON config) + + (diag:_) <- waitForDiagnosticsFrom doc + liftIO $ diag ^. L.message @?= "Not in scope: ‘Control.when’\nNo module named ‘Control’ is imported." + + actionsOrCommands <- getAllCodeActions doc + let actns = map fromAction actionsOrCommands + + let importQualifiedPostSuggestion = "import Control.Monad qualified as Control" + importControlMonadQualified <- liftIO $ inspectCodeAction actionsOrCommands [importQualifiedPostSuggestion] + liftIO $ do + dontExpectCodeAction actionsOrCommands ["import qualified Control.Monad as Control", "import Control.Monad (when)"] + length actns >= 10 @? "There are some actions" + + executeCodeAction importControlMonadQualified + + contents <- documentContents doc + liftIO $ T.lines contents !! 2 @?= "import Control.Monad qualified as Control" + ] + packageTests :: TestTree packageTests = testGroup "add package suggestions" [ ignoreTestBecause "no support for adding dependent packages via code action" $ testCase "adds to .cabal files" $ do diff --git a/test/testdata/CodeActionImportPostQualified.hs b/test/testdata/CodeActionImportPostQualified.hs new file mode 100644 index 0000000000..1f225e77a5 --- /dev/null +++ b/test/testdata/CodeActionImportPostQualified.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# OPTIONS_GHC -Wprepositive-qualified-module #-} +main :: IO () +main = Control.when True $ putStrLn "hello" diff --git a/test/testdata/CodeActionImportQualified.hs b/test/testdata/CodeActionImportQualified.hs new file mode 100644 index 0000000000..9740fd0aa5 --- /dev/null +++ b/test/testdata/CodeActionImportQualified.hs @@ -0,0 +1,2 @@ +main :: IO () +main = Control.when True $ putStrLn "hello"