Skip to content

Commit d40753b

Browse files
wz1000wz1000
committed
port default plugins
1 parent a60921c commit d40753b

File tree

8 files changed

+117
-135
lines changed

8 files changed

+117
-135
lines changed

‎plugins/default/src/Ide/Plugin/Example.hs

Lines changed: 26 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,8 @@
77
{-# LANGUAGE OverloadedStrings #-}
88
{-# LANGUAGE TupleSections #-}
99
{-# LANGUAGE TypeFamilies #-}
10+
{-# LANGUAGE DataKinds #-}
11+
{-# LANGUAGE RecordWildCards #-}
1012

1113
module Ide.Plugin.Example
1214
(
@@ -30,25 +32,27 @@ import GHC.Generics
3032
import Ide.PluginUtils
3133
import Ide.Types
3234
import Language.LSP.Types
35+
import Language.LSP.Server
3336
import Text.Regex.TDFA.Text()
37+
import Control.Monad.IO.Class
3438

3539
-- ---------------------------------------------------------------------
3640

3741
descriptor :: PluginId -> PluginDescriptor IdeState
3842
descriptor plId = (defaultPluginDescriptor plId)
3943
{ pluginRules = exampleRules
4044
, pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd]
41-
, pluginCodeActionProvider = Just codeAction
42-
, pluginCodeLensProvider = Just codeLens
43-
, pluginHoverProvider = Just hover
44-
, pluginSymbolsProvider = Just symbols
45-
, pluginCompletionProvider = Just completion
45+
, pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction
46+
<> mkPluginHandler STextDocumentCodeLens codeLens
47+
<> mkPluginHandler STextDocumentHover hover
48+
<> mkPluginHandler STextDocumentDocumentSymbol symbols
49+
<> mkPluginHandler STextDocumentCompletion completion
4650
}
4751

4852
-- ---------------------------------------------------------------------
4953

50-
hover :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))
51-
hover = request "Hover" blah (Right Nothing) foundHover
54+
hover :: PluginMethodHandler IdeState TextDocumentHover
55+
hover ide _ HoverParams{..} = liftIO $ request "Hover" blah (Right Nothing) foundHover ide TextDocumentPositionParams{..}
5256

5357
blah :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.Text]))
5458
blah _ (Position line col)
@@ -99,8 +103,8 @@ mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)
99103
-- ---------------------------------------------------------------------
100104

101105
-- | Generate code actions.
102-
codeAction :: CodeActionProvider IdeState
103-
codeAction _lf state _pid (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs} = do
106+
codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction
107+
codeAction state _pid (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs}) = liftIO $ do
104108
let Just nfp = uriToNormalizedFilePath $ toNormalizedUri uri
105109
Just (ParsedModule{},_) <- runIdeAction "example" (shakeExtras state) $ useWithStaleFast GetParsedModule nfp
106110
let
@@ -109,12 +113,12 @@ codeAction _lf state _pid (TextDocumentIdentifier uri) _range CodeActionContext{
109113
"-- TODO1 added by Example Plugin directly\n"]
110114
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
111115
pure $ Right $ List
112-
[ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) (Just edit) Nothing ]
116+
[ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing]
113117

114118
-- ---------------------------------------------------------------------
115119

116-
codeLens :: CodeLensProvider IdeState
117-
codeLens _lf ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do
120+
codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens
121+
codeLens ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ do
118122
logInfo (ideLogger ideState) "Example.codeLens entered (ideLogger)" -- AZ
119123
case uriToFilePath' uri of
120124
Just (toNormalizedFilePath -> filePath) -> do
@@ -141,7 +145,7 @@ data AddTodoParams = AddTodoParams
141145
deriving (Show, Eq, Generic, ToJSON, FromJSON)
142146

143147
addTodoCmd :: CommandFunction IdeState AddTodoParams
144-
addTodoCmd _lf _ide (AddTodoParams uri todoText) = do
148+
addTodoCmd _ide (AddTodoParams uri todoText) = do
145149
let
146150
pos = Position 3 0
147151
textEdits = List
@@ -151,7 +155,8 @@ addTodoCmd _lf _ide (AddTodoParams uri todoText) = do
151155
res = WorkspaceEdit
152156
(Just $ Map.singleton uri textEdits)
153157
Nothing
154-
return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res))
158+
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing res) (\_ -> pure ())
159+
return $ Right Null
155160

