@@ -17,7 +17,6 @@ import qualified Data.HashMap.Strict as H
1717import qualified Data.Text as T
1818import Development.IDE as D
1919import qualified GHC.Generics as Generics
20- import Ide.Plugin
2120import Ide.Types
2221import Language.Haskell.LSP.Types
2322import qualified Language.Haskell.LSP.Types as J
@@ -32,19 +31,12 @@ import qualified Language.Haskell.LSP.VFS as VFS
3231
3332descriptor :: PluginId -> PluginDescriptor
3433descriptor plId = (defaultPluginDescriptor plId)
35- { pluginCommands = commands
36- , pluginCodeActionProvider = Just codeActionProvider
34+ { pluginCodeActionProvider = Just codeActionProvider
3735 , pluginCompletionProvider = Just completion
3836 }
3937
4038-- ---------------------------------------------------------------------
4139
42- commands :: [PluginCommand ]
43- commands = [ PluginCommand " addPragma" " add the given pragma" addPragmaCmd
44- ]
45-
46- -- ---------------------------------------------------------------------
47-
4840-- | Parameters for the addPragma PluginCommand.
4941data AddPragmaParams = AddPragmaParams
5042 { file :: J. Uri -- ^ Uri of the file to add the pragma to
@@ -56,9 +48,9 @@ data AddPragmaParams = AddPragmaParams
5648-- Pragma is added to the first line of the Uri.
5749-- It is assumed that the pragma name is a valid pragma,
5850-- thus, not validated.
59- addPragmaCmd :: CommandFunction AddPragmaParams
60- addPragmaCmd _lf _ide ( AddPragmaParams uri pragmaName) = do
61- let
51+ -- mkPragmaEdit :: CommandFunction AddPragmaParams
52+ mkPragmaEdit :: Uri -> T. Text -> WorkspaceEdit
53+ mkPragmaEdit uri pragmaName = res where
6254 pos = J. Position 0 0
6355 textEdits = J. List
6456 [J. TextEdit (J. Range pos pos)
@@ -67,33 +59,29 @@ addPragmaCmd _lf _ide (AddPragmaParams uri pragmaName) = do
6759 res = J. WorkspaceEdit
6860 (Just $ H. singleton uri textEdits)
6961 Nothing
70- return (Right Null , Just (WorkspaceApplyEdit , ApplyWorkspaceEditParams res))
7162
7263-- ---------------------------------------------------------------------
7364-- | Offer to add a missing Language Pragma to the top of a file.
7465-- Pragmas are defined by a curated list of known pragmas, see 'possiblePragmas'.
7566codeActionProvider :: CodeActionProvider
76- codeActionProvider _ state plId docId _ (J. CodeActionContext (J. List diags) _monly) = do
67+ codeActionProvider _ state _plId docId _ (J. CodeActionContext (J. List diags) _monly) = do
7768 let mFile = docId ^. J. uri & uriToFilePath <&> toNormalizedFilePath'
7869 pm <- fmap join $ runAction " addPragma" state $ getParsedModule `traverse` mFile
7970 let dflags = ms_hspp_opts . pm_mod_summary <$> pm
8071 -- Filter diagnostics that are from ghcmod
8172 ghcDiags = filter (\ d -> d ^. J. source == Just " typecheck" ) diags
8273 -- Get all potential Pragmas for all diagnostics.
8374 pragmas = concatMap (\ d -> genPragma dflags (d ^. J. message)) ghcDiags
84- -- cmds <- mapM mkCommand ("FooPragma":pragmas)
85- cmds <- mapM mkCommand pragmas
75+ cmds <- mapM mkCodeAction pragmas
8676 return $ Right $ List cmds
8777 where
88- mkCommand pragmaName = do
78+ mkCodeAction pragmaName = do
8979 let
90- -- | Code Action for the given command.
91- codeAction :: J. Command -> J. CAResult
92- codeAction cmd = J. CACodeAction $ J. CodeAction title (Just J. CodeActionQuickFix ) (Just (J. List [] )) Nothing (Just cmd)
80+ codeAction = J. CACodeAction $ J. CodeAction title (Just J. CodeActionQuickFix ) (Just (J. List [] )) (Just edit) Nothing
9381 title = " Add \" " <> pragmaName <> " \" "
94- cmdParams = [toJSON ( AddPragmaParams ( docId ^. J. uri) pragmaName)]
95- cmd <- mkLspCommand plId " addPragma " title ( Just cmdParams)
96- return $ codeAction cmd
82+ edit = mkPragmaEdit ( docId ^. J. uri) pragmaName
83+ return codeAction
84+
9785 genPragma mDynflags target
9886 | Just dynFlags <- mDynflags,
9987 -- GHC does not export 'OnOff', so we have to view it as string
0 commit comments