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 937f95147a..7535b478ff 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -38,7 +38,6 @@ import Data.Ord (comparing) import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Utf16.Rope as Rope -import Data.Tuple.Extra (fst3) import Development.IDE.Core.Rules import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -87,6 +86,7 @@ import Language.LSP.Types (ApplyWorkspa uriToFilePath) import Language.LSP.VFS (VirtualFile, _file_text) +import qualified Text.Fuzzy.Parallel as TFP import Text.Regex.TDFA (mrAfter, (=~), (=~~)) #if MIN_VERSION_ghc(9,2,0) @@ -99,7 +99,6 @@ import GHC (AddEpAnn (Ad EpaLocation (..), LEpaComment, LocatedA) - #else import Language.Haskell.GHC.ExactPrint.Types (Annotation (annsDP), DeltaPos, @@ -1521,35 +1520,65 @@ 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 ‘([^’]*)’" - = sortOn fst3 [(imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " ")) - | (kind, unNewImport -> imp) <- constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions - ] + = let suggestions = nubSort + (constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions) in + map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions where L _ HsModule {..} = astA ps suggestNewImport _ _ _ _ = [] constructNewImportSuggestions - :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [(CodeActionKind, NewImport)] -constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrdOn snd + :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [ImportSuggestion] +constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrd [ suggestion - | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing] - , identInfo <- maybe [] Set.toList $ Map.lookup name (getExportsMap exportsMap) - , canUseIdent thingMissing identInfo - , moduleNameText identInfo `notElem` fromMaybe [] notTheseModules - , suggestion <- renderNewImport identInfo + | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing] -- strip away qualified module names from the unknown name + , identInfo <- maybe [] Set.toList $ Map.lookup name (getExportsMap exportsMap) -- look up the modified unknown name in the export map + , canUseIdent thingMissing identInfo -- check if the identifier information retrieved can be used + , moduleNameText identInfo `notElem` fromMaybe [] notTheseModules -- check if the module of the identifier is allowed + , suggestion <- renderNewImport identInfo -- creates a list of import suggestions for the retrieved identifier information ] where - renderNewImport :: IdentInfo -> [(CodeActionKind, NewImport)] + renderNewImport :: IdentInfo -> [ImportSuggestion] renderNewImport identInfo | Just q <- qual - = [(quickFixImportKind "new.qualified", newQualImport m q)] + = [ImportSuggestion importanceScore (quickFixImportKind "new.qualified") (newQualImport m q)] | otherwise - = [(quickFixImportKind' "new" importStyle, newUnqualImport m (renderImportStyle importStyle) False) + = [ImportSuggestion importanceScore (quickFixImportKind' "new" importStyle) (newUnqualImport m (renderImportStyle importStyle) False) | importStyle <- NE.toList $ importStyles identInfo] ++ - [(quickFixImportKind "new.all", newImportAll m)] + [ImportSuggestion importanceScore (quickFixImportKind "new.all") (newImportAll m)] where + -- The importance score takes 2 metrics into account. The first being the similarity using + -- the Text.Fuzzy.Parallel.match function. The second is a factor of the relation between + -- the modules prefix import suggestion and the unknown identifier names. + importanceScore + | Just q <- qual + = let + similarityScore = fromIntegral $ unpackMatchScore (TFP.match (T.toLower q) (T.toLower m)) :: Double + (maxLength, minLength) = case (T.length q, T.length m) of + (la, lb) + | la >= lb -> (fromIntegral la, fromIntegral lb) + | otherwise -> (fromIntegral lb, fromIntegral la) + lengthPenaltyFactor = 100 * minLength / maxLength + in max 0 (floor (similarityScore * lengthPenaltyFactor)) + | otherwise + = 0 + where + unpackMatchScore pScore + | Just score <- pScore = score + | otherwise = 0 m = moduleNameText identInfo +-- | Implements a lexicographic order for import suggestions. +-- First compares the importance score in DESCENDING order. +-- If the scores are equal it compares the import names alphabetical order. +data ImportSuggestion = ImportSuggestion !Int !CodeActionKind !NewImport + deriving ( Eq ) + +instance Ord ImportSuggestion where + compare (ImportSuggestion s1 _ i1) (ImportSuggestion s2 _ i2) + | s1 == s2 = compare i1 i2 + | otherwise = flip compare s1 s2 + newtype NewImport = NewImport {unNewImport :: T.Text} deriving (Show, Eq, Ord)