156161
-- ---------------------------------------------------------------------
157162

@@ -170,7 +175,7 @@ request
170175
-> IdeState
171176
-> TextDocumentPositionParams
172177
-> IO (Either ResponseError b)
173-
request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos _) = do
178+
request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos) = do
174179
mbResult <- case uriToFilePath' uri of
175180
Just path -> logAndRunRequest label getResults ide pos path
176181
Nothing -> pure Nothing
@@ -187,9 +192,9 @@ logAndRunRequest label getResults ide pos path = do
187192

188193
-- ---------------------------------------------------------------------
189194

190-
symbols :: SymbolsProvider IdeState
191-
symbols _lf _ide (DocumentSymbolParams _doc _mt)
192-
= pure $ Right [r]
195+
symbols :: PluginMethodHandler IdeState TextDocumentDocumentSymbol
196+
symbols _ide _pid (DocumentSymbolParams _ _ _doc)
197+
= pure $ Right $ InL $ List [r]
193198
where
194199
r = DocumentSymbol name detail kind deprecation range selR chList
195200
name = "Example_symbol_name"
@@ -202,9 +207,9 @@ symbols _lf _ide (DocumentSymbolParams _doc _mt)
202207

203208
-- ---------------------------------------------------------------------
204209

205-
completion :: CompletionProvider IdeState
206-
completion _lf _ide (CompletionParams _doc _pos _mctxt _mt)
207-
= pure $ Right $ Completions $ List [r]
210+
completion :: PluginMethodHandler IdeState TextDocumentCompletion
211+
completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt)
212+
= pure $ Right $ InL $ List [r]
208213
where
209214
r = CompletionItem label kind tags detail documentation deprecated preselect
210215
sortText filterText insertText insertTextFormat

‎plugins/default/src/Ide/Plugin/Example2.hs

Lines changed: 26 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,8 @@
77
{-# LANGUAGE OverloadedStrings #-}
88
{-# LANGUAGE TupleSections #-}
99
{-# LANGUAGE TypeFamilies #-}
10+
{-# LANGUAGE DataKinds #-}
11+
{-# LANGUAGE RecordWildCards #-}
1012

1113
module Ide.Plugin.Example2
1214
(
@@ -29,25 +31,27 @@ import GHC.Generics
2931
import Ide.PluginUtils
3032
import Ide.Types
3133
import Language.LSP.Types
34+
import Language.LSP.Server
3235
import Text.Regex.TDFA.Text()
36+
import Control.Monad.IO.Class
3337

3438
-- ---------------------------------------------------------------------
3539

3640
descriptor :: PluginId -> PluginDescriptor IdeState
3741
descriptor plId = (defaultPluginDescriptor plId)
3842
{ pluginRules = exampleRules
3943
, pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd]
40-
, pluginCodeActionProvider = Just codeAction
41-
, pluginCodeLensProvider = Just codeLens
42-
, pluginHoverProvider = Just hover
43-
, pluginSymbolsProvider = Just symbols
44-
, pluginCompletionProvider = Just completion
44+
, pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction
45+
<> mkPluginHandler STextDocumentCodeLens codeLens
46+
<> mkPluginHandler STextDocumentHover hover
47+
<> mkPluginHandler STextDocumentDocumentSymbol symbols
48+
<> mkPluginHandler STextDocumentCompletion completion
4549
}
4650

4751
-- ---------------------------------------------------------------------
4852

49-
hover :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))
50-
hover = request "Hover" blah (Right Nothing) foundHover
53+
hover :: PluginMethodHandler IdeState TextDocumentHover
54+
hover ide _ HoverParams{..} = liftIO $ request "Hover" blah (Right Nothing) foundHover ide TextDocumentPositionParams{..}
5155

5256
blah :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.Text]))
5357
blah _ (Position line col)
@@ -98,20 +102,20 @@ mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)
98102
-- ---------------------------------------------------------------------
99103

