7
7
-- | Go to the definition of a variable.
8
8
9
9
module Development.IDE.Plugin.CodeAction
10
- ( descriptor
11
-
10
+ (
11
+ iePluginDescriptor ,
12
+ typeSigsPluginDescriptor ,
13
+ bindingsPluginDescriptor ,
14
+ fillHolePluginDescriptor
12
15
-- * For testing
13
16
, matchRegExMultipleImports
14
17
) where
@@ -18,7 +21,6 @@ import Bag (bagToList,
18
21
import Control.Applicative ((<|>) )
19
22
import Control.Arrow (second ,
20
23
(>>>) )
21
- import Control.Concurrent.Extra (readVar )
22
24
import Control.Monad (guard , join )
23
25
import Control.Monad.IO.Class
24
26
import Data.Char
@@ -39,21 +41,17 @@ import Data.Tuple.Extra (fst3)
39
41
import Development.IDE.Core.RuleTypes
40
42
import Development.IDE.Core.Rules
41
43
import Development.IDE.Core.Service
42
- import Development.IDE.Core.Shake
43
44
import Development.IDE.GHC.Compat
44
45
import Development.IDE.GHC.Error
45
- import Development.IDE.GHC.ExactPrint
46
46
import Development.IDE.GHC.Util (prettyPrint ,
47
47
printRdrName ,
48
48
unsafePrintSDoc )
49
49
import Development.IDE.Plugin.CodeAction.Args
50
50
import Development.IDE.Plugin.CodeAction.ExactPrint
51
51
import Development.IDE.Plugin.CodeAction.PositionIndexed
52
- import Development.IDE.Plugin.TypeLenses (GetGlobalBindingTypeSigs (GetGlobalBindingTypeSigs ),
53
- suggestSignature )
52
+ import Development.IDE.Plugin.TypeLenses (suggestSignature )
54
53
import Development.IDE.Spans.Common
55
54
import Development.IDE.Types.Exports
56
- import Development.IDE.Types.HscEnvEq
57
55
import Development.IDE.Types.Location
58
56
import Development.IDE.Types.Options
59
57
import qualified GHC.LanguageExtensions as Lang
@@ -79,12 +77,7 @@ import TcRnTypes (ImportAvails
79
77
import Text.Regex.TDFA (mrAfter ,
80
78
(=~) , (=~~) )
81
79
82
- descriptor :: PluginId -> PluginDescriptor IdeState
83
- descriptor plId =
84
- (defaultPluginDescriptor plId)
85
- { pluginRules = mempty ,
86
- pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction
87
- }
80
+ -------------------------------------------------------------------------------------------------
88
81
89
82
-- | Generate code actions.
90
83
codeAction
@@ -98,60 +91,53 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod
98
91
let text = Rope. toText . (_text :: VirtualFile -> Rope. Rope ) <$> contents
99
92
mbFile = toNormalizedFilePath' <$> uriToFilePath uri
100
93
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
113
95
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
123
97
<> 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
137
122
, wrap suggestFillTypeWildcard
138
- , wrap suggestFixConstructorImport
139
- , wrap suggestModuleTypo
140
- , wrap suggestReplaceIdentifier
141
123
, wrap removeRedundantConstraints
142
124
, wrap suggestAddTypeAnnotationToSatisfyContraints
143
125
, wrap suggestConstraint
126
+ ]
127
+
128
+ bindingsPluginDescriptor :: PluginId -> PluginDescriptor IdeState
129
+ bindingsPluginDescriptor =
130
+ mkGhcideCAsPlugin [
131
+ wrap suggestReplaceIdentifier
144
132
, wrap suggestImplicitParameter
145
- , wrap suggestHideShadow
146
133
, wrap suggestNewDefinition
147
- , wrap suggestNewImport
148
134
, wrap suggestDeleteUnusedBinding
149
- , wrap suggestExportUnusedTopBinding
150
- , wrap suggestFillHole -- Lowest priority
151
135
]
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
+ -------------------------------------------------------------------------------------------------
155
141
156
142
findSigOfDecl :: (IdP p -> Bool ) -> [LHsDecl p ] -> Maybe (Sig p )
157
143
findSigOfDecl pred decls =
0 commit comments