diff --git a/README.md b/README.md index f284ea0ba4..0df9d84084 100644 --- a/README.md +++ b/README.md @@ -75,6 +75,10 @@ This is *very* early stage software. ![Retrie](https://i.imgur.com/Ev7B87k.gif) + - Code lenses for explicit import lists + + ![Imports code lens](https://imgur.com/pX9kvY4.gif) + - Many more (TBD) ## Installation diff --git a/exe/Main.hs b/exe/Main.hs index 4d7518ca88..7a5bd8e44e 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -69,6 +69,7 @@ import Ide.Plugin.Example2 as Example2 import Ide.Plugin.GhcIde as GhcIde import Ide.Plugin.Floskell as Floskell import Ide.Plugin.Fourmolu as Fourmolu +import Ide.Plugin.ImportLens as ImportLens import Ide.Plugin.Ormolu as Ormolu import Ide.Plugin.StylishHaskell as StylishHaskell import Ide.Plugin.Retrie as Retrie @@ -114,6 +115,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins , Brittany.descriptor "brittany" #endif , Eval.descriptor "eval" + , ImportLens.descriptor "importLens" ] examplePlugins = [Example.descriptor "eg" diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 8883e9e08b..a58ba7fdcc 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -47,6 +47,7 @@ library Ide.Plugin.Example2 Ide.Plugin.Fourmolu Ide.Plugin.GhcIde + Ide.Plugin.ImportLens Ide.Plugin.Ormolu Ide.Plugin.Pragmas Ide.Plugin.Retrie diff --git a/src/Ide/Plugin/ImportLens.hs b/src/Ide/Plugin/ImportLens.hs new file mode 100644 index 0000000000..c8f2661f5b --- /dev/null +++ b/src/Ide/Plugin/ImportLens.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Ide.Plugin.ImportLens (descriptor) where +import Control.Monad (forM) +import Data.Aeson (ToJSON) +import Data.Aeson (Value (Null)) +import Data.Aeson (ToJSON (toJSON)) +import Data.Aeson.Types (FromJSON) +import qualified Data.HashMap.Strict as HashMap +import Data.IORef (readIORef) +import Data.Map (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (catMaybes, fromMaybe) +import qualified Data.Text as T +import Development.IDE.Core.RuleTypes (GhcSessionDeps (GhcSessionDeps), + TcModuleResult (tmrModule), + TypeCheck (TypeCheck)) +import Development.IDE.Core.Shake (use, IdeState (..)) +import Development.IDE.GHC.Compat +import Development.IDE.GHC.Error (realSpan, realSrcSpanToRange) +import Development.IDE.GHC.Util (HscEnvEq, hscEnv, prettyPrint) +import GHC.Generics (Generic) +import Ide.Plugin +import Ide.Types +import Language.Haskell.LSP.Types +import PrelNames (pRELUDE) +import RnNames (findImportUsage, + getMinimalImports) +import TcRnMonad (initTcWithGbl) +import TcRnTypes (TcGblEnv (tcg_used_gres)) +import Development.IDE.Core.Service (runAction) +import Development.Shake (Action) + +importCommandId :: CommandId +importCommandId = "ImportLensCommand" + +-- | The "main" function of a plugin +descriptor :: PluginId -> PluginDescriptor +descriptor plId = (defaultPluginDescriptor plId) { + -- This plugin provides code lenses + pluginCodeLensProvider = Just provider, + -- This plugin provides a command handler + pluginCommands = [ importLensCommand ] +} + +-- | The command descriptor +importLensCommand :: PluginCommand +importLensCommand = + PluginCommand importCommandId "Explicit import command" runImportCommand + +-- | The type of the parameters accepted by our command +data ImportCommandParams = ImportCommandParams WorkspaceEdit + deriving Generic + deriving anyclass (FromJSON, ToJSON) + +-- | The actual command handler +runImportCommand :: CommandFunction ImportCommandParams +runImportCommand _lspFuncs _state (ImportCommandParams edit) = do + -- This command simply triggers a workspace edit! + return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams edit)) + +-- | For every implicit import statement, return a code lens of the corresponding explicit import +-- 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) +provider :: CodeLensProvider +provider _lspFuncs -- LSP functions, not used + state -- ghcide state, used to retrieve typechecking artifacts + pId -- plugin Id + CodeLensParams{_textDocument = TextDocumentIdentifier{_uri}} + -- VSCode uses URIs instead of file paths + -- haskell-lsp provides conversion functions + | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri + = do + -- Get the typechecking artifacts from the module + tmr <- runIde state $ use TypeCheck nfp + -- We also need a GHC session with all the dependencies + hsc <- runIde state $ use GhcSessionDeps nfp + -- Use the GHC api to extract the "minimal" imports + (imports, mbMinImports) <- extractMinimalImports hsc tmr + + case mbMinImports of + -- Implement the provider logic: + -- for every import, if it's lacking a explicit list, generate a code lens + Just minImports -> do + let minImportsMap = + Map.fromList [ (srcSpanStart l, i) | L l i <- minImports ] + commands <- forM imports $ generateLens pId _uri minImportsMap + return $ Right (List $ catMaybes commands) + _ -> + return $ Right (List []) + + | otherwise + = return $ Right (List []) + +-- | Use the ghc api to extract a minimal, explicit set of imports for this module +extractMinimalImports + :: Maybe (HscEnvEq) + -> Maybe (TcModuleResult) + -> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn]) +extractMinimalImports (Just (hsc)) (Just (tmrModule -> TypecheckedModule{..})) = do + -- extract the original imports and the typechecking environment + let (tcEnv,_) = tm_internals_ + Just (_, imports, _, _) = tm_renamed_source + ParsedModule{ pm_parsed_source = L loc _} = tm_parsed_module + span = fromMaybe (error "expected real") $ realSpan loc + + -- GHC is secretly full of mutable state + gblElts <- readIORef (tcg_used_gres tcEnv) + + -- call findImportUsage does exactly what we need + -- GHC is full of treats like this + let usage = findImportUsage imports gblElts + (_, minimalImports) <- initTcWithGbl (hscEnv hsc) tcEnv span $ getMinimalImports usage + + -- return both the original imports and the computed minimal ones + return (imports, minimalImports) + +extractMinimalImports _ _ = return ([], Nothing) + +-- | Given an import declaration, generate a code lens unless it has an explicit import list +generateLens :: PluginId -> Uri -> Map SrcLoc (ImportDecl GhcRn) -> LImportDecl GhcRn -> IO (Maybe CodeLens) +generateLens pId uri minImports (L src imp) + -- Explicit import list case + | ImportDecl{ideclHiding = Just (False,_)} <- imp + = return Nothing + -- No explicit import list + | RealSrcSpan l <- src + , Just explicit <- Map.lookup (srcSpanStart src) minImports + , L _ mn <- ideclName imp + -- (almost) no one wants to see an explicit import list for Prelude + , mn /= moduleName pRELUDE + = do + -- The title of the command is just the minimal explicit import decl + let title = T.pack $ prettyPrint explicit + -- the range of the code lens is the span of the original import decl + _range :: Range = realSrcSpanToRange l + -- 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 + editsMap = HashMap.fromList [(uri, List [importEdit])] + importEdit = TextEdit _range title + -- the command argument is simply the edit + _arguments = Just [toJSON $ ImportCommandParams edit] + -- create the command + _command <- Just <$> mkLspCommand pId importCommandId title _arguments + -- create and return the code lens + return $ Just CodeLens{..} + | otherwise + = return Nothing + +-- | A helper to run ide actions +runIde :: IdeState -> Action a -> IO a +runIde state = runAction "importLens" state