100104
-- | Generate code actions.
101-
codeAction :: CodeActionProvider IdeState
102-
codeAction _lf _state _pid (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs} = do
105+
codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction
106+
codeAction _state _pid (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs}) = do
103107
let
104108
title = "Add TODO2 Item"
105109
tedit = [TextEdit (Range (Position 3 0) (Position 3 0))
106110
"-- TODO2 added by Example2 Plugin directly\n"]
107111
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
108112
pure $ Right $ List
109-
[ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) (Just edit) Nothing ]
113+
[ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing ]
110114

111115
-- ---------------------------------------------------------------------
112116

113-
codeLens :: CodeLensProvider IdeState
114-
codeLens _lf ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do
117+
codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens
118+
codeLens ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ do
115119
logInfo (ideLogger ideState) "Example2.codeLens entered (ideLogger)" -- AZ
116120
case uriToFilePath' uri of
117121
Just (toNormalizedFilePath -> filePath) -> do
@@ -135,7 +139,7 @@ data AddTodoParams = AddTodoParams
135139
deriving (Show, Eq, Generic, ToJSON, FromJSON)
136140

137141
addTodoCmd :: CommandFunction IdeState AddTodoParams
138-
addTodoCmd _lf _ide (AddTodoParams uri todoText) = do
142+
addTodoCmd _ide (AddTodoParams uri todoText) = do
139143
let
140144
pos = Position 5 0
141145
textEdits = List
@@ -145,7 +149,8 @@ addTodoCmd _lf _ide (AddTodoParams uri todoText) = do
145149
res = WorkspaceEdit
146150
(Just $ Map.singleton uri textEdits)
147151
Nothing
148-
return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res))
152+
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing res) (\_ -> pure ())
153+
return $ Right Null
149154

150155
-- ---------------------------------------------------------------------
151156

@@ -164,7 +169,7 @@ request
164169
-> IdeState
165170
-> TextDocumentPositionParams
166171
-> IO (Either ResponseError b)
167-
request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos _) = do
172+
request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos) = do
168173
mbResult <- case uriToFilePath' uri of
169174
Just path -> logAndRunRequest label getResults ide pos path
170175
Nothing -> pure Nothing
@@ -181,9 +186,9 @@ logAndRunRequest label getResults ide pos path = do
181186

182187
-- ---------------------------------------------------------------------
183188

184-
symbols :: SymbolsProvider IdeState
185-
symbols _lf _ide (DocumentSymbolParams _doc _mt)
186-
= pure $ Right [r]
189+
symbols :: PluginMethodHandler IdeState TextDocumentDocumentSymbol
190+
symbols _ide _ (DocumentSymbolParams _ _ _doc)
191+
= pure $ Right $ InL $ List [r]
187192
where
188193
r = DocumentSymbol name detail kind deprecation range selR chList
189194
name = "Example2_symbol_name"
@@ -196,9 +201,9 @@ symbols _lf _ide (DocumentSymbolParams _doc _mt)
196201

197202
-- ---------------------------------------------------------------------
198203

199-
completion :: CompletionProvider IdeState
200-
completion _lf _ide (CompletionParams _doc _pos _mctxt _mt)
201-
= pure $ Right $ Completions $ List [r]
204+
completion :: PluginMethodHandler IdeState TextDocumentCompletion
205+
completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt)
206+
= pure $ Right $ InL $ List [r]
202207
where
203208
r = CompletionItem label kind tags detail documentation deprecated preselect
204209
sortText filterText insertText insertTextFormat

‎plugins/default/src/Ide/Plugin/Floskell.hs

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11,27 +11,28 @@ where
1111
import qualified Data.ByteString.Lazy as BS
1212
import qualified Data.Text as T
1313
import qualified Data.Text.Encoding as T
14-
import Development.IDE as D
14+
import Development.IDE as D hiding (pluginHandlers)
1515
import Floskell
1616
import Ide.PluginUtils
1717
import Ide.Types
1818
import Language.LSP.Types
1919
import Text.Regex.TDFA.Text()
20+
import Control.Monad.IO.Class
2021

2122
-- ---------------------------------------------------------------------
2223

