diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index 18f4c35dee..8ebd25c8c4 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -34,7 +34,7 @@ jobs: "hls-class-plugin", "hls-eval-plugin", "hls-explicit-imports-plugin", "hls-haddock-comments-plugin", "hls-hlint-plugin", "hls-stan-plugin", "hls-module-name-plugin", "hls-pragmas-plugin", - "hls-refine-imports-plugin", "hls-rename-plugin", "hls-retrie-plugin", + "hls-rename-plugin", "hls-retrie-plugin", "hls-splice-plugin", "hls-tactics-plugin", "hls-call-hierarchy-plugin", "hls-alternate-number-format-plugin", "hls-qualify-imported-names-plugin", "hls-code-range-plugin", diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 1b0eb530e0..7348d914fd 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -179,10 +179,6 @@ jobs: name: Test hls-tactics-plugin test suite run: cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || cabal test hls-tactics-plugin --test-options="$TEST_OPTS" - - if: matrix.test - name: Test hls-refine-imports-plugin test suite - run: cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" - - if: matrix.test name: Test hls-explicit-imports-plugin test suite run: cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" diff --git a/CODEOWNERS b/CODEOWNERS index 9599cba755..747b0cd140 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -23,7 +23,6 @@ /plugins/hls-ormolu-plugin @georgefst /plugins/hls-pragmas-plugin @berberman @Ailrun @eddiemundo /plugins/hls-qualify-imported-names-plugin @eddiemundo -/plugins/hls-refine-imports-plugin /plugins/hls-rename-plugin @OliverMadine /plugins/hls-refactor-plugin @santiweight /plugins/hls-retrie-plugin @pepeiborra diff --git a/bench/config.yaml b/bench/config.yaml index 08811a58d0..411406fa99 100644 --- a/bench/config.yaml +++ b/bench/config.yaml @@ -140,7 +140,6 @@ configurations: - ormolu - pragmas - qualifyImportedNames - - refineImports - rename - stylish-haskell # - alternateNumberFormat @@ -168,7 +167,6 @@ configurations: # # - ormolu # - pragmas # - qualifyImportedNames -# - refineImports # - rename # - retrie # - splice diff --git a/cabal.project b/cabal.project index 2dc12eb573..49f7578adb 100644 --- a/cabal.project +++ b/cabal.project @@ -16,7 +16,6 @@ packages: ./plugins/hls-class-plugin ./plugins/hls-eval-plugin ./plugins/hls-explicit-imports-plugin - ./plugins/hls-refine-imports-plugin ./plugins/hls-hlint-plugin ./plugins/hls-rename-plugin ./plugins/hls-retrie-plugin diff --git a/docs/configuration.md b/docs/configuration.md index 8fbd4e661c..1a74d688f2 100644 --- a/docs/configuration.md +++ b/docs/configuration.md @@ -50,7 +50,7 @@ Here is a list of the additional settings currently supported by `haskell-langua Plugins have a generic config to control their behaviour. The schema of such config is: - `haskell.plugin.${pluginName}.globalOn`: usually with default true. Whether the plugin is enabled at runtime or it is not. That is the option you might use if you want to disable completely a plugin. - - Actual plugin names are: `ghcide-code-actions-fill-holes`, `ghcide-completions`, `ghcide-hover-and-symbols`, `ghcide-type-lenses`, `ghcide-code-actions-type-signatures`, `ghcide-code-actions-bindings`, `ghcide-code-actions-imports-exports`, `eval`, `moduleName`, `pragmas`, `refineImports`, `importLens`, `class`, `tactics` (aka wingman), `hlint`, `haddockComments`, `retrie`, `rename`, `splice`, `stan`. + - Actual plugin names are: `ghcide-code-actions-fill-holes`, `ghcide-completions`, `ghcide-hover-and-symbols`, `ghcide-type-lenses`, `ghcide-code-actions-type-signatures`, `ghcide-code-actions-bindings`, `ghcide-code-actions-imports-exports`, `eval`, `moduleName`, `pragmas`, `importLens`, `class`, `tactics` (aka wingman), `hlint`, `haddockComments`, `retrie`, `rename`, `splice`, `stan`. - So to disable the import lens with an explicit list of module definitions you could set `haskell.plugin.importLens.globalOn: false` - `haskell.plugin.${pluginName}.${lspCapability}On`: usually with default true. Whether a concrete plugin capability is enabled. - Capabilities are the different ways a lsp server can interact with the editor. The current available capabilities of the server are: `callHierarchy`, `codeActions`, `codeLens`, `diagnostics`, `hover`, `symbols`, `completion`, `rename`. diff --git a/docs/features.md b/docs/features.md index e15853a9ae..1b26dff066 100644 --- a/docs/features.md +++ b/docs/features.md @@ -180,6 +180,14 @@ Code action kind: `quickfix.literals.style` Make import lists fully explicit (same as the code lens). +### Refine import + +Provided by: `hls-explicit-imports-plugin` + +Code action kind: `quickfix.import.refine` + +Refines imports to more specific modules when names are re-exported (same as the code lens). + ### Qualify imported names Provided by: `hls-qualify-imported-names-plugin` @@ -192,14 +200,6 @@ Rewrites imported names to be qualified. For usage see the ![readme](../plugins/hls-qualify-imported-names-plugin/README.md). -### Refine import - -Provided by: `hls-refine-imports-plugin` - -Code action kind: `quickfix.import.refine` - -Refines imports to more specific modules when names are re-exported (same as the code lens). - ### Add missing class methods Provided by: `hls-class-plugin` @@ -354,7 +354,7 @@ Shows fully explicit import lists and rewrites them with a click (same as the co ### Refine import code lens -Provided by: `hls-refine-imports-plugin` +Provided by: `hls-explicit-imports-plugin` Shows refined imports and applies them with a click (same as the code action). diff --git a/docs/support/plugin-support.md b/docs/support/plugin-support.md index 9c14577afc..2c9477cd22 100644 --- a/docs/support/plugin-support.md +++ b/docs/support/plugin-support.md @@ -59,7 +59,6 @@ For example, a plugin to provide a formatter which has itself been abandoned has | `hls-qualify-imported-names-plugin` | 2 | | | `hls-ormolu-plugin` | 2 | | | `hls-rename-plugin` | 2 | | -| `hls-refine-imports-plugin` | 2 | | | `hls-stylish-haskell-plugin` | 2 | | | `hls-tactics-plugin` | 2 | 9.2, 9.4, 9.6 | | `hls-overloaded-record-dot-plugin` | 2 | 8.10, 9.0 | diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 3afbe687fd..068874f9e8 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -94,11 +94,6 @@ flag importLens default: True manual: True -flag refineImports - description: Enable refineImports plugin - default: True - manual: True - flag rename description: Enable rename plugin default: True @@ -251,11 +246,6 @@ common importLens build-depends: hls-explicit-imports-plugin == 2.1.0.0 cpp-options: -Dhls_importLens -common refineImports - if flag(refineImports) - build-depends: hls-refine-imports-plugin == 2.1.0.0 - cpp-options: -Dhls_refineImports - common rename if flag(rename) build-depends: hls-rename-plugin == 2.1.0.0 @@ -377,7 +367,6 @@ library , haddockComments , eval , importLens - , refineImports , rename , retrie , tactic diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 944154a41f..dc8517fd92 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -12,8 +12,6 @@ module Ide.Plugin.ExplicitImports ( descriptor , descriptorForModules - , extractMinimalImports - , within , abbreviateImportTitle , Log(..) ) where @@ -31,6 +29,8 @@ import qualified Data.IntMap as IM (IntMap, elems, fromList, (!?)) import Data.IORef (readIORef) import qualified Data.Map.Strict as Map +import Data.Maybe (mapMaybe) +import qualified Data.Set as S import Data.String (fromString) import qualified Data.Text as T import Data.Traversable (for) @@ -57,6 +57,10 @@ import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Language.LSP.Server +-- This plugin is named explicit-imports for historical reasons. Besides +-- providing code actions and lenses to make imports explicit it also provides +-- code actions and lens to refine imports. + importCommandId :: CommandId importCommandId = "ImportLensCommand" @@ -103,7 +107,7 @@ descriptorForModules recorder modFilter plId = } -- | The actual command handler -runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState EIResolveData +runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IAResolveData runImportCommand recorder ideState eird@(ResolveOne _ _) = do wedit <- resolveWTextEdit ideState eird _ <- lift $ sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) logErrors @@ -112,65 +116,88 @@ runImportCommand recorder ideState eird@(ResolveOne _ _) = do logWith recorder Error (LogWAEResponseError re) pure () logErrors (Right _) = pure () -runImportCommand _ _ (ResolveAll _) = do - throwError $ PluginInvalidParams "Unexpected argument for command handler: ResolveAll" +runImportCommand _ _ rd = do + throwError $ PluginInvalidParams (T.pack $ "Unexpected argument for command handler:" <> show rd) --- | For every implicit import statement, return a code lens of the corresponding explicit import --- Example - for the module below: --- + +-- | We provide two code lenses for imports. The first lens makes imports +-- explicit. For example, for the module below: -- > import Data.List --- > -- > f = intercalate " " . sortBy length --- -- the provider should produce one code lens associated to the import statement: --- -- > import Data.List (intercalate, sortBy) +-- +-- The second one allows us to import functions directly from the original +-- module. For example, for the following import +-- > import Random.ReExporting.Module (liftIO) +-- the provider should produce one code lens associated to the import statement: +-- > Refine imports to import Control.Monad.IO.Class (liftIO) lensProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}} = do nfp <- getNormalizedFilePathE _uri - mbMinImports <- liftIO $ runAction "MinimalImports" state $ use MinimalImports nfp - case mbMinImports of - Just (MinimalImportsResult{forLens}) -> do - let lens = [ generateLens _uri range int - | (range, int) <- forLens] - pure $ InL lens - _ -> - pure $ InL [] - where generateLens :: Uri -> Range -> Int -> CodeLens + (ImportActionsResult{forLens}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp + let lens = [ generateLens _uri newRange int + | (range, int) <- forLens + , Just newRange <- [toCurrentRange pm range]] + pure $ InL lens + where -- because these are non resolved lenses we only need the range and a + -- unique id to later resolve them with. These are for both refine + -- import lenses and for explicit import lenses. + generateLens :: Uri -> Range -> Int -> CodeLens generateLens uri range int = CodeLens { _data_ = Just $ A.toJSON $ ResolveOne uri int , _range = range , _command = Nothing } -lensResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState EIResolveData 'Method_CodeLensResolve +lensResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeLensResolve lensResolveProvider _ ideState plId cl uri rd@(ResolveOne _ uid) = do nfp <- getNormalizedFilePathE uri - (MinimalImportsResult{forResolve}) <- runActionE "MinimalImports" ideState $ useE MinimalImports nfp + (ImportActionsResult{forResolve}, _) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp target <- handleMaybe PluginStaleResolve $ forResolve IM.!? uid let updatedCodeLens = cl & L.command ?~ mkCommand plId target pure updatedCodeLens - where mkCommand :: PluginId -> TextEdit -> Command - mkCommand pId TextEdit{_newText} = - let title = abbreviateImportTitle _newText - in mkLspCommand pId importCommandId title (Just $ [A.toJSON rd]) -lensResolveProvider _ _ _ _ _ (ResolveAll _) = do - throwError $ PluginInvalidParams "Unexpected argument for lens resolve handler: ResolveAll" - --- | If there are any implicit imports, provide both one code action per import --- to make that specific import explicit, and one code action to turn them all --- into explicit imports. + where mkCommand :: PluginId -> ImportEdit -> Command + mkCommand pId (ImportEdit{ieResType, ieText}) = + let -- The only new thing we need to provide to resolve a lens is the + -- title, as the unique Id is the same to resolve the lens title + -- as it is to apply the lens through a command. + -- The title is written differently depending on what type of lens + -- it is. + title ExplicitImport = abbreviateImportTitle ieText + title RefineImport = "Refine imports to " <> T.intercalate ", " (T.lines ieText) + in mkLspCommand pId importCommandId (title ieResType) (Just [A.toJSON rd]) +lensResolveProvider _ _ _ _ _ rd = do + throwError $ PluginInvalidParams (T.pack $ "Unexpected argument for lens resolve handler: " <> show rd) + +-- |For explicit imports: If there are any implicit imports, provide both one +-- code action per import to make that specific import explicit, and one code +-- action to turn them all into explicit imports. For refine imports: If there +-- are any reexported imports, provide both one code action per import to refine +-- that specific import, and one code action to refine all imports. codeActionProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeActionProvider _ ideState _pId (CodeActionParams _ _ TextDocumentIdentifier {_uri} range _context) = do nfp <- getNormalizedFilePathE _uri - (MinimalImportsResult{forCodeActions}) <- - runActionE "MinimalImports" ideState $ useE MinimalImports nfp - let relevantCodeActions = filterByRange range forCodeActions + (ImportActionsResult{forCodeActions}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp + newRange <- toCurrentRangeE pm range + let relevantCodeActions = filterByRange newRange forCodeActions allExplicit = - [InR $ mkCodeAction "Make all imports explicit" (Just $ A.toJSON $ ResolveAll _uri) - | not $ null relevantCodeActions ] - toCodeAction uri (_, int) = + [InR $ mkCodeAction "Make all imports explicit" (Just $ A.toJSON $ ExplicitAll _uri) + -- We should only provide this code action if there are any code + -- of this type + | any (\x -> iaResType x == ExplicitImport) relevantCodeActions] + allRefine = + [InR $ mkCodeAction "Refine all imports" (Just $ A.toJSON $ RefineAll _uri) + -- We should only provide this code action if there are any code + -- of this type + | any (\x -> iaResType x == RefineImport) relevantCodeActions] + -- The only thing different in making the two types of code actions, is + -- the title. The actual resolve data type, ResolveOne is used by both + -- of them + toCodeAction uri (ImportAction _ int ExplicitImport) = mkCodeAction "Make this import explicit" (Just $ A.toJSON $ ResolveOne uri int) - pure $ InL ((InR . toCodeAction _uri <$> relevantCodeActions) <> allExplicit) + toCodeAction uri (ImportAction _ int RefineImport) = + mkCodeAction "Refine this import" (Just $ A.toJSON $ ResolveOne uri int) + pure $ InL ((InR . toCodeAction _uri <$> relevantCodeActions) <> allExplicit <> allRefine) where mkCodeAction title data_ = CodeAction { _title = title @@ -182,42 +209,52 @@ codeActionProvider _ ideState _pId (CodeActionParams _ _ TextDocumentIdentifier , _disabled = Nothing , _data_ = data_} -codeActionResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState EIResolveData 'Method_CodeActionResolve +codeActionResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeActionResolve codeActionResolveProvider _ ideState _ ca _ rd = do wedit <- resolveWTextEdit ideState rd pure $ ca & L.edit ?~ wedit -------------------------------------------------------------------------------- -resolveWTextEdit :: IdeState -> EIResolveData -> ExceptT PluginError (LspT Config IO) WorkspaceEdit +resolveWTextEdit :: IdeState -> IAResolveData -> ExceptT PluginError (LspT Config IO) WorkspaceEdit +-- Providing the edit for the command, or the resolve for the code action is +-- completely generic, as all we need is the unique id and the text edit. resolveWTextEdit ideState (ResolveOne uri int) = do nfp <- getNormalizedFilePathE uri - (MinimalImportsResult{forResolve}) <- - runActionE "MinimalImports" ideState $ useE MinimalImports nfp - tedit <- handleMaybe PluginStaleResolve $ forResolve IM.!? int - pure $ mkWorkspaceEdit uri [tedit] -resolveWTextEdit ideState (ResolveAll uri) = do + (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp + iEdit <- handleMaybe PluginStaleResolve $ forResolve IM.!? int + pure $ mkWorkspaceEdit uri [iEdit] pm +resolveWTextEdit ideState (ExplicitAll uri) = do + nfp <- getNormalizedFilePathE uri + (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp + let edits = [ ie | ie@ImportEdit{ieResType = ExplicitImport} <- IM.elems forResolve] + pure $ mkWorkspaceEdit uri edits pm +resolveWTextEdit ideState (RefineAll uri) = do nfp <- getNormalizedFilePathE uri - (MinimalImportsResult{forResolve}) <- - runActionE "MinimalImports" ideState $ useE MinimalImports nfp - let edits = IM.elems forResolve - pure $ mkWorkspaceEdit uri edits - -mkWorkspaceEdit :: Uri -> [TextEdit] -> WorkspaceEdit -mkWorkspaceEdit uri edits = - WorkspaceEdit {_changes = Just $ Map.fromList [(uri, edits)] + (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp + let edits = [ re | re@ImportEdit{ieResType = RefineImport} <- IM.elems forResolve] + pure $ mkWorkspaceEdit uri edits pm +mkWorkspaceEdit :: Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit +mkWorkspaceEdit uri edits pm = + WorkspaceEdit {_changes = Just $ Map.fromList [(uri, mapMaybe toWEdit edits)] , _documentChanges = Nothing , _changeAnnotations = Nothing} + where toWEdit ImportEdit{ieRange, ieText} = + let newRange = toCurrentRange pm ieRange + in (\r -> TextEdit r ieText) <$> newRange -data MinimalImports = MinimalImports +data ImportActions = ImportActions deriving (Show, Generic, Eq, Ord) -instance Hashable MinimalImports +instance Hashable ImportActions + +instance NFData ImportActions -instance NFData MinimalImports +type instance RuleResult ImportActions = ImportActionsResult -type instance RuleResult MinimalImports = MinimalImportsResult +data ResultType = ExplicitImport | RefineImport + deriving Eq -data MinimalImportsResult = MinimalImportsResult +data ImportActionsResult = ImportActionsResult { -- |For providing the code lenses we need to have a range, and a unique id -- that is later resolved to the new text for each import. It is stored in -- a list, because we always need to provide all the code lens in a file. @@ -226,21 +263,32 @@ data MinimalImportsResult = MinimalImportsResult -- we store it in a RangeMap, because that allows us to filter on a specific -- range with better performance, and code actions are almost always only -- requested for a specific range - , forCodeActions :: RM.RangeMap (Range, Int) + , forCodeActions :: RM.RangeMap ImportAction -- |For resolve we have an intMap where for every previously provided unique id -- we provide a textEdit to allow our code actions or code lens to be resolved - , forResolve :: IM.IntMap TextEdit } + , forResolve :: IM.IntMap ImportEdit } -instance Show MinimalImportsResult where show _ = "" +-- |For resolving code lenses and code actions we need standard text edit stuff, +-- such as range and text, and then we need the result type, because we use this +-- for code lenses which need to create a appropriate title +data ImportEdit = ImportEdit { ieRange :: Range, ieText :: T.Text, ieResType :: ResultType} -instance NFData MinimalImportsResult where rnf = rwhnf +-- |The necessary data for providing code actions: the range, a unique ID for +-- later resolving the action, and the type of action for giving a proper name. +data ImportAction = ImportAction { iaRange :: Range, iaUniqueId :: Int, iaResType :: ResultType} -data EIResolveData = ResolveOne +instance Show ImportActionsResult where show _ = "" + +instance NFData ImportActionsResult where rnf = rwhnf + +data IAResolveData = ResolveOne { uri :: Uri , importId :: Int } - | ResolveAll + | ExplicitAll + { uri :: Uri } + | RefineAll { uri :: Uri } - deriving (Generic, A.ToJSON, FromJSON) + deriving (Generic, Show, A.ToJSON, FromJSON) exportedModuleStrings :: ParsedModule -> [String] exportedModuleStrings ParsedModule{pm_parsed_source = L _ HsModule{..}} @@ -250,20 +298,33 @@ exportedModuleStrings ParsedModule{pm_parsed_source = L _ HsModule{..}} exportedModuleStrings _ = [] minimalImportsRule :: Recorder (WithPriority Log) -> (ModuleName -> Bool) -> Rules () -minimalImportsRule recorder modFilter = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \MinimalImports nfp -> runMaybeT $ do +minimalImportsRule recorder modFilter = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \ImportActions nfp -> runMaybeT $ do -- Get the typechecking artifacts from the module - (tmr, tmrpm) <- MaybeT $ useWithStale TypeCheck nfp + tmr <- MaybeT $ use TypeCheck nfp -- We also need a GHC session with all the dependencies - (hsc, _) <- MaybeT $ useWithStale GhcSessionDeps nfp + hsc <- MaybeT $ use GhcSessionDeps nfp + + -- refine imports: 2 layer map ModuleName -> ModuleName -> [Avails] (exports) + import2Map <- do + -- first layer is from current(editing) module to its imports + ImportMap currIm <- MaybeT $ use GetImportMap nfp + for currIm $ \path -> do + -- second layer is from the imports of first layer to their imports + ImportMap importIm <- MaybeT $ use GetImportMap path + for importIm $ \imp_path -> do + imp_hir <- MaybeT $ use GetModIface imp_path + return $ mi_exports $ hirModIface imp_hir + -- Use the GHC api to extract the "minimal" imports (imports, mbMinImports) <- MaybeT $ liftIO $ extractMinimalImports hsc tmr + let importsMap = Map.fromList [ (realSrcSpanStart l, printOutputable i) | L (locA -> RealSrcSpan l _) i <- mbMinImports ] - res = - [ (newRange, minImport) + minimalImportsResult = + [ (range, (minImport, ExplicitImport)) | imp@(L _ impDecl) <- imports , not (isQualifiedImport impDecl) , not (isExplicitImport impDecl) @@ -272,16 +333,36 @@ minimalImportsRule recorder modFilter = defineNoDiagnostics (cmapWithPrio LogSha , RealSrcSpan location _ <- [getLoc imp] , let range = realSrcSpanToRange location , Just minImport <- [Map.lookup (realSrcSpanStart location) importsMap] - , Just newRange <- [toCurrentRange tmrpm range] ] - uniqueAndRangeAndText <- liftIO $ for res $ \rt -> do + refineImportsResult = + [ (range, (T.intercalate "\n" + . map (printOutputable . constructImport i) + . Map.toList + $ filteredInnerImports, RefineImport)) + -- for every minimal imports + | minImports <- [mbMinImports] + , i@(L _ ImportDecl{ideclName = L _ mn}) <- minImports + -- (almost) no one wants to see an refine import list for Prelude + , mn /= moduleName pRELUDE + -- we check for the inner imports + , Just innerImports <- [Map.lookup mn import2Map] + -- and only get those symbols used + , Just filteredInnerImports <- [filterByImport i innerImports] + -- if no symbols from this modules then don't need to generate new import + , not $ null filteredInnerImports + -- get the location + , RealSrcSpan location _ <- [getLoc i] + -- and then convert that to a Range + , let range = realSrcSpanToRange location + ] + uniqueAndRangeAndText <- liftIO $ for (minimalImportsResult ++ refineImportsResult) $ \rt -> do u <- U.hashUnique <$> U.newUnique pure (u, rt) - let rangeAndUnique = [ (r, u) | (u, (r, _)) <- uniqueAndRangeAndText ] - pure MinimalImportsResult - { forLens = rangeAndUnique - , forCodeActions = RM.fromList fst rangeAndUnique - , forResolve = IM.fromList ((\(i, (r, t)) -> (i, TextEdit r t)) <$> uniqueAndRangeAndText) } + let rangeAndUnique = [ ImportAction r u rt | (u, (r, (_, rt))) <- uniqueAndRangeAndText ] + pure ImportActionsResult + { forLens = (\ImportAction{..} -> (iaRange, iaUniqueId)) <$> rangeAndUnique + , forCodeActions = RM.fromList iaRange rangeAndUnique + , forResolve = IM.fromList ((\(u, (r, (te, ty))) -> (u, ImportEdit r te ty)) <$> uniqueAndRangeAndText) } -------------------------------------------------------------------------------- @@ -372,6 +453,49 @@ abbreviateImportTitle input = -------------------------------------------------------------------------------- -within :: Range -> SrcSpan -> Bool -within (Range start end) srcSpan = - isInsideSrcSpan start srcSpan || isInsideSrcSpan end srcSpan + +filterByImport :: LImportDecl GhcRn -> Map.Map ModuleName [AvailInfo] -> Maybe (Map.Map ModuleName [AvailInfo]) +#if MIN_VERSION_ghc(9,5,0) +filterByImport (L _ ImportDecl{ideclImportList = Just (_, L _ names)}) +#else +filterByImport (L _ ImportDecl{ideclHiding = Just (_, L _ names)}) +#endif + avails = + -- if there is a function defined in the current module and is used + -- i.e. if a function is not reexported but defined in current + -- module then this import cannot be refined + if importedNames `S.isSubsetOf` allFilteredAvailsNames + then Just res + else Nothing + where importedNames = S.fromList $ map (ieName . unLoc) names + res = flip Map.filter avails $ \a -> + any (`S.member` importedNames) + $ concatMap availNamesWithSelectors a + allFilteredAvailsNames = S.fromList + $ concatMap availNamesWithSelectors + $ mconcat + $ Map.elems res +filterByImport _ _ = Nothing + +constructImport :: LImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> LImportDecl GhcRn +#if MIN_VERSION_ghc(9,5,0) +constructImport (L lim imd@ImportDecl {ideclName = L _ _, ideclImportList = Just (hiding, L _ names)}) +#else +constructImport (L lim imd@ImportDecl{ideclName = L _ _, ideclHiding = Just (hiding, L _ names)}) +#endif + (newModuleName, avails) = L lim imd + { ideclName = noLocA newModuleName +#if MIN_VERSION_ghc(9,5,0) + , ideclImportList = Just (hiding, noLocA newNames) +#else + , ideclHiding = Just (hiding, noLocA newNames) +#endif + } + where newNames = filter (\n -> any (n `containsAvail`) avails) names + -- Check if a name is exposed by AvailInfo (the available information of a module) + containsAvail :: LIE GhcRn -> AvailInfo -> Bool + containsAvail name avail = + any (\an -> printOutputable an == (printOutputable . ieName . unLoc $ name)) + $ availNamesWithSelectors avail + +constructImport lim _ = lim diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index d787630b7f..8cab24d707 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -15,6 +15,7 @@ import Data.Foldable (find) import Data.Row ((.+), (.==)) import Data.Text (Text) import qualified Data.Text as T +import Data.Traversable (for) import qualified Ide.Plugin.ExplicitImports as ExplicitImports import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message @@ -25,24 +26,29 @@ explicitImportsPlugin :: PluginTestDescriptor ExplicitImports.Log explicitImportsPlugin = mkPluginTestDescriptor ExplicitImports.descriptor "explicitImports" main :: IO () -main = defaultTestRunner $ +main = defaultTestRunner $ testGroup "import-actions" + [testGroup + "Refine Imports" + [ codeActionGoldenTest "RefineWithOverride" 3 1 + , codeLensGoldenTest isRefineImports "RefineUsualCase" 1 + ], testGroup "Make imports explicit" - [ codeActionAllGoldenTest "UsualCase" 3 0 - , codeActionAllResolveGoldenTest "UsualCase" 3 0 - , codeActionOnlyGoldenTest "OnlyThis" 3 0 - , codeActionOnlyResolveGoldenTest "OnlyThis" 3 0 - , codeLensGoldenTest "UsualCase" 0 - , codeActionBreakFile "BreakFile" 4 0 - , codeActionStaleAction "StaleAction" 4 0 + [ codeActionAllGoldenTest "ExplicitUsualCase" 3 0 + , codeActionAllResolveGoldenTest "ExplicitUsualCase" 3 0 + , codeActionOnlyGoldenTest "ExplicitOnlyThis" 3 0 + , codeActionOnlyResolveGoldenTest "ExplicitOnlyThis" 3 0 + , codeLensGoldenTest notRefineImports "ExplicitUsualCase" 0 + , codeActionBreakFile "ExplicitBreakFile" 4 0 + , codeActionStaleAction "ExplicitStaleAction" 4 0 , testCase "No CodeAction when exported" $ runSessionWithServer explicitImportsPlugin testDataDir $ do - doc <- openDoc "Exported.hs" "haskell" + doc <- openDoc "ExplicitExported.hs" "haskell" action <- getCodeActions doc (pointRange 3 0) liftIO $ action @?= [] , testCase "No CodeLens when exported" $ runSessionWithServer explicitImportsPlugin testDataDir $ do - doc <- openDoc "Exported.hs" "haskell" + doc <- openDoc "ExplicitExported.hs" "haskell" lenses <- getCodeLenses doc liftIO $ lenses @?= [] , testGroup "Title abbreviation" @@ -68,31 +74,31 @@ main = defaultTestRunner $ o = "import " <> T.replicate 80 "F" <> " (Athing, Bthing, ... (3 items))" in ExplicitImports.abbreviateImportTitle i @?= o ] - ] + ]] -- code action tests codeActionAllGoldenTest :: FilePath -> Int -> Int -> TestTree -codeActionAllGoldenTest fp l c = goldenWithExplicitImports " code action" fp codeActionNoResolveCaps $ \doc -> do +codeActionAllGoldenTest fp l c = goldenWithImportActions " code action" fp codeActionNoResolveCaps $ \doc -> do actions <- getCodeActions doc (pointRange l c) case find ((== Just "Make all imports explicit") . caTitle) actions of Just (InR x) -> executeCodeAction x _ -> liftIO $ assertFailure "Unable to find CodeAction" codeActionBreakFile :: FilePath -> Int -> Int -> TestTree -codeActionBreakFile fp l c = goldenWithExplicitImports " code action" fp codeActionNoResolveCaps $ \doc -> do - _ <- waitForDiagnostics +codeActionBreakFile fp l c = goldenWithImportActions " code action" fp codeActionNoResolveCaps $ \doc -> do + _ <- getCodeLenses doc changeDoc doc [edit] actions <- getCodeActions doc (pointRange l c) case find ((== Just "Make all imports explicit") . caTitle) actions of Just (InR x) -> executeCodeAction x _ -> liftIO $ assertFailure "Unable to find CodeAction" - where edit = TextDocumentContentChangeEvent $ InL $ #range .== pointRange 2 21 + where edit = TextDocumentContentChangeEvent $ InL $ #range .== pointRange 2 29 .+ #rangeLength .== Nothing .+ #text .== "x" codeActionStaleAction :: FilePath -> Int -> Int -> TestTree -codeActionStaleAction fp l c = goldenWithExplicitImports " code action" fp codeActionResolveCaps $ \doc -> do +codeActionStaleAction fp l c = goldenWithImportActions " code action" fp codeActionResolveCaps $ \doc -> do _ <- waitForDiagnostics actions <- getCodeActions doc (pointRange l c) changeDoc doc [edit] @@ -108,21 +114,21 @@ codeActionStaleAction fp l c = goldenWithExplicitImports " code action" fp codeA .+ #text .== "\ntesting = undefined" codeActionAllResolveGoldenTest :: FilePath -> Int -> Int -> TestTree -codeActionAllResolveGoldenTest fp l c = goldenWithExplicitImports " code action resolve" fp codeActionResolveCaps $ \doc -> do +codeActionAllResolveGoldenTest fp l c = goldenWithImportActions " code action resolve" fp codeActionResolveCaps $ \doc -> do actions <- getCodeActions doc (pointRange l c) Just (InR x) <- pure $ find ((== Just "Make all imports explicit") . caTitle) actions resolved <- resolveCodeAction x executeCodeAction resolved codeActionOnlyGoldenTest :: FilePath -> Int -> Int -> TestTree -codeActionOnlyGoldenTest fp l c = goldenWithExplicitImports " code action" fp codeActionNoResolveCaps $ \doc -> do +codeActionOnlyGoldenTest fp l c = goldenWithImportActions " code action" fp codeActionNoResolveCaps $ \doc -> do actions <- getCodeActions doc (pointRange l c) case find ((== Just "Make this import explicit") . caTitle) actions of Just (InR x) -> executeCodeAction x _ -> liftIO $ assertFailure "Unable to find CodeAction" codeActionOnlyResolveGoldenTest :: FilePath -> Int -> Int -> TestTree -codeActionOnlyResolveGoldenTest fp l c = goldenWithExplicitImports " code action resolve" fp codeActionResolveCaps $ \doc -> do +codeActionOnlyResolveGoldenTest fp l c = goldenWithImportActions " code action resolve" fp codeActionResolveCaps $ \doc -> do actions <- getCodeActions doc (pointRange l c) Just (InR x) <- pure $ find ((== Just "Make this import explicit") . caTitle) actions resolved <- resolveCodeAction x @@ -147,12 +153,18 @@ caTitle _ = Nothing -- code lens tests -codeLensGoldenTest :: FilePath -> Int -> TestTree -codeLensGoldenTest fp _ = goldenWithExplicitImports " code lens" fp codeActionNoResolveCaps $ \doc -> do - (codeLens: _) <- getCodeLenses doc - CodeLens {_command = Just c} <- resolveCodeLens codeLens +codeLensGoldenTest :: (CodeLens -> Bool) -> FilePath -> Int -> TestTree +codeLensGoldenTest predicate fp i = goldenWithImportActions " code lens" fp codeActionNoResolveCaps $ \doc -> do + codeLenses <- getCodeLenses doc + resolvedCodeLenses <- for codeLenses resolveCodeLens + (CodeLens {_command = Just c}) <- pure (filter predicate resolvedCodeLenses !! i) executeCmd c +notRefineImports :: CodeLens -> Bool +notRefineImports (CodeLens _ (Just (Command text _ _)) _) + | "Refine imports to" `T.isPrefixOf` text = False +notRefineImports _ = True + -- TODO: use the one from lsp-test once that's released resolveCodeLens :: CodeLens -> Session CodeLens resolveCodeLens cl = do @@ -170,8 +182,8 @@ executeCmd cmd = do -- helpers -goldenWithExplicitImports :: String -> FilePath -> ClientCapabilities -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithExplicitImports title fp caps = goldenWithHaskellAndCaps caps explicitImportsPlugin (fp <> title <> " (golden)") testDataDir fp "expected" "hs" +goldenWithImportActions :: String -> FilePath -> ClientCapabilities -> (TextDocumentIdentifier -> Session ()) -> TestTree +goldenWithImportActions title fp caps = goldenWithHaskellAndCaps caps explicitImportsPlugin (fp <> title <> " (golden)") testDataDir fp "expected" "hs" testDataDir :: String testDataDir = "test" "testdata" @@ -181,3 +193,18 @@ pointRange (subtract 1 -> fromIntegral -> line) (subtract 1 -> fromIntegral -> col) = Range (Position line col) (Position line $ col + 1) + +------------------------------------------------------------------------------- +-- code action tests + +codeActionGoldenTest :: FilePath -> Int -> Int -> TestTree +codeActionGoldenTest fp l c = goldenWithImportActions "" fp codeActionNoResolveCaps $ \doc -> do + actions <- getCodeActions doc (pointRange l c) + case find ((== Just "Refine all imports") . caTitle) actions of + Just (InR x) -> executeCodeAction x + _ -> liftIO $ assertFailure "Unable to find CodeAction" + +isRefineImports :: CodeLens -> Bool +isRefineImports (CodeLens _ (Just (Command txt _ _)) _) + | "Refine imports to" `T.isInfixOf` txt = True +isRefineImports _ = False diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/A.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitA.hs similarity index 67% rename from plugins/hls-explicit-imports-plugin/test/testdata/A.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/ExplicitA.hs index 28768c69d4..8c69f8d84b 100644 --- a/plugins/hls-explicit-imports-plugin/test/testdata/A.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitA.hs @@ -1,4 +1,4 @@ -module A where +module ExplicitA where a1 :: String a1 = "a1" diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/B.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitB.hs similarity index 67% rename from plugins/hls-explicit-imports-plugin/test/testdata/B.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/ExplicitB.hs index 80159dc10b..7eb07baca6 100644 --- a/plugins/hls-explicit-imports-plugin/test/testdata/B.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitB.hs @@ -1,4 +1,4 @@ -module B where +module ExplicitB where b1 :: String b1 = "b1" diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/BreakFile.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitBreakFile.expected.hs similarity index 52% rename from plugins/hls-explicit-imports-plugin/test/testdata/BreakFile.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/ExplicitBreakFile.expected.hs index 2a570ae2d8..3ff53cddac 100644 --- a/plugins/hls-explicit-imports-plugin/test/testdata/BreakFile.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitBreakFile.expected.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wall #-} -module BreakFile where +module ExplicitBreakFile whexe -import A +import ExplicitA ( a1 ) main = putStrLn $ "hello " ++ a1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/StaleAction.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitBreakFile.hs similarity index 55% rename from plugins/hls-explicit-imports-plugin/test/testdata/StaleAction.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/ExplicitBreakFile.hs index 6d38cc62c4..bb20a5f1b0 100644 --- a/plugins/hls-explicit-imports-plugin/test/testdata/StaleAction.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitBreakFile.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wall #-} -module StaleAction where +module ExplicitBreakFile where -import A +import ExplicitA main = putStrLn $ "hello " ++ a1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitExported.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitExported.hs new file mode 100644 index 0000000000..ef6591ef3b --- /dev/null +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitExported.hs @@ -0,0 +1,6 @@ +module ExplicitExported (module ExplicitA) where + +import ExplicitA + +main :: IO () +main = putStrLn $ "hello " ++ a1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitOnlyThis.expected.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitOnlyThis.expected.hs new file mode 100644 index 0000000000..5dc9602676 --- /dev/null +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitOnlyThis.expected.hs @@ -0,0 +1,7 @@ +module ExplicitOnlyThis where + +import ExplicitA ( a1 ) +import ExplicitB + +main :: IO () +main = putStrLn $ "hello " ++ a1 ++ b1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitOnlyThis.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitOnlyThis.hs new file mode 100644 index 0000000000..eab53a795d --- /dev/null +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitOnlyThis.hs @@ -0,0 +1,7 @@ +module ExplicitOnlyThis where + +import ExplicitA +import ExplicitB + +main :: IO () +main = putStrLn $ "hello " ++ a1 ++ b1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/StaleAction.expected.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitStaleAction.expected.hs similarity index 61% rename from plugins/hls-explicit-imports-plugin/test/testdata/StaleAction.expected.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/ExplicitStaleAction.expected.hs index a345a5c91e..4433837a8e 100644 --- a/plugins/hls-explicit-imports-plugin/test/testdata/StaleAction.expected.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitStaleAction.expected.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall #-} -module StaleAction where +module ExplicitStaleAction where -import A +import ExplicitA main = putStrLn $ "hello " ++ a1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/BreakFile.expected.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitStaleAction.hs similarity index 54% rename from plugins/hls-explicit-imports-plugin/test/testdata/BreakFile.expected.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/ExplicitStaleAction.hs index 6ef3eeec69..864fbbc2c3 100644 --- a/plugins/hls-explicit-imports-plugin/test/testdata/BreakFile.expected.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitStaleAction.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wall #-} -module BreakFile whexe +module ExplicitStaleAction where -import A ( a1 ) +import ExplicitA main = putStrLn $ "hello " ++ a1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitUsualCase.expected.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitUsualCase.expected.hs new file mode 100644 index 0000000000..f96b6b2322 --- /dev/null +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitUsualCase.expected.hs @@ -0,0 +1,6 @@ +module ExplicitUsualCase where + +import ExplicitA ( a1 ) + +main :: IO () +main = putStrLn $ "hello " ++ a1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/Exported.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitUsualCase.hs similarity index 50% rename from plugins/hls-explicit-imports-plugin/test/testdata/Exported.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/ExplicitUsualCase.hs index 7ccaa5c3d4..6ca72a9d31 100644 --- a/plugins/hls-explicit-imports-plugin/test/testdata/Exported.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ExplicitUsualCase.hs @@ -1,6 +1,6 @@ -module Exported (module A) where +module ExplicitUsualCase where -import A +import ExplicitA main :: IO () main = putStrLn $ "hello " ++ a1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/OnlyThis.expected.hs b/plugins/hls-explicit-imports-plugin/test/testdata/OnlyThis.expected.hs deleted file mode 100644 index 5911ee5562..0000000000 --- a/plugins/hls-explicit-imports-plugin/test/testdata/OnlyThis.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -module OnlyThis where - -import A ( a1 ) -import B - -main :: IO () -main = putStrLn $ "hello " ++ a1 ++ b1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/OnlyThis.hs b/plugins/hls-explicit-imports-plugin/test/testdata/OnlyThis.hs deleted file mode 100644 index 9663d1b174..0000000000 --- a/plugins/hls-explicit-imports-plugin/test/testdata/OnlyThis.hs +++ /dev/null @@ -1,7 +0,0 @@ -module OnlyThis where - -import A -import B - -main :: IO () -main = putStrLn $ "hello " ++ a1 ++ b1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/RefineA.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineA.hs new file mode 100644 index 0000000000..eac694c211 --- /dev/null +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineA.hs @@ -0,0 +1,7 @@ +module RefineA + ( module RefineB + , module RefineC + ) where + +import RefineB +import RefineC \ No newline at end of file diff --git a/plugins/hls-refine-imports-plugin/test/testdata/B.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineB.hs similarity index 68% rename from plugins/hls-refine-imports-plugin/test/testdata/B.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/RefineB.hs index a813ff528a..aace4c226f 100644 --- a/plugins/hls-refine-imports-plugin/test/testdata/B.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineB.hs @@ -1,4 +1,4 @@ -module B where +module RefineB where b1 :: String b1 = "b1" diff --git a/plugins/hls-refine-imports-plugin/test/testdata/C.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineC.hs similarity index 52% rename from plugins/hls-refine-imports-plugin/test/testdata/C.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/RefineC.hs index 28434310d2..7af22d912f 100644 --- a/plugins/hls-refine-imports-plugin/test/testdata/C.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineC.hs @@ -1,4 +1,4 @@ -module C where +module RefineC where c1 :: String c1 = "c1" \ No newline at end of file diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/RefineD.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineD.hs new file mode 100644 index 0000000000..0c6d8aba16 --- /dev/null +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineD.hs @@ -0,0 +1,7 @@ +module RefineD (module RefineE, module RefineD) where + +import RefineE hiding (e1) +import qualified RefineE + +e1 :: String +e1 = RefineE.e1 <> " but overrided" \ No newline at end of file diff --git a/plugins/hls-refine-imports-plugin/test/testdata/E.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineE.hs similarity index 69% rename from plugins/hls-refine-imports-plugin/test/testdata/E.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/RefineE.hs index 7f61954f30..07a3125ca7 100644 --- a/plugins/hls-refine-imports-plugin/test/testdata/E.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineE.hs @@ -1,4 +1,4 @@ -module E where +module RefineE where e1 :: String e1 = "e1" diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/RefineF.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineF.hs new file mode 100644 index 0000000000..dd264e3ddf --- /dev/null +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineF.hs @@ -0,0 +1,7 @@ +module RefineF (module RefineF, module RefineG) where + +import RefineG + +f1 :: String +f1 = "f1" + diff --git a/plugins/hls-refine-imports-plugin/test/testdata/G.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineG.hs similarity index 53% rename from plugins/hls-refine-imports-plugin/test/testdata/G.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/RefineG.hs index 634a7f3ed8..f38731ba03 100644 --- a/plugins/hls-refine-imports-plugin/test/testdata/G.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineG.hs @@ -1,4 +1,4 @@ -module G where +module RefineG where g1 :: String g1 = "g1" \ No newline at end of file diff --git a/plugins/hls-refine-imports-plugin/test/testdata/UsualCase.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineUsualCase.expected.hs similarity index 78% rename from plugins/hls-refine-imports-plugin/test/testdata/UsualCase.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/RefineUsualCase.expected.hs index cb8193d35d..1e0c36661b 100644 --- a/plugins/hls-refine-imports-plugin/test/testdata/UsualCase.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineUsualCase.expected.hs @@ -1,7 +1,7 @@ module Main where -import A -import D +import RefineA +import RefineE ( e2 ) import Data.List (intercalate) main :: IO () diff --git a/plugins/hls-refine-imports-plugin/test/testdata/UsualCase.expected.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineUsualCase.hs similarity index 81% rename from plugins/hls-refine-imports-plugin/test/testdata/UsualCase.expected.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/RefineUsualCase.hs index 6403caef33..2d59232063 100644 --- a/plugins/hls-refine-imports-plugin/test/testdata/UsualCase.expected.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineUsualCase.hs @@ -1,7 +1,7 @@ module Main where -import A -import E ( e2 ) +import RefineA +import RefineD import Data.List (intercalate) main :: IO () diff --git a/plugins/hls-refine-imports-plugin/test/testdata/WithOverride.expected.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineWithOverride.expected.hs similarity index 66% rename from plugins/hls-refine-imports-plugin/test/testdata/WithOverride.expected.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/RefineWithOverride.expected.hs index 125b6b123d..06e195d639 100644 --- a/plugins/hls-refine-imports-plugin/test/testdata/WithOverride.expected.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineWithOverride.expected.hs @@ -1,9 +1,9 @@ module Main where -import B ( b1 ) -import C ( c1 ) -import D -import F +import RefineB ( b1 ) +import RefineC ( c1 ) +import RefineD +import RefineF import Data.List (intercalate) main :: IO () diff --git a/plugins/hls-refine-imports-plugin/test/testdata/WithOverride.hs b/plugins/hls-explicit-imports-plugin/test/testdata/RefineWithOverride.hs similarity index 76% rename from plugins/hls-refine-imports-plugin/test/testdata/WithOverride.hs rename to plugins/hls-explicit-imports-plugin/test/testdata/RefineWithOverride.hs index 66d62989cd..dba1ab7fbb 100644 --- a/plugins/hls-refine-imports-plugin/test/testdata/WithOverride.hs +++ b/plugins/hls-explicit-imports-plugin/test/testdata/RefineWithOverride.hs @@ -1,8 +1,8 @@ module Main where -import A -import D -import F +import RefineA +import RefineD +import RefineF import Data.List (intercalate) main :: IO () diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/UsualCase.expected.hs b/plugins/hls-explicit-imports-plugin/test/testdata/UsualCase.expected.hs deleted file mode 100644 index ec0b512b3b..0000000000 --- a/plugins/hls-explicit-imports-plugin/test/testdata/UsualCase.expected.hs +++ /dev/null @@ -1,6 +0,0 @@ -module UsualCase where - -import A ( a1 ) - -main :: IO () -main = putStrLn $ "hello " ++ a1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/UsualCase.hs b/plugins/hls-explicit-imports-plugin/test/testdata/UsualCase.hs deleted file mode 100644 index 4bf33dc094..0000000000 --- a/plugins/hls-explicit-imports-plugin/test/testdata/UsualCase.hs +++ /dev/null @@ -1,6 +0,0 @@ -module UsualCase where - -import A - -main :: IO () -main = putStrLn $ "hello " ++ a1 diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/hie.yaml b/plugins/hls-explicit-imports-plugin/test/testdata/hie.yaml index 8d08bfb527..42efdf316e 100644 --- a/plugins/hls-explicit-imports-plugin/test/testdata/hie.yaml +++ b/plugins/hls-explicit-imports-plugin/test/testdata/hie.yaml @@ -2,9 +2,18 @@ cradle: direct: arguments: - - OnlyThis.hs - - StaleAction.hs - - UsualCase.hs - - Exported.hs - - A.hs - - B.hs + - ExplicitOnlyThis.hs + - ExplicitStaleAction.hs + - ExplicitUsualCase.hs + - ExplicitExported.hs + - ExplicitA.hs + - ExplicitB.hs + - RefineUsualCase.hs + - RefineWithOverride.hs + - RefineA.hs + - RefineB.hs + - RefineC.hs + - RefineD.hs + - RefineE.hs + - RefineF.hs + - RefineG.hs diff --git a/plugins/hls-refine-imports-plugin/LICENSE b/plugins/hls-refine-imports-plugin/LICENSE deleted file mode 100644 index 261eeb9e9f..0000000000 --- a/plugins/hls-refine-imports-plugin/LICENSE +++ /dev/null @@ -1,201 +0,0 @@ - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS - - APPENDIX: How to apply the Apache License to your work. - - To apply the Apache License to your work, attach the following - boilerplate notice, with the fields enclosed by brackets "[]" - replaced with your own identifying information. (Don't include - the brackets!) The text should be enclosed in the appropriate - comment syntax for the file format. We also recommend that a - file or class name and description of purpose be included on the - same "printed page" as the copyright notice for easier - identification within third-party archives. - - Copyright [yyyy] [name of copyright owner] - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. diff --git a/plugins/hls-refine-imports-plugin/hls-refine-imports-plugin.cabal b/plugins/hls-refine-imports-plugin/hls-refine-imports-plugin.cabal deleted file mode 100644 index 2011f74b37..0000000000 --- a/plugins/hls-refine-imports-plugin/hls-refine-imports-plugin.cabal +++ /dev/null @@ -1,58 +0,0 @@ -cabal-version: 2.4 -name: hls-refine-imports-plugin -version: 2.1.0.0 -synopsis: Refine imports plugin for Haskell Language Server -description: - Please see the README on GitHub at -license: Apache-2.0 -license-file: LICENSE -author: rayshih -maintainer: mnf.shih@gmail.com -category: Development -build-type: Simple -extra-source-files: - LICENSE - test/testdata/*.hs - test/testdata/*.yaml - -source-repository head - type: git - location: https://github.com/haskell/haskell-language-server.git - -library - buildable: True - exposed-modules: Ide.Plugin.RefineImports - hs-source-dirs: src - build-depends: - , aeson - , base >=4.12 && <5 - , containers - , deepseq - , ghc - , ghcide == 2.1.0.0 - , hls-explicit-imports-plugin == 2.1.0.0 - , hls-graph - , hls-plugin-api == 2.1.0.0 - , lsp - , text - , transformers - , unordered-containers - - default-language: Haskell2010 - default-extensions: - DataKinds - TypeOperators - -test-suite tests - buildable: True - type: exitcode-stdio-1.0 - default-language: Haskell2010 - hs-source-dirs: test - main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: - , base - , filepath - , hls-refine-imports-plugin - , hls-test-utils - , text diff --git a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs b/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs deleted file mode 100644 index 2241d052dc..0000000000 --- a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs +++ /dev/null @@ -1,318 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE CPP #-} - -module Ide.Plugin.RefineImports (descriptor, Log(..)) where - -import Control.Arrow (Arrow (second)) -import Control.DeepSeq (rwhnf) -import Control.Monad (join) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Maybe (MaybeT (MaybeT), - runMaybeT) -import Data.Aeson.Types hiding (Null) -import Data.IORef (readIORef) -import Data.List (intercalate) -import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, fromMaybe) -import qualified Data.Set as S -import qualified Data.Text as T -import Data.Traversable (forM) -import Development.IDE -import Development.IDE.Core.PositionMapping -import Development.IDE.GHC.Compat - {- (AvailInfo, - GenLocated (L), GhcRn, - HsModule (hsmodImports), - ImportDecl (ImportDecl, ideclHiding, ideclName), - LIE, LImportDecl, - Module (moduleName), - ModuleName, - ParsedModule (ParsedModule, pm_parsed_source), - SrcSpan(..), - RealSrcSpan(..), - getLoc, ieName, noLoc, - tcg_exports, unLoc) -} -import qualified Development.IDE.Core.Shake as Shake -import Development.IDE.Graph.Classes -import qualified Ide.Logger as Logger -import GHC.Generics (Generic) -import Ide.Plugin.ExplicitImports (extractMinimalImports, - within) -import Ide.PluginUtils (mkLspCommand) -import Ide.Types -import Language.LSP.Server -import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), - CodeAction (CodeAction, _command, _diagnostics, _disabled, _edit, _isPreferred, _kind, _title, _data_), - CodeActionKind (CodeActionKind_Custom), - CodeActionParams (CodeActionParams), - CodeLens (..), - CodeLensParams (CodeLensParams, _textDocument), - TextDocumentIdentifier (TextDocumentIdentifier, _uri), - TextEdit (..), - WorkspaceEdit (..), - type (|?) (InL, InR), - uriToNormalizedFilePath, Null (Null)) -import Language.LSP.Protocol.Message (Method (Method_TextDocumentCodeAction, Method_TextDocumentCodeLens), - SMethod (SMethod_TextDocumentCodeAction, SMethod_TextDocumentCodeLens, SMethod_WorkspaceApplyEdit),) -newtype Log = LogShake Shake.Log deriving Show - -instance Pretty Log where - pretty = \case - LogShake log -> pretty log - --- | plugin declaration -descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState -descriptor recorder plId = (defaultPluginDescriptor plId) - { pluginCommands = [refineImportCommand] - , pluginRules = refineImportsRule recorder - , pluginHandlers = mconcat - [ -- This plugin provides code lenses - mkPluginHandler SMethod_TextDocumentCodeLens lensProvider - -- This plugin provides code actions - , mkPluginHandler SMethod_TextDocumentCodeAction codeActionProvider - ] - } - -refineImportCommandId :: CommandId -refineImportCommandId = "RefineImportLensCommand" - -newtype RefineImportCommandParams = RefineImportCommandParams WorkspaceEdit - deriving Generic - deriving anyclass (FromJSON, ToJSON) - --- | The command descriptor -refineImportCommand :: PluginCommand IdeState -refineImportCommand = - PluginCommand - { commandId = refineImportCommandId - , commandDesc = "Directly use the imports as oppose to using aggregation module" - , commandFunc = runRefineImportCommand - } - --- | The actual command handler -runRefineImportCommand :: CommandFunction IdeState RefineImportCommandParams -runRefineImportCommand _state (RefineImportCommandParams edit) = do - -- This command simply triggers a workspace edit! - _ <- lift $ sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) - pure $ InR Null - -lensProvider :: PluginMethodHandler IdeState Method_TextDocumentCodeLens -lensProvider - state -- ghcide state - pId - CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}} - -- VSCode uses URIs instead of file paths - -- haskell-lsp provides conversion functions - | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri = liftIO $ - do - mbRefinedImports <- - runIde state $ useWithStale RefineImports nfp - case mbRefinedImports of - -- Implement the provider logic: - -- for every refined import, generate a code lens - Just (RefineImportsResult result, posMapping) -> do - commands <- - sequence - [ generateLens pId _uri edit - | (imp, Just refinedImports) <- result - , Just edit <- [mkExplicitEdit posMapping imp refinedImports] - ] - return $ (InL $ catMaybes commands) - _ -> return $ (InL []) - | otherwise = - return $ (InL []) - --- | Provide one code action to refine all imports -codeActionProvider :: PluginMethodHandler IdeState Method_TextDocumentCodeAction -codeActionProvider ideState _pId (CodeActionParams _ _ docId range _context) - | TextDocumentIdentifier {_uri} <- docId, - Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri = liftIO $ - do - pm <- runIde ideState $ use GetParsedModule nfp - let insideImport = case pm of - Just ParsedModule {pm_parsed_source} - | locImports <- hsmodImports (unLoc pm_parsed_source), - rangesImports <- map getLoc locImports -> - any (within range) rangesImports - _ -> False - if not insideImport - then return (InL []) - else do - mbRefinedImports <- runIde ideState $ use RefineImports nfp - let edits = - [ e - | Just (RefineImportsResult result) <- [mbRefinedImports] - , (imp, Just refinedImports) <- result - , Just e <- [mkExplicitEdit zeroMapping imp refinedImports] - ] - caExplicitImports = InR CodeAction {..} - _title = "Refine all imports" - _kind = Just $ CodeActionKind_Custom "quickfix.import.refine" - _command = Nothing - _edit = Just WorkspaceEdit - {_changes, _documentChanges, _changeAnnotations} - _changes = Just $ Map.singleton _uri edits - _documentChanges = Nothing - _diagnostics = Nothing - _isPreferred = Nothing - _disabled = Nothing - _data_ = Nothing - _changeAnnotations = Nothing - return $ InL [caExplicitImports | not (null edits)] - | otherwise = - return $ InL [] - --------------------------------------------------------------------------------- - -data RefineImports = RefineImports - deriving (Show, Generic, Eq, Ord) - -instance Hashable RefineImports -instance NFData RefineImports -type instance RuleResult RefineImports = RefineImportsResult - -newtype RefineImportsResult = RefineImportsResult - {getMinimalImportsResult :: [(LImportDecl GhcRn, Maybe T.Text)]} - -instance Show RefineImportsResult where show _ = "" -instance NFData RefineImportsResult where rnf = rwhnf - -refineImportsRule :: Recorder (WithPriority Log) -> Rules () -refineImportsRule recorder = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \RefineImports nfp -> runMaybeT $ do - -- Get the typechecking artifacts from the module - tmr <- MaybeT $ use TypeCheck nfp - -- We also need a GHC session with all the dependencies - hsc <- MaybeT $ use GhcSessionDeps nfp - - -- 2 layer map ModuleName -> ModuleName -> [Avails] (exports) - import2Map <- do - -- first layer is from current(editing) module to its imports - ImportMap currIm <- lift $ use_ GetImportMap nfp - forM currIm $ \path -> do - -- second layer is from the imports of first layer to their imports - ImportMap importIm <- lift $ use_ GetImportMap path - forM importIm $ \imp_path -> do - imp_hir <- lift $ use_ GetModIface imp_path - return $ mi_exports $ hirModIface imp_hir - - -- Use the GHC api to extract the "minimal" imports - -- We shouldn't blindly refine imports - -- instead we should generate imports statements - -- for modules/symbols actually got used - (imports, mbMinImports) <- MaybeT $ liftIO $ extractMinimalImports hsc tmr - - let filterByImport - :: LImportDecl GhcRn - -> Map.Map ModuleName [AvailInfo] - -> Maybe (Map.Map ModuleName [AvailInfo]) -#if MIN_VERSION_ghc(9,5,0) - filterByImport (L _ ImportDecl{ideclImportList = Just (_, L _ names)}) avails = -#else - filterByImport (L _ ImportDecl{ideclHiding = Just (_, L _ names)}) avails = -#endif - let importedNames = S.fromList $ map (ieName . unLoc) names - res = flip Map.filter avails $ \a -> - any (`S.member` importedNames) - $ concatMap availNamesWithSelectors a - allFilteredAvailsNames = S.fromList - $ concatMap availNamesWithSelectors - $ mconcat - $ Map.elems res - -- if there is a function defined in the current module and is used - -- i.e. if a function is not reexported but defined in current - -- module then this import cannot be refined - in if importedNames `S.isSubsetOf` allFilteredAvailsNames - then Just res - else Nothing - filterByImport _ _ = Nothing - let constructImport - :: LImportDecl GhcRn - -> (ModuleName, [AvailInfo]) - -> LImportDecl GhcRn - constructImport - i@(L lim id@ImportDecl -#if MIN_VERSION_ghc(9,5,0) - {ideclName = L _ mn, ideclImportList = Just (hiding, L _ names)}) -#else - {ideclName = L _ mn, ideclHiding = Just (hiding, L _ names)}) -#endif - (newModuleName, avails) = L lim id - { ideclName = noLocA newModuleName -#if MIN_VERSION_ghc(9,5,0) - , ideclImportList = Just (hiding, noLocA newNames) -#else - , ideclHiding = Just (hiding, noLocA newNames) -#endif - } - where newNames = filter (\n -> any (n `containsAvail`) avails) names - constructImport lim _ = lim - let res = - [ (i, Just - . T.intercalate "\n" - . map (printOutputable . constructImport i) - . Map.toList - $ filteredInnerImports) - -- for every minimal imports - | minImports <- [mbMinImports] - , i@(L _ ImportDecl{ideclName = L _ mn}) <- minImports - -- we check for the inner imports - , Just innerImports <- [Map.lookup mn import2Map] - -- and only get those symbols used - , Just filteredInnerImports <- [filterByImport i innerImports] - -- if no symbols from this modules then don't need to generate new import - , not $ null filteredInnerImports - ] - pure $ RefineImportsResult res - - where - -- Check if a name is exposed by AvailInfo (the available information of a module) - containsAvail :: LIE GhcRn -> AvailInfo -> Bool - containsAvail name avail = - any (\an -> printOutputable an == (printOutputable . ieName . unLoc $ name)) - $ availNamesWithSelectors avail - --------------------------------------------------------------------------------- - -mkExplicitEdit :: PositionMapping -> LImportDecl GhcRn -> T.Text -> Maybe TextEdit -mkExplicitEdit posMapping (L src imp) explicit - | RealSrcSpan l _ <- locA src, - L _ mn <- ideclName imp, - -- (almost) no one wants to see an refine import list for Prelude - mn /= moduleName pRELUDE, - Just rng <- toCurrentRange posMapping $ realSrcSpanToRange l = - Just $ TextEdit rng explicit - | otherwise = - Nothing - --- | Given an import declaration, generate a code lens unless it has an --- explicit import list or it's qualified -generateLens :: PluginId -> Uri -> TextEdit -> IO (Maybe CodeLens) -generateLens pId uri edits@TextEdit {_range, _newText} = do - -- The title of the command is just the minimal explicit import decl - let title = "Refine imports to " <> T.intercalate ", " (T.lines _newText) - -- the code lens has no extra data - _data_ = Nothing - -- an edit that replaces the whole declaration with the explicit one - edit = WorkspaceEdit (Just editsMap) Nothing Nothing - editsMap = Map.fromList [(uri, [edits])] - -- the command argument is simply the edit - _arguments = Just [toJSON $ RefineImportCommandParams edit] - -- create the command - _command = Just $ mkLspCommand pId refineImportCommandId title _arguments - -- create and return the code lens - return $ Just CodeLens {..} - --------------------------------------------------------------------------------- - --- | A helper to run ide actions -runIde :: IdeState -> Action a -> IO a -runIde = runAction "RefineImports" diff --git a/plugins/hls-refine-imports-plugin/test/Main.hs b/plugins/hls-refine-imports-plugin/test/Main.hs deleted file mode 100644 index 284aedffa2..0000000000 --- a/plugins/hls-refine-imports-plugin/test/Main.hs +++ /dev/null @@ -1,79 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ViewPatterns #-} - -module Main - ( main - ) where - -import Data.Foldable (find, forM_) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Ide.Plugin.RefineImports as RefineImports -import System.FilePath ((<.>), ()) -import Test.Hls - -main :: IO () -main = defaultTestRunner $ - testGroup - "Refine Imports" - [ codeActionGoldenTest "WithOverride" 3 1 - , codeLensGoldenTest "UsualCase" 1 - ] - -refineImportsPlugin :: PluginTestDescriptor RefineImports.Log -refineImportsPlugin = mkPluginTestDescriptor RefineImports.descriptor "refineImports" - --- code action tests - -codeActionGoldenTest :: FilePath -> Int -> Int -> TestTree -codeActionGoldenTest fp l c = goldenWithRefineImports fp $ \doc -> do - actions <- getCodeActions doc (pointRange l c) - case find ((== Just "Refine all imports") . caTitle) actions of - Just (InR x) -> executeCodeAction x - _ -> liftIO $ assertFailure "Unable to find CodeAction" - -caTitle :: (Command |? CodeAction) -> Maybe Text -caTitle (InR CodeAction {_title}) = Just _title -caTitle _ = Nothing - - --- code lens tests - -codeLensGoldenTest :: FilePath -> Int -> TestTree -codeLensGoldenTest fp codeLensIdx = goldenWithRefineImports fp $ \doc -> do - codeLens <- (!! codeLensIdx) <$> getCodeLensesBy isRefineImports doc - mapM_ executeCmd - [c | CodeLens{_command = Just c} <- [codeLens]] - -getCodeLensesBy :: (CodeLens -> Bool) -> TextDocumentIdentifier -> Session [CodeLens] -getCodeLensesBy f doc = filter f <$> getCodeLenses doc - -isRefineImports :: CodeLens -> Bool -isRefineImports (CodeLens _ (Just (Command _ cmd _)) _) - | ":refineImports:" `T.isInfixOf` cmd = True -isRefineImports _ = False - --- Execute command and wait for result -executeCmd :: Command -> Session () -executeCmd cmd = do - executeCommand cmd - _resp <- skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) - -- liftIO $ print _resp - return () - --- helpers - -goldenWithRefineImports :: FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithRefineImports fp = goldenWithHaskellDoc refineImportsPlugin (fp <> " (golden)") testDataDir fp "expected" "hs" - -testDataDir :: String -testDataDir = "test" "testdata" - -pointRange :: Int -> Int -> Range -pointRange - (subtract 1 -> fromIntegral -> line) - (subtract 1 -> fromIntegral -> col) = - Range (Position line col) (Position line $ col + 1) diff --git a/plugins/hls-refine-imports-plugin/test/testdata/A.hs b/plugins/hls-refine-imports-plugin/test/testdata/A.hs deleted file mode 100644 index da94829c76..0000000000 --- a/plugins/hls-refine-imports-plugin/test/testdata/A.hs +++ /dev/null @@ -1,7 +0,0 @@ -module A - ( module B - , module C - ) where - -import B -import C \ No newline at end of file diff --git a/plugins/hls-refine-imports-plugin/test/testdata/D.hs b/plugins/hls-refine-imports-plugin/test/testdata/D.hs deleted file mode 100644 index afb002ca84..0000000000 --- a/plugins/hls-refine-imports-plugin/test/testdata/D.hs +++ /dev/null @@ -1,7 +0,0 @@ -module D (module E, module D) where - -import E hiding (e1) -import qualified E - -e1 :: String -e1 = E.e1 <> " but overrided" \ No newline at end of file diff --git a/plugins/hls-refine-imports-plugin/test/testdata/F.hs b/plugins/hls-refine-imports-plugin/test/testdata/F.hs deleted file mode 100644 index 9fab4ee9b8..0000000000 --- a/plugins/hls-refine-imports-plugin/test/testdata/F.hs +++ /dev/null @@ -1,7 +0,0 @@ -module F (module F, module G) where - -import G - -f1 :: String -f1 = "f1" - diff --git a/plugins/hls-refine-imports-plugin/test/testdata/hie.yaml b/plugins/hls-refine-imports-plugin/test/testdata/hie.yaml deleted file mode 100644 index 4770978cb2..0000000000 --- a/plugins/hls-refine-imports-plugin/test/testdata/hie.yaml +++ /dev/null @@ -1,12 +0,0 @@ -cradle: - direct: - arguments: - - UsualCase.hs - - WithOverride.hs - - A.hs - - B.hs - - C.hs - - D.hs - - E.hs - - F.hs - - G.hs \ No newline at end of file diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index 22008d2a4a..a23051fd9e 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -40,9 +40,7 @@ import qualified Ide.Plugin.Eval as Eval import qualified Ide.Plugin.ExplicitImports as ExplicitImports #endif -#if hls_refineImports -import qualified Ide.Plugin.RefineImports as RefineImports -#endif + #if hls_rename import qualified Ide.Plugin.Rename as Rename @@ -200,9 +198,6 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins #if hls_qualifyImportedNames QualifyImportedNames.descriptor "qualifyImportedNames" : #endif -#if hls_refineImports - let pId = "refineImports" in RefineImports.descriptor (pluginRecorder pId) pId: -#endif #if hls_moduleName let pId = "moduleName" in ModuleName.descriptor (pluginRecorder pId) pId: #endif diff --git a/stack-lts21.yaml b/stack-lts21.yaml index b90fa0d4e5..90f2c3953c 100644 --- a/stack-lts21.yaml +++ b/stack-lts21.yaml @@ -31,7 +31,6 @@ packages: - ./plugins/hls-pragmas-plugin - ./plugins/hls-qualify-imported-names-plugin - ./plugins/hls-refactor-plugin - - ./plugins/hls-refine-imports-plugin - ./plugins/hls-rename-plugin - ./plugins/hls-retrie-plugin - ./plugins/hls-splice-plugin diff --git a/stack.yaml b/stack.yaml index 473661211e..7c2af3269c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -31,7 +31,6 @@ packages: - ./plugins/hls-pragmas-plugin - ./plugins/hls-qualify-imported-names-plugin - ./plugins/hls-refactor-plugin - - ./plugins/hls-refine-imports-plugin - ./plugins/hls-rename-plugin - ./plugins/hls-retrie-plugin - ./plugins/hls-splice-plugin