Skip to content

Commit 13a2cc2

Browse files
authored
Split ghcide actions into different descriptors (#1857)
* Split ghcide actions into different descriptors * Fix duplicate of suggestModuleTypo * Reformat
1 parent aa4bd29 commit 13a2cc2

File tree

3 files changed

+236
-274
lines changed

3 files changed

+236
-274
lines changed

ghcide/src/Development/IDE/Plugin/CodeAction.hs

Lines changed: 44 additions & 58 deletions
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,11 @@
77
-- | Go to the definition of a variable.
88

99
module Development.IDE.Plugin.CodeAction
10-
( descriptor
11-
10+
(
11+
iePluginDescriptor,
12+
typeSigsPluginDescriptor,
13+
bindingsPluginDescriptor,
14+
fillHolePluginDescriptor
1215
-- * For testing
1316
, matchRegExMultipleImports
1417
) where
@@ -18,7 +21,6 @@ import Bag (bagToList,
1821
import Control.Applicative ((<|>))
1922
import Control.Arrow (second,
2023
(>>>))
21-
import Control.Concurrent.Extra (readVar)
2224
import Control.Monad (guard, join)
2325
import Control.Monad.IO.Class
2426
import Data.Char
@@ -39,21 +41,17 @@ import Data.Tuple.Extra (fst3)
3941
import Development.IDE.Core.RuleTypes
4042
import Development.IDE.Core.Rules
4143
import Development.IDE.Core.Service
42-
import Development.IDE.Core.Shake
4344
import Development.IDE.GHC.Compat
4445
import Development.IDE.GHC.Error
45-
import Development.IDE.GHC.ExactPrint
4646
import Development.IDE.GHC.Util (prettyPrint,
4747
printRdrName,
4848
unsafePrintSDoc)
4949
import Development.IDE.Plugin.CodeAction.Args
5050
import Development.IDE.Plugin.CodeAction.ExactPrint
5151
import Development.IDE.Plugin.CodeAction.PositionIndexed
52-
import Development.IDE.Plugin.TypeLenses (GetGlobalBindingTypeSigs (GetGlobalBindingTypeSigs),
53-
suggestSignature)
52+
import Development.IDE.Plugin.TypeLenses (suggestSignature)
5453
import Development.IDE.Spans.Common
5554
import Development.IDE.Types.Exports
56-
import Development.IDE.Types.HscEnvEq
5755
import Development.IDE.Types.Location
5856
import Development.IDE.Types.Options
5957
import qualified GHC.LanguageExtensions as Lang
@@ -79,12 +77,7 @@ import TcRnTypes (ImportAvails
7977
import Text.Regex.TDFA (mrAfter,
8078
(=~), (=~~))
8179

82-
descriptor :: PluginId -> PluginDescriptor IdeState
83-
descriptor plId =
84-
(defaultPluginDescriptor plId)
85-
{ pluginRules = mempty,
86-
pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction
87-
}
80+
-------------------------------------------------------------------------------------------------
8881

8982
-- | Generate code actions.
9083
codeAction
@@ -98,60 +91,53 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod
9891
let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
9992
mbFile = toNormalizedFilePath' <$> uriToFilePath uri
10093
diag <- fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state
101-
(ideOptions, join -> parsedModule, join -> env, join -> annotatedPS, join -> tcM, join -> har, join -> bindings, join -> gblSigs) <- runAction "CodeAction" state $
102-
(,,,,,,,) <$> getIdeOptions
103-
<*> getParsedModule `traverse` mbFile
104-
<*> use GhcSession `traverse` mbFile
105-
<*> use GetAnnotatedParsedSource `traverse` mbFile
106-
<*> use TypeCheck `traverse` mbFile
107-
<*> use GetHieAst `traverse` mbFile
108-
<*> use GetBindings `traverse` mbFile
109-
<*> use GetGlobalBindingTypeSigs `traverse` mbFile
110-
-- This is quite expensive 0.6-0.7s on GHC
111-
pkgExports <- maybe mempty envPackageExports env
112-
localExports <- readVar (exportsMap $ shakeExtras state)
94+
(join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile
11395
let
114-
exportsMap = localExports <> pkgExports
115-
df = ms_hspp_opts . pm_mod_summary <$> parsedModule
116-
actions =
117-
[ mkCA title kind isPreferred [x] edit
118-
| x <- xs, (title, kind, isPreferred, tedit) <- suggestAction $ CodeActionArgs exportsMap ideOptions parsedModule text df annotatedPS tcM har bindings gblSigs x
119-
, let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing
120-
]
121-
actions' = caRemoveRedundantImports parsedModule text diag xs uri
122-
<> actions
96+
actions = caRemoveRedundantImports parsedModule text diag xs uri
12397
<> caRemoveInvalidExports parsedModule text diag xs uri
124-
pure $ Right $ List actions'
125-
126-
mkCA :: T.Text -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction)
127-
mkCA title kind isPreferred diags edit =
128-
InR $ CodeAction title kind (Just $ List diags) isPreferred Nothing (Just edit) Nothing Nothing
129-
130-
suggestAction :: CodeActionArgs -> GhcideCodeActions
131-
suggestAction caa =
132-
concat -- Order these suggestions by priority
133-
[ wrap $ suggestSignature True
134-
, wrap suggestExtendImport
135-
, wrap suggestImportDisambiguation
136-
, wrap suggestNewOrExtendImportForClassMethod
98+
pure $ Right $ List actions
99+
100+
-------------------------------------------------------------------------------------------------
101+
102+
iePluginDescriptor :: PluginId -> PluginDescriptor IdeState
103+
iePluginDescriptor plId =
104+
let old =
105+
mkGhcideCAsPlugin [
106+
wrap suggestExtendImport
107+
, wrap suggestImportDisambiguation
108+
, wrap suggestNewOrExtendImportForClassMethod
109+
, wrap suggestNewImport
110+
, wrap suggestModuleTypo
111+
, wrap suggestFixConstructorImport
112+
, wrap suggestHideShadow
113+
, wrap suggestExportUnusedTopBinding
114+
]
115+
plId
116+
in old {pluginHandlers = pluginHandlers old <> mkPluginHandler STextDocumentCodeAction codeAction}
117+
118+
typeSigsPluginDescriptor :: PluginId -> PluginDescriptor IdeState
119+
typeSigsPluginDescriptor =
120+
mkGhcideCAsPlugin [
121+
wrap $ suggestSignature True
137122
, wrap suggestFillTypeWildcard
138-
, wrap suggestFixConstructorImport
139-
, wrap suggestModuleTypo
140-
, wrap suggestReplaceIdentifier
141123
, wrap removeRedundantConstraints
142124
, wrap suggestAddTypeAnnotationToSatisfyContraints
143125
, wrap suggestConstraint
126+
]
127+
128+
bindingsPluginDescriptor :: PluginId -> PluginDescriptor IdeState
129+
bindingsPluginDescriptor =
130+
mkGhcideCAsPlugin [
131+
wrap suggestReplaceIdentifier
144132
, wrap suggestImplicitParameter
145-
, wrap suggestHideShadow
146133
, wrap suggestNewDefinition
147-
, wrap suggestNewImport
148134
, wrap suggestDeleteUnusedBinding
149-
, wrap suggestExportUnusedTopBinding
150-
, wrap suggestFillHole -- Lowest priority
151135
]
152-
where
153-
wrap :: ToCodeAction a => a -> GhcideCodeActions
154-
wrap = toCodeAction caa
136+
137+
fillHolePluginDescriptor :: PluginId -> PluginDescriptor IdeState
138+
fillHolePluginDescriptor = mkGhcideCAPlugin $ wrap suggestFillHole
139+
140+
-------------------------------------------------------------------------------------------------
155141

156142
findSigOfDecl :: (IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
157143
findSigOfDecl pred decls =

0 commit comments

Comments
 (0)