Skip to content

Commit 75f3c67

Browse files
pepeiborrapepeiborra
authored
Add a code action to make all imports explicit (#436)
1 parent 84a2274 commit 75f3c67

File tree

1 file changed

+207
-122
lines changed

1 file changed

+207
-122
lines changed

‎plugins/default/src/Ide/Plugin/ImportLens.hs‎

Lines changed: 207 additions & 122 deletions
Original file line numberDiff line numberDiff line change
@@ -1,68 +1,77 @@
1-
{-# LANGUAGE CPP #-}
2-
{-# LANGUAGE DeriveAnyClass #-}
3-
{-# LANGUAGE DeriveGeneric #-}
4-
{-# LANGUAGE DerivingStrategies #-}
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE DeriveAnyClass #-}
3+
{-# LANGUAGE DeriveGeneric #-}
4+
{-# LANGUAGE DerivingStrategies #-}
55
{-# LANGUAGE DuplicateRecordFields #-}
6-
{-# LANGUAGE LambdaCase #-}
7-
{-# LANGUAGE NamedFieldPuns #-}
8-
{-# LANGUAGE OverloadedStrings #-}
9-
{-# LANGUAGE RecordWildCards #-}
10-
{-# LANGUAGE ScopedTypeVariables #-}
11-
{-# LANGUAGE ViewPatterns #-}
6+
{-# LANGUAGE LambdaCase #-}
7+
{-# LANGUAGE NamedFieldPuns #-}
8+
{-# LANGUAGE OverloadedStrings #-}
9+
{-# LANGUAGE RecordWildCards #-}
10+
{-# LANGUAGE ScopedTypeVariables #-}
11+
{-# LANGUAGE TypeFamilies #-}
12+
{-# LANGUAGE ViewPatterns #-}
1213

1314
#include "ghc-api-version.h"
1415

1516
module Ide.Plugin.ImportLens (descriptor) where
16-
import Control.Monad (forM)
17-
import Data.Aeson (ToJSON)
18-
import Data.Aeson (Value (Null))
19-
import Data.Aeson (ToJSON (toJSON))
20-
import Data.Aeson.Types (FromJSON)
21-
import qualified Data.HashMap.Strict as HashMap
22-
import Data.IORef (readIORef)
23-
import Data.Map (Map)
24-
import qualified Data.Map.Strict as Map
25-
import Data.Maybe (catMaybes, fromMaybe)
26-
import qualified Data.Text as T
27-
import Development.IDE
28-
import Development.IDE.GHC.Compat
29-
import GHC.Generics (Generic)
30-
import Ide.Plugin
31-
import Ide.Types
32-
import Language.Haskell.LSP.Types
33-
import PrelNames (pRELUDE)
34-
import RnNames (findImportUsage,
35-
getMinimalImports)
36-
import TcRnMonad (initTcWithGbl)
37-
import TcRnTypes (TcGblEnv (tcg_used_gres))
17+
18+
import Control.DeepSeq
19+
import Control.Monad.IO.Class
20+
import Data.Aeson (ToJSON (toJSON), Value (Null))
21+
import Data.Aeson.Types (FromJSON)
22+
import qualified Data.HashMap.Strict as HashMap
23+
import Data.IORef (readIORef)
24+
import qualified Data.Map.Strict as Map
25+
import Data.Maybe (catMaybes, fromMaybe)
26+
import qualified Data.Text as T
27+
import Development.IDE
28+
import Development.IDE.Core.PositionMapping
29+
import Development.IDE.GHC.Compat
30+
import Development.Shake.Classes
31+
import GHC.Generics (Generic)
32+
import Ide.Plugin
33+
import Ide.Types
34+
import Language.Haskell.LSP.Types
35+
import PrelNames (pRELUDE)
36+
import RnNames
37+
( findImportUsage,
38+
getMinimalImports,
39+
)
40+
import TcRnMonad (initTcWithGbl)
41+
import TcRnTypes (TcGblEnv (tcg_used_gres))
3842

3943
importCommandId :: CommandId
4044
importCommandId = "ImportLensCommand"
4145

4246
-- | The "main" function of a plugin
4347
descriptor :: PluginId -> PluginDescriptor
44-
descriptor plId = (defaultPluginDescriptor plId) {
45-
-- This plugin provides code lenses
46-
pluginCodeLensProvider = Just provider,
47-
-- This plugin provides a command handler
48-
pluginCommands = [ importLensCommand ]
49-
}
48+
descriptor plId =
49+
(defaultPluginDescriptor plId)
50+
{ -- This plugin provides code lenses
51+
pluginCodeLensProvider = Just lensProvider,
52+
-- This plugin provides a command handler
53+
pluginCommands = [importLensCommand],
54+
-- This plugin provides code actions
55+
pluginCodeActionProvider = Just codeActionProvider,
56+
-- This plugin defines a new rule
57+
pluginRules = minimalImportsRule
58+
}
5059

5160
-- | The command descriptor
5261
importLensCommand :: PluginCommand
5362
importLensCommand =
54-
PluginCommand importCommandId "Explicit import command" runImportCommand
63+
PluginCommand importCommandId "Explicit import command" runImportCommand
5564

5665
-- | The type of the parameters accepted by our command
5766
data ImportCommandParams = ImportCommandParams WorkspaceEdit
58-
deriving Generic
67+
deriving (Generic)
5968
deriving anyclass (FromJSON, ToJSON)
6069

6170
-- | The actual command handler
6271
runImportCommand :: CommandFunction ImportCommandParams
6372
runImportCommand _lspFuncs _state (ImportCommandParams edit) = do
64-
-- This command simply triggers a workspace edit!
65-
return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams edit))
73+
-- This command simply triggers a workspace edit!
74+
return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams edit))
6675

6776
-- | For every implicit import statement, return a code lens of the corresponding explicit import
6877
-- Example - for the module below:
@@ -74,101 +83,173 @@ runImportCommand _lspFuncs _state (ImportCommandParams edit) = do
7483
-- the provider should produce one code lens associated to the import statement:
7584
--
7685
-- > import Data.List (intercalate, sortBy)
77-
provider :: CodeLensProvider
78-
provider _lspFuncs -- LSP functions, not used
79-
state -- ghcide state, used to retrieve typechecking artifacts
80-
pId -- plugin Id
81-
CodeLensParams{_textDocument = TextDocumentIdentifier{_uri}}
82-
-- VSCode uses URIs instead of file paths
83-
-- haskell-lsp provides conversion functions
84-
| Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri
85-
= do
86-
-- Get the typechecking artifacts from the module
87-
tmr <- runIde state $ useWithStale TypeCheck nfp
88-
-- We also need a GHC session with all the dependencies
89-
hsc <- runIde state $ useWithStale GhcSessionDeps nfp
90-
-- Use the GHC api to extract the "minimal" imports
91-
(imports, mbMinImports) <- extractMinimalImports (fst <$> hsc) ( fst <$> tmr)
92-
93-
case mbMinImports of
94-
-- Implement the provider logic:
95-
-- for every import, if it's lacking a explicit list, generate a code lens
96-
Just minImports -> do
97-
let minImportsMap =
98-
Map.fromList [ (srcSpanStart l, i) | L l i <- minImports ]
99-
commands <- forM imports $ generateLens pId _uri minImportsMap
86+
lensProvider :: CodeLensProvider
87+
lensProvider
88+
_lspFuncs -- LSP functions, not used
89+
state -- ghcide state, used to retrieve typechecking artifacts
90+
pId -- plugin Id
91+
CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}}
92+
-- VSCode uses URIs instead of file paths
93+
-- haskell-lsp provides conversion functions
94+
| Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri =
95+
do
96+
mbMinImports <- runAction "" state $ useWithStale MinimalImports nfp
97+
case mbMinImports of
98+
-- Implement the provider logic:
99+
-- for every import, if it's lacking a explicit list, generate a code lens
100+
Just (MinimalImportsResult minImports, posMapping) -> do
101+
commands <-
102+
sequence
103+
[ generateLens pId _uri edit
104+
| (imp, Just minImport) <- minImports,
105+
Just edit <- [mkExplicitEdit posMapping imp minImport]
106+
]
100107
return $ Right (List $ catMaybes commands)
101-
_ ->
108+
_ ->
102109
return $ Right (List [])
110+
| otherwise =
111+
return $ Right (List [])
112+
113+
-- | If there are any implicit imports, provide one code action to turn them all
114+
-- into explicit imports.
115+
codeActionProvider :: CodeActionProvider
116+
codeActionProvider _lspFuncs ideState _pId docId range _context
117+
| TextDocumentIdentifier {_uri} <- docId,
118+
Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri =
119+
do
120+
pm <- runIde ideState $ use GetParsedModule nfp
121+
let insideImport = case pm of
122+
Just ParsedModule {pm_parsed_source}
123+
| locImports <- hsmodImports (unLoc pm_parsed_source),
124+
rangesImports <- map getLoc locImports ->
125+
any (within range) rangesImports
126+
_ -> False
127+
if not insideImport
128+
then return (Right (List []))
129+
else do
130+
minImports <- runAction "MinimalImports" ideState $ use MinimalImports nfp
131+
let edits =
132+
[ e
133+
| (imp, Just explicit) <-
134+
maybe [] getMinimalImportsResult minImports,
135+
Just e <- [mkExplicitEdit zeroMapping imp explicit]
136+
]
137+
caExplicitImports = CACodeAction CodeAction {..}
138+
_title = "Make all imports explicit"
139+
_kind = Just CodeActionQuickFix
140+
_command = Nothing
141+
_edit = Just WorkspaceEdit {_changes, _documentChanges}
142+
_changes = Just $ HashMap.singleton _uri $ List edits
143+
_documentChanges = Nothing
144+
_diagnostics = Nothing
145+
return $ Right $ List [caExplicitImports | not (null edits)]
146+
| otherwise =
147+
return $ Right $ List []
148+
149+
--------------------------------------------------------------------------------
150+
151+
data MinimalImports = MinimalImports
152+
deriving (Show, Generic, Eq, Ord)
153+
154+
instance Hashable MinimalImports
155+
156+
instance NFData MinimalImports
157+
158+
instance Binary MinimalImports
159+
160+
type instance RuleResult MinimalImports = MinimalImportsResult
161+
162+
newtype MinimalImportsResult = MinimalImportsResult
163+
{getMinimalImportsResult :: [(LImportDecl GhcRn, Maybe T.Text)]}
164+
165+
instance Show MinimalImportsResult where show _ = "<minimalImportsResult>"
103166

104-
| otherwise
105-
= return $ Right (List [])
167+
instance NFData MinimalImportsResult where rnf = rwhnf
168+
169+
minimalImportsRule :: Rules ()
170+
minimalImportsRule = define $ \MinimalImports nfp -> do
171+
-- Get the typechecking artifacts from the module
172+
tmr <- use TypeCheck nfp
173+
-- We also need a GHC session with all the dependencies
174+
hsc <- use GhcSessionDeps nfp
175+
-- Use the GHC api to extract the "minimal" imports
176+
(imports, mbMinImports) <- liftIO $ extractMinimalImports hsc tmr
177+
let importsMap =
178+
Map.fromList
179+
[ (srcSpanStart l, T.pack (prettyPrint i))
180+
| L l i <- fromMaybe [] mbMinImports
181+
]
182+
res =
183+
[ (i, Map.lookup (srcSpanStart (getLoc i)) importsMap)
184+
| i <- imports
185+
]
186+
return ([], MinimalImportsResult res <$ mbMinImports)
187+
188+
--------------------------------------------------------------------------------
106189

107190
-- | Use the ghc api to extract a minimal, explicit set of imports for this module
108-
extractMinimalImports
109-
:: Maybe (HscEnvEq)
110-
-> Maybe (TcModuleResult)
111-
-> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
112-
extractMinimalImports (Just (hsc)) (Just (tmrModule -> TypecheckedModule{..})) = do
113-
-- extract the original imports and the typechecking environment
114-
let (tcEnv,_) = tm_internals_
115-
Just (_, imports, _, _) = tm_renamed_source
116-
ParsedModule{ pm_parsed_source = L loc _} = tm_parsed_module
117-
span = fromMaybe (error "expected real") $ realSpan loc
118-
119-
-- GHC is secretly full of mutable state
120-
gblElts <- readIORef (tcg_used_gres tcEnv)
121-
122-
-- call findImportUsage does exactly what we need
123-
-- GHC is full of treats like this
124-
let usage = findImportUsage imports gblElts
125-
(_, minimalImports) <- initTcWithGbl (hscEnv hsc) tcEnv span $ getMinimalImports usage
126-
127-
-- return both the original imports and the computed minimal ones
128-
return (imports, minimalImports)
191+
extractMinimalImports ::
192+
Maybe (HscEnvEq) ->
193+
Maybe (TcModuleResult) ->
194+
IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
195+
extractMinimalImports (Just (hsc)) (Just (tmrModule -> TypecheckedModule {..})) = do
196+
-- extract the original imports and the typechecking environment
197+
let (tcEnv, _) = tm_internals_
198+
Just (_, imports, _, _) = tm_renamed_source
199+
ParsedModule {pm_parsed_source = L loc _} = tm_parsed_module
200+
span = fromMaybe (error "expected real") $ realSpan loc
201+
202+
-- GHC is secretly full of mutable state
203+
gblElts <- readIORef (tcg_used_gres tcEnv)
129204

205+
-- call findImportUsage does exactly what we need
206+
-- GHC is full of treats like this
207+
let usage = findImportUsage imports gblElts
208+
(_, minimalImports) <- initTcWithGbl (hscEnv hsc) tcEnv span $ getMinimalImports usage
209+
210+
-- return both the original imports and the computed minimal ones
211+
return (imports, minimalImports)
130212
extractMinimalImports _ _ = return ([], Nothing)
131213

214+
mkExplicitEdit :: PositionMapping -> LImportDecl pass -> T.Text -> Maybe TextEdit
215+
mkExplicitEdit posMapping (L src imp) explicit
216+
-- Explicit import list case
217+
| ImportDecl {ideclHiding = Just (False, _)} <- imp =
218+
Nothing
219+
| not (isQualifiedImport imp),
220+
RealSrcSpan l <- src,
221+
L _ mn <- ideclName imp,
222+
-- (almost) no one wants to see an explicit import list for Prelude
223+
mn /= moduleName pRELUDE,
224+
Just rng <- toCurrentRange posMapping $ realSrcSpanToRange l =
225+
Just $ TextEdit rng explicit
226+
| otherwise =
227+
Nothing
228+
132229
-- | Given an import declaration, generate a code lens unless it has an
133230
-- explicit import list or it's qualified
134-
generateLens :: PluginId -> Uri -> Map SrcLoc (ImportDecl GhcRn) -> LImportDecl GhcRn -> IO (Maybe CodeLens)
135-
generateLens pId uri minImports (L src imp)
136-
-- Explicit import list case
137-
| ImportDecl{ideclHiding = Just (False,_)} <- imp
138-
= return Nothing
139-
-- Qualified case
140-
| isQualifiedImport imp
141-
= return Nothing
142-
-- No explicit import list
143-
| RealSrcSpan l <- src
144-
, Just explicit <- Map.lookup (srcSpanStart src) minImports
145-
, L _ mn <- ideclName imp
146-
-- (almost) no one wants to see an explicit import list for Prelude
147-
, mn /= moduleName pRELUDE
148-
= do
149-
-- The title of the command is just the minimal explicit import decl
150-
let title = T.pack $ prettyPrint explicit
151-
-- the range of the code lens is the span of the original import decl
152-
_range :: Range = realSrcSpanToRange l
153-
-- the code lens has no extra data
154-
_xdata = Nothing
155-
-- an edit that replaces the whole declaration with the explicit one
156-
edit = WorkspaceEdit (Just editsMap) Nothing
157-
editsMap = HashMap.fromList [(uri, List [importEdit])]
158-
importEdit = TextEdit _range title
159-
-- the command argument is simply the edit
160-
_arguments = Just [toJSON $ ImportCommandParams edit]
161-
-- create the command
162-
_command <- Just <$> mkLspCommand pId importCommandId title _arguments
163-
-- create and return the code lens
164-
return $ Just CodeLens{..}
165-
| otherwise
166-
= return Nothing
231+
generateLens :: PluginId -> Uri -> TextEdit -> IO (Maybe CodeLens)
232+
generateLens pId uri importEdit@TextEdit {_range} = do
233+
-- The title of the command is just the minimal explicit import decl
234+
let title = _newText importEdit
235+
-- the code lens has no extra data
236+
_xdata = Nothing
237+
-- an edit that replaces the whole declaration with the explicit one
238+
edit = WorkspaceEdit (Just editsMap) Nothing
239+
editsMap = HashMap.fromList [(uri, List [importEdit])]
240+
-- the command argument is simply the edit
241+
_arguments = Just [toJSON $ ImportCommandParams edit]
242+
-- create the command
243+
_command <- Just <$> mkLspCommand pId importCommandId title _arguments
244+
-- create and return the code lens
245+
return $ Just CodeLens {..}
167246

168247
-- | A helper to run ide actions
169248
runIde :: IdeState -> Action a -> IO a
170249
runIde state = runAction "importLens" state
171250

251+
--------------------------------------------------------------------------------
252+
172253
isQualifiedImport :: ImportDecl a -> Bool
173254
#if MIN_GHC_API_VERSION(8,10,0)
174255
isQualifiedImport ImportDecl{ideclQualified = NotQualified} = False
@@ -177,3 +258,7 @@ isQualifiedImport ImportDecl{} = True
177258
isQualifiedImport ImportDecl{ideclQualified} = ideclQualified
178259
#endif
179260
isQualifiedImport _ = False
261+
262+
within :: Range -> SrcSpan -> Bool
263+
within (Range start end) span =
264+
isInsideSrcSpan start span || isInsideSrcSpan end span

0 commit comments

Comments
 (0)