diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index d14023f349..882374a8bd 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -88,59 +88,48 @@ codeAction lsp state _ (TextDocumentIdentifier uri) _range CodeActionContext{_di df = ms_hspp_opts . pm_mod_summary <$> parsedModule actions = [ mkCA title [x] edit - | x <- xs, (title, tedit) <- suggestAction exportsMap ideOptions parsedModule text x + | x <- xs, (title, tedit) <- suggestAction exportsMap ideOptions parsedModule text df annotatedPS x , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing ] - actions' = - [mkCA title [x] edit - | x <- xs - , Just ps <- [annotatedPS] - , Just dynflags <- [df] - , (title, graft) <- suggestExactAction exportsMap dynflags ps x - , Right edit <- - [ -- either (Left . traceShow) Right $ - rewriteToEdit dynflags uri (annsA ps) graft - ] - ] - actions'' = caRemoveRedundantImports parsedModule text diag xs uri + actions' = caRemoveRedundantImports parsedModule text diag xs uri <> actions - <> actions' <> caRemoveInvalidExports parsedModule text diag xs uri - pure $ Right $ List actions'' + pure $ Right $ List actions' mkCA :: T.Text -> [Diagnostic] -> WorkspaceEdit -> CAResult mkCA title diags edit = CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List diags) (Just edit) Nothing -suggestExactAction :: - ExportsMap -> - DynFlags -> - Annotated ParsedSource -> - Diagnostic -> - [(T.Text, Rewrite)] -suggestExactAction exportsMap df ps x = - concat - [ suggestConstraint df (astA ps) x - , suggestImplicitParameter (astA ps) x - , suggestExtendImport exportsMap (astA ps) x - ] +rewrite :: + Maybe DynFlags -> + Maybe (Annotated ParsedSource) -> + (DynFlags -> ParsedSource -> [(T.Text, Rewrite)]) -> + [(T.Text, [TextEdit])] +rewrite (Just df) (Just ps) f + | Right edit <- (traverse . traverse) (rewriteToEdit df (annsA ps)) (f df $ astA ps) = edit +rewrite _ _ _ = [] suggestAction :: ExportsMap -> IdeOptions -> Maybe ParsedModule -> Maybe T.Text + -> Maybe DynFlags + -> Maybe (Annotated ParsedSource) -> Diagnostic -> [(T.Text, [TextEdit])] -suggestAction packageExports ideOptions parsedModule text diag = concat +suggestAction packageExports ideOptions parsedModule text df annSource diag = concat -- Order these suggestions by priority [ suggestSignature True diag + , rewrite df annSource $ \_ ps -> suggestExtendImport packageExports ps diag , suggestFillTypeWildcard diag , suggestFixConstructorImport text diag , suggestModuleTypo diag , suggestReplaceIdentifier text diag , removeRedundantConstraints text diag , suggestAddTypeAnnotationToSatisfyContraints text diag + , rewrite df annSource $ \df ps -> suggestConstraint df ps diag + , rewrite df annSource $ \_ ps -> suggestImplicitParameter ps diag ] ++ concat [ suggestNewDefinition ideOptions pm text diag ++ suggestNewImport packageExports pm diag diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index a35c793c16..00b521b615 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -18,7 +18,6 @@ import Control.Monad import Control.Monad.Trans import Data.Data (Data) import Data.Functor -import qualified Data.HashMap.Strict as HMap import qualified Data.Map.Strict as Map import Data.Maybe (fromJust) import qualified Data.Text as T @@ -50,22 +49,15 @@ data Rewrite where -- | Convert a 'Rewrite' into a 'WorkspaceEdit'. rewriteToEdit :: DynFlags -> - Uri -> Anns -> Rewrite -> - Either String WorkspaceEdit -rewriteToEdit dflags uri anns (Rewrite dst f) = do + Either String [TextEdit] +rewriteToEdit dflags anns (Rewrite dst f) = do (ast, (anns, _), _) <- runTransformT anns $ f dflags - let editMap = - HMap.fromList - [ ( uri, - List - [ TextEdit (fromJust $ srcSpanToRange dst) $ + let editMap = [ TextEdit (fromJust $ srcSpanToRange dst) $ T.pack $ tail $ exactPrint ast anns ] - ) - ] - pure $ WorkspaceEdit (Just editMap) Nothing + pure editMap srcSpanToRange :: SrcSpan -> Maybe Range srcSpanToRange (UnhelpfulSpan _) = Nothing