git.iko.soy/ghcide
on master help sign in
Add plugin type (#365)

* Add a plugin type * Add a helper to construct codeAction values * Remove a redundant $

commit331a144296923c91ec32aafa69b65e583bee1f39 authorNeil Mitchell <ndmitchell@gmail.com> dateSun 26 Jan 2020, 11:28 (7 years ago) parent556bebe
5 files changed+56−26
compare with master
unifiedsplit
exe/Main.hs+6−10 ghcide.cabal+1 src/Development/IDE/Plugin.hs+33 src/Development/IDE/Plugin/CodeAction.hs+11−13 src/Development/IDE/Plugin/Completions.hs+5−3
exe/Main.hs+6−10
@@ -28,8 +28,9 @@ import Development.IDE.Types.Diagnostics
2828import Development.IDE.Types.Options
2929import Development.IDE.Types.Logger
3030import Development.IDE.GHC.Util
31−import Development.IDE.Plugin.Completions
32−import Development.IDE.Plugin.CodeAction
31+import Development.IDE.Plugin
32+import Development.IDE.Plugin.Completions as Completions
33+import Development.IDE.Plugin.CodeAction as CodeAction
3334import qualified Data.Text as T
3435import qualified Data.Text.IO as T
3536import Language.Haskell.LSP.Messages
@@ -85,18 +86,13 @@ main = do
8586
8687 dir <- getCurrentDirectory
8788
88− let handlers =
89− setHandlersCompletion <>
90− setHandlersCodeAction <> setHandlersCodeLens
91− let rules = do
92− mainRule
93− produceCompletions
89+ let plugins = Completions.plugin <> CodeAction.plugin
9490
9591 if argLSP then do
9692 t <- offsetTime
9793 hPutStrLn stderr "Starting LSP server..."
9894 hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
99− runLanguageServer def handlers $ \getLspId event vfs caps -> do
95+ runLanguageServer def (pluginHandler plugins) $ \getLspId event vfs caps -> do
10096 t <- t
10197 hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
10298 -- very important we only call loadSession once, and it's fast, so just do it before starting
@@ -105,7 +101,7 @@ main = do
105101 { optReportProgress = clientSupportsProgress caps
106102 , optShakeProfiling = argsShakeProfiling
107103 }
108− initialise caps (rules >> action kick) getLspId event (logger minBound) options vfs
104+ initialise caps (mainRule >> pluginRules plugins >> action kick) getLspId event (logger minBound) options vfs
109105 else do
110106 putStrLn $ "Ghcide setup tester in " ++ dir ++ "."
111107 putStrLn "Report bugs at https://github.com/digital-asset/ghcide/issues"
ghcide.cabal+1
@@ -115,6 +115,7 @@ library
115115 Development.IDE.Types.Location
116116 Development.IDE.Types.Logger
117117 Development.IDE.Types.Options
118+ Development.IDE.Plugin
118119 Development.IDE.Plugin.Completions
119120 Development.IDE.Plugin.CodeAction
120121 other-modules:
src/Development/IDE/Plugin.hsnew file+33
@@ -0,0 +1,33 @@
1+
2+module Development.IDE.Plugin(Plugin(..), codeActionPlugin) where
3+
4+import Data.Default
5+import Development.Shake
6+import Development.IDE.LSP.Server
7+
8+import Language.Haskell.LSP.Types
9+import Development.IDE.Core.Rules
10+import qualified Language.Haskell.LSP.Core as LSP
11+import Language.Haskell.LSP.Messages
12+
13+
14+data Plugin = Plugin
15+ {pluginRules :: Rules ()
16+ ,pluginHandler :: PartialHandlers
17+ }
18+
19+instance Default Plugin where
20+ def = Plugin mempty def
21+
22+instance Semigroup Plugin where
23+ Plugin x1 y1 <> Plugin x2 y2 = Plugin (x1<>x2) (y1<>y2)
24+
25+instance Monoid Plugin where
26+ mempty = def
27+
28+
29+codeActionPlugin :: (LSP.LspFuncs () -> IdeState -> TextDocumentIdentifier -> Range -> CodeActionContext -> IO [CAResult]) -> Plugin
30+codeActionPlugin f = Plugin mempty $ PartialHandlers $ \WithMessage{..} x -> return x{
31+ LSP.codeActionHandler = withResponse RspCodeAction g
32+ }
33+ where g lsp state (CodeActionParams a b c _) = List <$> f lsp state a b c
src/Development/IDE/Plugin/CodeAction.hs+11−13
@@ -6,13 +6,11 @@
66#include "ghc-api-version.h"
77
88-- | Go to the definition of a variable.
9−module Development.IDE.Plugin.CodeAction
10− ( setHandlersCodeAction
11− , setHandlersCodeLens
12− ) where
9+module Development.IDE.Plugin.CodeAction(plugin) where
1310
1411import Language.Haskell.LSP.Types
1512import Control.Monad (join)
13+import Development.IDE.Plugin
1614import Development.IDE.GHC.Compat
1715import Development.IDE.Core.Rules
1816import Development.IDE.Core.RuleTypes
@@ -38,13 +36,18 @@ import Text.Regex.TDFA ((=~), (=~~))
3836import Text.Regex.TDFA.Text()
3937import Outputable (ppr, showSDocUnsafe)
4038
39+plugin :: Plugin
40+plugin = codeActionPlugin codeAction <> Plugin mempty setHandlersCodeLens
41+
4142-- | Generate code actions.
4243codeAction
4344 :: LSP.LspFuncs ()
4445 -> IdeState
45− -> CodeActionParams
46− -> IO (List CAResult)
47−codeAction lsp state CodeActionParams{_textDocument=TextDocumentIdentifier uri,_context=CodeActionContext{_diagnostics=List xs}} = do
46+ -> TextDocumentIdentifier
47+ -> Range
48+ -> CodeActionContext
49+ -> IO [CAResult]
50+codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List xs} = do
4851 -- disable logging as its quite verbose
4952 -- logInfo (ideLogger ide) $ T.pack $ "Code action req: " ++ show arg
5053 contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
@@ -52,7 +55,7 @@ codeAction lsp state CodeActionParams{_textDocument=TextDocumentIdentifier uri,_
5255 (ideOptions, parsedModule) <- runAction state $
5356 (,) <$> getIdeOptions
5457 <*> (getParsedModule . toNormalizedFilePath) `traverse` uriToFilePath uri
55− pure $ List
58+ pure
5659 [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
5760 | x <- xs, (title, tedit) <- suggestAction ideOptions ( join parsedModule ) text x
5861 , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
@@ -439,11 +442,6 @@ matchRegex message regex = case unifySpaces message =~~ regex of
439442 Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, bindings) -> Just bindings
440443 Nothing -> Nothing
441444
442−setHandlersCodeAction :: PartialHandlers
443−setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
444− LSP.codeActionHandler = withResponse RspCodeAction codeAction
445− }
446−
447445setHandlersCodeLens :: PartialHandlers
448446setHandlersCodeLens = PartialHandlers $ \WithMessage{..} x -> return x{
449447 LSP.codeLensHandler = withResponse RspCodeLens codeLens,
src/Development/IDE/Plugin/Completions.hs+5−3
@@ -1,8 +1,6 @@
11{-# LANGUAGE TypeFamilies #-}
22
3−module Development.IDE.Plugin.Completions (
4− setHandlersCompletion, produceCompletions
5−) where
3+module Development.IDE.Plugin.Completions(plugin) where
64
75import Language.Haskell.LSP.Messages
86import Language.Haskell.LSP.Types
@@ -15,6 +13,7 @@ import GHC.Generics
1513import Data.Maybe
1614import HscTypes
1715
16+import Development.IDE.Plugin
1817import Development.IDE.Core.Service
1918import Development.IDE.Plugin.Completions.Logic
2019import Development.IDE.Types.Location
@@ -26,6 +25,9 @@ import Development.IDE.LSP.Server
2625import Development.IDE.Import.DependencyInformation
2726
2827
28+plugin :: Plugin
29+plugin = Plugin produceCompletions setHandlersCompletion
30+
2931produceCompletions :: Rules ()
3032produceCompletions =
3133 define $ \ProduceCompletions file -> do