{-# 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 Data.Aeson.Types import qualified Data.HashMap.Strict as HashMap 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 Development.IDE.Types.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.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), CodeAction (CodeAction, _command, _diagnostics, _disabled, _edit, _isPreferred, _kind, _title, _xdata), CodeActionKind (CodeActionUnknown), CodeActionParams (CodeActionParams), CodeLens (..), CodeLensParams (CodeLensParams, _textDocument), Method (TextDocumentCodeAction, TextDocumentCodeLens), SMethod (STextDocumentCodeAction, STextDocumentCodeLens, SWorkspaceApplyEdit), TextDocumentIdentifier (TextDocumentIdentifier, _uri), TextEdit (..), WorkspaceEdit (..), type (|?) (InR), uriToNormalizedFilePath) 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 STextDocumentCodeLens lensProvider -- This plugin provides code actions , mkPluginHandler STextDocumentCodeAction 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! _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) return (Right Null) lensProvider :: PluginMethodHandler IdeState 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 $ Right (List $ catMaybes commands) _ -> return $ Right (List []) | otherwise = return $ Right (List []) -- | Provide one code action to refine all imports codeActionProvider :: PluginMethodHandler IdeState 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 (Right (List [])) 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 $ CodeActionUnknown "quickfix.import.refine" _command = Nothing _edit = Just WorkspaceEdit {_changes, _documentChanges, _changeAnnotations} _changes = Just $ HashMap.singleton _uri $ List edits _documentChanges = Nothing _diagnostics = Nothing _isPreferred = Nothing _disabled = Nothing _xdata = Nothing _changeAnnotations = Nothing return $ Right $ List [caExplicitImports | not (null edits)] | otherwise = return $ Right $ List [] -------------------------------------------------------------------------------- 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 = define (cmapWithPrio LogShake recorder) $ \RefineImports nfp -> do -- Get the typechecking artifacts from the module tmr <- use TypeCheck nfp -- We also need a GHC session with all the dependencies hsc <- use GhcSessionDeps nfp -- 2 layer map ModuleName -> ModuleName -> [Avails] (exports) import2Map <- do -- first layer is from current(editing) module to its imports ImportMap currIm <- use_ GetImportMap nfp forM currIm $ \path -> do -- second layer is from the imports of first layer to their imports ImportMap importIm <- use_ GetImportMap path forM importIm $ \imp_path -> do imp_hir <- 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) <- 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 | Just 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 ] return ([], RefineImportsResult res <$ mbMinImports) 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 _xdata = Nothing -- an edit that replaces the whole declaration with the explicit one edit = WorkspaceEdit (Just editsMap) Nothing Nothing editsMap = HashMap.fromList [(uri, List [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"