git.iko.soy/ghcide
on master help sign in
Add plugin type (#365)
331a144Neil Mitchell
exe/Main.hs+6−10
compare with master
unifiedsplit
@@ -28,8 +28,9 @@ import Development.IDE.Types.Diagnostics
28import Development.IDE.Types.Options
28import Development.IDE.Types.Options
29import Development.IDE.Types.Logger
29import Development.IDE.Types.Logger
30import Development.IDE.GHC.Util
30import Development.IDE.GHC.Util
31−import Development.IDE.Plugin.Completions
31+import Development.IDE.Plugin
32+import Development.IDE.Plugin.Completions as Completions
32−import Development.IDE.Plugin.CodeAction
33+import Development.IDE.Plugin.CodeAction as CodeAction
33import qualified Data.Text as T
34import qualified Data.Text as T
34import qualified Data.Text.IO as T
35import qualified Data.Text.IO as T
35import Language.Haskell.LSP.Messages
36import Language.Haskell.LSP.Messages
@@ -85,18 +86,13 @@ main = do
85
86
86 dir <- getCurrentDirectory
87 dir <- getCurrentDirectory
87
88
88− let handlers =
89+ let plugins = Completions.plugin <> CodeAction.plugin
89− setHandlersCompletion <>
90− setHandlersCodeAction <> setHandlersCodeLens
91− let rules = do
92− mainRule
93− produceCompletions
94
90
95 if argLSP then do
91 if argLSP then do
96 t <- offsetTime
92 t <- offsetTime
97 hPutStrLn stderr "Starting LSP server..."
93 hPutStrLn stderr "Starting LSP server..."
98 hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
94 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
100 t <- t
96 t <- t
101 hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
97 hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
102 -- very important we only call loadSession once, and it's fast, so just do it before starting
98 -- very important we only call loadSession once, and it's fast, so just do it before starting
@@ -105,7 +101,7 @@ main = do
105 { optReportProgress = clientSupportsProgress caps
101 { optReportProgress = clientSupportsProgress caps
106 , optShakeProfiling = argsShakeProfiling
102 , optShakeProfiling = argsShakeProfiling
107 }
103 }
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
109 else do
105 else do
110 putStrLn $ "Ghcide setup tester in " ++ dir ++ "."
106 putStrLn $ "Ghcide setup tester in " ++ dir ++ "."
111 putStrLn "Report bugs at https://github.com/digital-asset/ghcide/issues"
107 putStrLn "Report bugs at https://github.com/digital-asset/ghcide/issues"
ghcide.cabal+1
@@ -115,6 +115,7 @@ library
115 Development.IDE.Types.Location
115 Development.IDE.Types.Location
116 Development.IDE.Types.Logger
116 Development.IDE.Types.Logger
117 Development.IDE.Types.Options
117 Development.IDE.Types.Options
118+ Development.IDE.Plugin
118 Development.IDE.Plugin.Completions
119 Development.IDE.Plugin.Completions
119 Development.IDE.Plugin.CodeAction
120 Development.IDE.Plugin.CodeAction
120 other-modules:
121 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 @@
6#include "ghc-api-version.h"
6#include "ghc-api-version.h"
7
7
8-- | Go to the definition of a variable.
8-- | Go to the definition of a variable.
9−module Development.IDE.Plugin.CodeAction
9+module Development.IDE.Plugin.CodeAction(plugin) where
10− ( setHandlersCodeAction
11− , setHandlersCodeLens
12− ) where
13
10
14import Language.Haskell.LSP.Types
11import Language.Haskell.LSP.Types
15import Control.Monad (join)
12import Control.Monad (join)
13+import Development.IDE.Plugin
16import Development.IDE.GHC.Compat
14import Development.IDE.GHC.Compat
17import Development.IDE.Core.Rules
15import Development.IDE.Core.Rules
18import Development.IDE.Core.RuleTypes
16import Development.IDE.Core.RuleTypes
@@ -38,13 +36,18 @@ import Text.Regex.TDFA ((=~), (=~~))
38import Text.Regex.TDFA.Text()
36import Text.Regex.TDFA.Text()
39import Outputable (ppr, showSDocUnsafe)
37import Outputable (ppr, showSDocUnsafe)
40
38
39+plugin :: Plugin
40+plugin = codeActionPlugin codeAction <> Plugin mempty setHandlersCodeLens
41+
41-- | Generate code actions.
42-- | Generate code actions.
42codeAction
43codeAction
43 :: LSP.LspFuncs ()
44 :: LSP.LspFuncs ()
44 -> IdeState
45 -> IdeState
45− -> CodeActionParams
46+ -> TextDocumentIdentifier
47+ -> Range
48+ -> CodeActionContext
46− -> IO (List CAResult)
49+ -> IO [CAResult]
47−codeAction lsp state CodeActionParams{_textDocument=TextDocumentIdentifier uri,_context=CodeActionContext{_diagnostics=List xs}} = do
50+codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List xs} = do
48 -- disable logging as its quite verbose
51 -- disable logging as its quite verbose
49 -- logInfo (ideLogger ide) $ T.pack $ "Code action req: " ++ show arg
52 -- logInfo (ideLogger ide) $ T.pack $ "Code action req: " ++ show arg
50 contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
53 contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
@@ -52,7 +55,7 @@ codeAction lsp state CodeActionParams{_textDocument=TextDocumentIdentifier uri,_
52 (ideOptions, parsedModule) <- runAction state $
55 (ideOptions, parsedModule) <- runAction state $
53 (,) <$> getIdeOptions
56 (,) <$> getIdeOptions
54 <*> (getParsedModule . toNormalizedFilePath) `traverse` uriToFilePath uri
57 <*> (getParsedModule . toNormalizedFilePath) `traverse` uriToFilePath uri
55− pure $ List
58+ pure
56 [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
59 [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
57 | x <- xs, (title, tedit) <- suggestAction ideOptions ( join parsedModule ) text x
60 | x <- xs, (title, tedit) <- suggestAction ideOptions ( join parsedModule ) text x
58 , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
61 , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
@@ -439,11 +442,6 @@ matchRegex message regex = case unifySpaces message =~~ regex of
439 Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, bindings) -> Just bindings
442 Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, bindings) -> Just bindings
440 Nothing -> Nothing
443 Nothing -> Nothing
441
444
442−setHandlersCodeAction :: PartialHandlers
443−setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
444− LSP.codeActionHandler = withResponse RspCodeAction codeAction
445− }
446−
447setHandlersCodeLens :: PartialHandlers
445setHandlersCodeLens :: PartialHandlers
448setHandlersCodeLens = PartialHandlers $ \WithMessage{..} x -> return x{
446setHandlersCodeLens = PartialHandlers $ \WithMessage{..} x -> return x{
449 LSP.codeLensHandler = withResponse RspCodeLens codeLens,
447 LSP.codeLensHandler = withResponse RspCodeLens codeLens,
src/Development/IDE/Plugin/Completions.hs+5−3
@@ -1,8 +1,6 @@
1{-# LANGUAGE TypeFamilies #-}
1{-# LANGUAGE TypeFamilies #-}
2
2
3−module Development.IDE.Plugin.Completions (
3+module Development.IDE.Plugin.Completions(plugin) where
4− setHandlersCompletion, produceCompletions
5−) where
6
4
7import Language.Haskell.LSP.Messages
5import Language.Haskell.LSP.Messages
8import Language.Haskell.LSP.Types
6import Language.Haskell.LSP.Types
@@ -15,6 +13,7 @@ import GHC.Generics
15import Data.Maybe
13import Data.Maybe
16import HscTypes
14import HscTypes
17
15
16+import Development.IDE.Plugin
18import Development.IDE.Core.Service
17import Development.IDE.Core.Service
19import Development.IDE.Plugin.Completions.Logic
18import Development.IDE.Plugin.Completions.Logic
20import Development.IDE.Types.Location
19import Development.IDE.Types.Location
@@ -26,6 +25,9 @@ import Development.IDE.LSP.Server
26import Development.IDE.Import.DependencyInformation
25import Development.IDE.Import.DependencyInformation
27
26
28
27
28+plugin :: Plugin
29+plugin = Plugin produceCompletions setHandlersCompletion
30+
29produceCompletions :: Rules ()
31produceCompletions :: Rules ()
30produceCompletions =
32produceCompletions =
31 define $ \ProduceCompletions file -> do
33 define $ \ProduceCompletions file -> do