From 1f895ef217a1ef672dbf4896f57e6cab2b425661 Mon Sep 17 00:00:00 2001 From: Chris Smith Date: Tue, 14 Sep 2021 23:20:08 -0400 Subject: [PATCH] Consider all root paths when suggesting module name change. If there are source root dirs nested inside each other, a module might have more than one possible name, depending on where it's intended to be imported from. In this case, a rename should not be suggested unless the module name doesn't match any possible correct name. When suggesting a name, the shortest name should be suggested, since that's more likely to be the intended one. Fixes #1903 --- .../src/Ide/Plugin/ModuleName.hs | 39 +++++++++++-------- plugins/hls-module-name-plugin/test/Main.hs | 5 +++ .../test/testdata/hie.yaml | 1 + .../subdir/TWrongModuleName.expected.hs | 7 ++++ .../test/testdata/subdir/TWrongModuleName.hs | 7 ++++ 5 files changed, 42 insertions(+), 17 deletions(-) create mode 100644 plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.expected.hs create mode 100644 plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.hs diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 48bf577fbf..391e09cf43 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -21,7 +21,7 @@ import Control.Monad.Trans.Maybe import Data.Aeson (Value (Null), toJSON) import Data.Char (isLower) import qualified Data.HashMap.Strict as HashMap -import Data.List (find, intercalate, isPrefixOf) +import Data.List (intercalate, isPrefixOf, minimumBy) import Data.Maybe (maybeToList) import Data.String (IsString) import qualified Data.Text as T @@ -44,6 +44,7 @@ import Language.LSP.VFS (virtualFileText) import System.Directory (canonicalizePath) import System.FilePath (dropExtension, splitDirectories, takeFileName) +import Data.Ord (comparing) -- |Plugin descriptor descriptor :: PluginId -> PluginDescriptor IdeState @@ -97,36 +98,40 @@ action state uri = contents <- lift . getVirtualFile $ toNormalizedUri uri let emptyModule = maybe True (T.null . T.strip . virtualFileText) contents - correctName <- MaybeT . liftIO $ traceAs "correctName" <$> pathModuleName state nfp fp + correctNames <- liftIO $ traceAs "correctNames" <$> pathModuleNames state nfp fp + let bestName = minimumBy (comparing T.length) correctNames statedNameMaybe <- liftIO $ traceAs "statedName" <$> codeModuleName state nfp case statedNameMaybe of Just (nameRange, statedName) - | correctName /= statedName -> - pure $ Replace uri nameRange ("Set module name to " <> correctName) correctName + | statedName `notElem` correctNames -> + pure $ Replace uri nameRange ("Set module name to " <> bestName) bestName Nothing | emptyModule -> - let code = "module " <> correctName <> " where\n" + let code = "module " <> bestName <> " where\n" in pure $ Replace uri (Range (Position 0 0) (Position 0 0)) code code _ -> MaybeT $ pure Nothing --- | The module name, as derived by the position of the module in its source directory -pathModuleName :: IdeState -> NormalizedFilePath -> String -> IO (Maybe T.Text) -pathModuleName state normFilePath filePath - | isLower . head $ takeFileName filePath = return $ Just "Main" +-- | Possible module names, as derived by the position of the module in the +-- source directories. There may be more than one possible name, if the source +-- directories are nested inside each other. +pathModuleNames :: IdeState -> NormalizedFilePath -> String -> IO [T.Text] +pathModuleNames state normFilePath filePath + | isLower . head $ takeFileName filePath = return ["Main"] | otherwise = do session <- runAction "ModuleName.ghcSession" state $ use_ GhcSession normFilePath srcPaths <- evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags paths <- mapM canonicalizePath srcPaths mdlPath <- canonicalizePath filePath - pure $ do - prefix <- find (`isPrefixOf` mdlPath) paths - pure - . T.pack - . intercalate "." - . splitDirectories - . drop (length prefix + 1) - $ dropExtension mdlPath + let prefixes = filter (`isPrefixOf` mdlPath) paths + pure (map (moduleNameFrom mdlPath) prefixes) + where + moduleNameFrom mdlPath prefix = + T.pack + . intercalate "." + . splitDirectories + . drop (length prefix + 1) + $ dropExtension mdlPath -- | The module name, as stated in the module codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, T.Text)) diff --git a/plugins/hls-module-name-plugin/test/Main.hs b/plugins/hls-module-name-plugin/test/Main.hs index 2ee496818f..b6a35af926 100644 --- a/plugins/hls-module-name-plugin/test/Main.hs +++ b/plugins/hls-module-name-plugin/test/Main.hs @@ -32,6 +32,11 @@ tests = [CodeLens { _command = Just c }] <- getCodeLenses doc executeCommand c void $ skipManyTill anyMessage (message SWorkspaceApplyEdit) + + , goldenWithModuleName "Fix wrong module name in nested directory" "subdir/TWrongModuleName" $ \doc -> do + [CodeLens { _command = Just c }] <- getCodeLenses doc + executeCommand c + void $ skipManyTill anyMessage (message SWorkspaceApplyEdit) ] goldenWithModuleName :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree diff --git a/plugins/hls-module-name-plugin/test/testdata/hie.yaml b/plugins/hls-module-name-plugin/test/testdata/hie.yaml index 221ee3dd72..d9e8533d22 100644 --- a/plugins/hls-module-name-plugin/test/testdata/hie.yaml +++ b/plugins/hls-module-name-plugin/test/testdata/hie.yaml @@ -1,6 +1,7 @@ cradle: direct: arguments: + - "-isubdir" - "TEmptyModule" - "TWrongModuleName" - "mainlike" diff --git a/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.expected.hs b/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.expected.hs new file mode 100644 index 0000000000..87fb0f5b10 --- /dev/null +++ b/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.expected.hs @@ -0,0 +1,7 @@ +module TWrongModuleName + ( x + ) +where + +x :: Integer +x = 11 diff --git a/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.hs b/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.hs new file mode 100644 index 0000000000..ede67750f5 --- /dev/null +++ b/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.hs @@ -0,0 +1,7 @@ +module BadName + ( x + ) +where + +x :: Integer +x = 11