From 6fdd7d43387fa8777490561573fb6e5375782ba8 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 9 Aug 2020 11:37:34 +0100 Subject: [PATCH 1/5] import lens plugin --- exe/Main.hs | 2 + haskell-language-server.cabal | 1 + src/Ide/Plugin/ImportLens.hs | 124 ++++++++++++++++++++++++++++++++++ 3 files changed, 127 insertions(+) create mode 100644 src/Ide/Plugin/ImportLens.hs 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..d032a16313 --- /dev/null +++ b/src/Ide/Plugin/ImportLens.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +module Ide.Plugin.ImportLens (descriptor) where +import Control.Monad (forM) +import Data.Aeson (ToJSON) +import Data.Aeson (Value(Null)) +import Data.Aeson.Types (FromJSON) +import Data.IORef (readIORef) +import Data.Map (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe, catMaybes) +import qualified Data.Text as T +import Development.IDE +import Development.IDE.GHC.Compat +import GHC.Generics (Generic) +import Ide.Plugin +import Ide.Types +import Language.Haskell.LSP.Types +import RnNames (getMinimalImports, findImportUsage) +import TcRnMonad (initTcWithGbl) +import TcRnTypes (TcGblEnv(tcg_used_gres)) +import PrelNames (pRELUDE) +import Data.Aeson (ToJSON(toJSON)) +import qualified Data.HashMap.Strict as HashMap + +importCommandId :: CommandId +importCommandId = "ImportLensCommand" + +descriptor :: PluginId -> PluginDescriptor +descriptor plId = (defaultPluginDescriptor plId) { + pluginCodeLensProvider = Just provider, + pluginCommands = [ importLensCommand ] +} + +importLensCommand :: PluginCommand +importLensCommand = + PluginCommand importCommandId "Explicit import command" runImportCommand + +data ImportCommandParams = ImportCommandParams WorkspaceEdit + deriving Generic + deriving anyclass (FromJSON, ToJSON) + +runImportCommand :: CommandFunction ImportCommandParams +runImportCommand _lspFuncs _state (ImportCommandParams edit) = do + 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: +-- +-- > import Data.List (intercalate, sortBy) + +provider :: CodeLensProvider +provider _lspFuncs state pId CodeLensParams{..} + | TextDocumentIdentifier{_uri} <- _textDocument + , Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri + = do + Just (tmr, _) <- runIde state $ useWithStaleFast TypeCheck nfp + hsc <- hscEnv <$> runAction "importLens" state (use_ GhcSessionDeps nfp) + (imports, mbMinImports) <- extractMinimalImports hsc (tmrModule tmr) + + case mbMinImports of + 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 []) + +extractMinimalImports :: HscEnv -> TypecheckedModule -> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn]) +extractMinimalImports hsc TypecheckedModule{..} = do + let (tcEnv,_) = tm_internals_ + Just (_, imports, _, _) = tm_renamed_source + ParsedModule{ pm_parsed_source = L loc _} = tm_parsed_module + + gblElts <- readIORef (tcg_used_gres tcEnv) + let usage = findImportUsage imports gblElts + span = fromMaybe (error "expected real") $ realSpan loc + (_, minimalImports) <- initTcWithGbl hsc tcEnv span $ getMinimalImports usage + return (imports, minimalImports) + +generateLens :: PluginId -> Uri -> Map SrcLoc (ImportDecl GhcRn) -> LImportDecl GhcRn -> IO (Maybe CodeLens) +generateLens pId uri minImports (L src imp) + | ImportDecl{ideclHiding = Just (False,_)} <- imp + = return Nothing + | RealSrcSpan l <- src + , Just explicit <- Map.lookup (srcSpanStart src) minImports + , L _ mn <- ideclName imp + , mn /= moduleName pRELUDE + = do + let title = T.pack $ prettyPrint explicit + commandArgs = Nothing + c <- mkLspCommand pId importCommandId title commandArgs + let _range :: Range = realSrcSpanToRange l + _xdata = Nothing + edit = WorkspaceEdit (Just editsMap) Nothing + editsMap = HashMap.fromList [(uri, List [importEdit])] + importEdit = TextEdit _range title + args = ImportCommandParams edit + _arguments = Just (List [toJSON args]) + _command = Just (c :: Command){_arguments} + return $ Just CodeLens{..} + | otherwise + = return Nothing + +runIde :: IdeState -> IdeAction a -> IO a +runIde state = runIdeAction "importLens" (shakeExtras state) From 6e4bc8cde5fcd3f702753d0293c7c3287257edb1 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 10 Aug 2020 21:10:21 +0100 Subject: [PATCH 2/5] Development.IDE is not available yet --- src/Ide/Plugin/ImportLens.hs | 67 ++++++++++++++++++++---------------- 1 file changed, 38 insertions(+), 29 deletions(-) diff --git a/src/Ide/Plugin/ImportLens.hs b/src/Ide/Plugin/ImportLens.hs index d032a16313..54f3b2a46e 100644 --- a/src/Ide/Plugin/ImportLens.hs +++ b/src/Ide/Plugin/ImportLens.hs @@ -1,34 +1,43 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} +{-# 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.Types (FromJSON) -import Data.IORef (readIORef) -import Data.Map (Map) -import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe, catMaybes) -import qualified Data.Text as T -import Development.IDE -import Development.IDE.GHC.Compat -import GHC.Generics (Generic) -import Ide.Plugin -import Ide.Types -import Language.Haskell.LSP.Types -import RnNames (getMinimalImports, findImportUsage) -import TcRnMonad (initTcWithGbl) -import TcRnTypes (TcGblEnv(tcg_used_gres)) -import PrelNames (pRELUDE) -import Data.Aeson (ToJSON(toJSON)) -import qualified Data.HashMap.Strict as HashMap +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.Service (IdeState, runAction) +import Development.IDE.Core.Shake (IdeAction, IdeState (..), + runIdeAction, useWithStaleFast, + use_) +import Development.IDE.GHC.Compat +import Development.IDE.GHC.Error (realSpan, realSrcSpanToRange) +import Development.IDE.GHC.Util (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)) importCommandId :: CommandId importCommandId = "ImportLensCommand" From f68d6e3c9f457ecb7958576065cd73676704ce1b Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 10 Aug 2020 21:26:41 +0100 Subject: [PATCH 3/5] Add lots of comments --- src/Ide/Plugin/ImportLens.hs | 89 ++++++++++++++++++++++++++---------- 1 file changed, 64 insertions(+), 25 deletions(-) diff --git a/src/Ide/Plugin/ImportLens.hs b/src/Ide/Plugin/ImportLens.hs index 54f3b2a46e..5157fd2953 100644 --- a/src/Ide/Plugin/ImportLens.hs +++ b/src/Ide/Plugin/ImportLens.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} @@ -22,13 +23,11 @@ import qualified Data.Text as T import Development.IDE.Core.RuleTypes (GhcSessionDeps (GhcSessionDeps), TcModuleResult (tmrModule), TypeCheck (TypeCheck)) -import Development.IDE.Core.Service (IdeState, runAction) import Development.IDE.Core.Shake (IdeAction, IdeState (..), - runIdeAction, useWithStaleFast, - use_) + runIdeAction, useWithStaleFast) import Development.IDE.GHC.Compat import Development.IDE.GHC.Error (realSpan, realSrcSpanToRange) -import Development.IDE.GHC.Util (hscEnv, prettyPrint) +import Development.IDE.GHC.Util (HscEnvEq, hscEnv, prettyPrint) import GHC.Generics (Generic) import Ide.Plugin import Ide.Types @@ -42,46 +41,64 @@ import TcRnTypes (TcGblEnv (tcg_used_gres)) 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: +-- | 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: +-- the provider should produce one code lens associated to the import statement: -- -- > import Data.List (intercalate, sortBy) - provider :: CodeLensProvider -provider _lspFuncs state pId CodeLensParams{..} - | TextDocumentIdentifier{_uri} <- _textDocument - , Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri +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 - Just (tmr, _) <- runIde state $ useWithStaleFast TypeCheck nfp - hsc <- hscEnv <$> runAction "importLens" state (use_ GhcSessionDeps nfp) - (imports, mbMinImports) <- extractMinimalImports hsc (tmrModule tmr) + -- Get the typechecking artifacts from the module, even if they are stale. + -- This is for responsiveness - we don't want our code lenses to vanish + -- just because there is a type error unrelated to the moduel imports. + -- However, if the user edits the imports while the module does not typecheck, + -- our code lenses will get out of sync + tmr <- runIde state $ useWithStaleFast TypeCheck nfp + -- We also need a GHC session with all the dependencies + hsc <- runIde state $ useWithStaleFast 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 ] @@ -93,41 +110,63 @@ provider _lspFuncs state pId CodeLensParams{..} | otherwise = return $ Right (List []) -extractMinimalImports :: HscEnv -> TypecheckedModule -> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn]) -extractMinimalImports hsc TypecheckedModule{..} = do +-- | Use the ghc api to extract a minimal, explicit set of imports for this module +extractMinimalImports + :: Maybe (HscEnvEq, a) + -> Maybe (TcModuleResult, b) + -> 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 - span = fromMaybe (error "expected real") $ realSpan loc - (_, minimalImports) <- initTcWithGbl hsc tcEnv span $ getMinimalImports usage + (_, 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 - commandArgs = Nothing - c <- mkLspCommand pId importCommandId title commandArgs - let _range :: Range = realSrcSpanToRange l + -- 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 - args = ImportCommandParams edit - _arguments = Just (List [toJSON args]) - _command = Just (c :: Command){_arguments} + -- 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 -> IdeAction a -> IO a runIde state = runIdeAction "importLens" (shakeExtras state) From b6cd60e3c751e00c79cced4f171ef3d678d04e92 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 10 Aug 2020 21:32:33 +0100 Subject: [PATCH 4/5] Add readme entry with imgur GIF I swear that it works for me... --- README.md | 4 ++++ 1 file changed, 4 insertions(+) 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 From 5bb9d8626a53b54d0f28bcf66f7c68cae997937d Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 10 Aug 2020 22:24:17 +0100 Subject: [PATCH 5/5] Dont use stale data for the import lenses Doesn't seem worth it --- src/Ide/Plugin/ImportLens.hs | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/src/Ide/Plugin/ImportLens.hs b/src/Ide/Plugin/ImportLens.hs index 5157fd2953..c8f2661f5b 100644 --- a/src/Ide/Plugin/ImportLens.hs +++ b/src/Ide/Plugin/ImportLens.hs @@ -23,8 +23,7 @@ import qualified Data.Text as T import Development.IDE.Core.RuleTypes (GhcSessionDeps (GhcSessionDeps), TcModuleResult (tmrModule), TypeCheck (TypeCheck)) -import Development.IDE.Core.Shake (IdeAction, IdeState (..), - runIdeAction, useWithStaleFast) +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) @@ -37,6 +36,8 @@ 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" @@ -85,14 +86,10 @@ provider _lspFuncs -- LSP functions, not used -- haskell-lsp provides conversion functions | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri = do - -- Get the typechecking artifacts from the module, even if they are stale. - -- This is for responsiveness - we don't want our code lenses to vanish - -- just because there is a type error unrelated to the moduel imports. - -- However, if the user edits the imports while the module does not typecheck, - -- our code lenses will get out of sync - tmr <- runIde state $ useWithStaleFast TypeCheck nfp + -- 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 $ useWithStaleFast GhcSessionDeps nfp + hsc <- runIde state $ use GhcSessionDeps nfp -- Use the GHC api to extract the "minimal" imports (imports, mbMinImports) <- extractMinimalImports hsc tmr @@ -112,10 +109,10 @@ provider _lspFuncs -- LSP functions, not used -- | Use the ghc api to extract a minimal, explicit set of imports for this module extractMinimalImports - :: Maybe (HscEnvEq, a) - -> Maybe (TcModuleResult, b) + :: Maybe (HscEnvEq) + -> Maybe (TcModuleResult) -> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn]) -extractMinimalImports (Just (hsc, _)) (Just (tmrModule -> TypecheckedModule{..}, _)) = do +extractMinimalImports (Just (hsc)) (Just (tmrModule -> TypecheckedModule{..})) = do -- extract the original imports and the typechecking environment let (tcEnv,_) = tm_internals_ Just (_, imports, _, _) = tm_renamed_source @@ -168,5 +165,5 @@ generateLens pId uri minImports (L src imp) = return Nothing -- | A helper to run ide actions -runIde :: IdeState -> IdeAction a -> IO a -runIde state = runIdeAction "importLens" (shakeExtras state) +runIde :: IdeState -> Action a -> IO a +runIde state = runAction "importLens" state