2324
descriptor :: PluginId -> PluginDescriptor IdeState
2425
descriptor plId = (defaultPluginDescriptor plId)
25-
{ pluginFormattingProvider = Just provider
26+
{ pluginHandlers = mkFormattingHandlers provider
2627
}
2728

2829
-- ---------------------------------------------------------------------
2930

3031
-- | Format provider of Floskell.
3132
-- Formats the given source in either a given Range or the whole Document.
3233
-- If the provider fails an error is returned that can be displayed to the user.
33-
provider :: FormattingProvider IdeState IO
34-
provider _lf _ideState typ contents fp _ = do
34+
provider :: FormattingHandler IdeState
35+
provider _ideState typ contents fp _ = liftIO $ do
3536
let file = fromNormalizedFilePath fp
3637
config <- findConfigOrDefault file
3738
let (range, selectedContents) = case typ of

‎plugins/default/src/Ide/Plugin/Fourmolu.hs

Lines changed: 15 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ import System.FilePath
1515

1616
import Control.Lens ((^.))
1717
import qualified Data.Text as T
18-
import Development.IDE as D
18+
import Development.IDE as D hiding (pluginHandlers)
1919
import qualified DynFlags as D
2020
import qualified EnumSet as S
2121
import GHC (DynFlags, moduleNameString)
@@ -28,23 +28,24 @@ import Language.LSP.Server
2828
import Language.LSP.Types
2929
import Language.LSP.Types.Lens
3030
import "fourmolu" Ormolu
31+
import Control.Monad.IO.Class
3132

3233
-- ---------------------------------------------------------------------
3334

3435
descriptor :: PluginId -> PluginDescriptor IdeState
3536
descriptor plId =
3637
(defaultPluginDescriptor plId)
37-
{ pluginFormattingProvider = Just provider
38+
{ pluginHandlers = mkFormattingHandlers provider
3839
}
3940

4041
-- ---------------------------------------------------------------------
4142

42-
provider :: FormattingProvider IdeState IO
43-
provider lf ideState typ contents fp fo = withIndefiniteProgress lf title Cancellable $ do
44-
ghc <- runAction "Fourmolu" ideState $ use GhcSession fp
43+
provider :: FormattingHandler IdeState
44+
provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do
45+
ghc <- liftIO $ runAction "Fourmolu" ideState $ use GhcSession fp
4546
fileOpts <- case hsc_dflags . hscEnv <$> ghc of
4647
Nothing -> return []
47-
Just df -> convertDynFlags df
48+
Just df -> liftIO $ convertDynFlags df
4849

4950
let format printerOpts =
5051
mapLeft (responseError . ("Fourmolu: " <>) . T.pack . show)
@@ -61,29 +62,22 @@ provider lf ideState typ contents fp fo = withIndefiniteProgress lf title Cancel
6162
defaultPrinterOpts
6263
}
6364

64-
loadConfigFile fp' >>= \case
65-
ConfigLoaded file opts -> do
65+
liftIO (loadConfigFile fp') >>= \case
66+
ConfigLoaded file opts -> liftIO $ do
6667
putStrLn $ "Loaded Fourmolu config from: " <> file
6768
format opts
68-
ConfigNotFound searchDirs -> do
69+
ConfigNotFound searchDirs -> liftIO $ do
6970
putStrLn
7071
. unlines
7172
$ ("No " ++ show configFileName ++ " found in any of:") :
7273
map (" " ++) searchDirs
7374
format mempty
7475
ConfigParseError f (_, err) -> do
75-
sendFunc lf . ReqShowMessage $
76-
RequestMessage
77-
{ _jsonrpc = ""
78-
, _id = IdString "fourmolu"
79-
, _method = WindowShowMessageRequest
80-
, _params =
81-
ShowMessageRequestParams
82-
{ _xtype = MtError
83-
, _message = errorMessage
84-
, _actions = Nothing
85-
}
86-
}
76+
sendNotification SWindowShowMessage $
77+
ShowMessageParams
78+
{ _xtype = MtError
79+
, _message = errorMessage
80+
}
8781
return . Left $ responseError errorMessage
8882
where
8983
errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err

0 commit comments

Comments
 (0)