Skip to content

Commit 3088e6d

Browse files
alanzalanz
committed
Starting to sketch out IDE-level plugin modularity
Address #25 Currently WIP
1 parent 9b77d33 commit 3088e6d

File tree

9 files changed

+429
-36
lines changed

9 files changed

+429
-36
lines changed

‎exe/Main.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -54,6 +54,7 @@ import System.Time.Extra
5454
import Development.IDE.Plugin.CodeAction as CodeAction
5555
import Development.IDE.Plugin.Completions as Completions
5656
import Ide.Plugin.Example as Example
57+
import Ide.Plugin.Example2 as Example2
5758
import Ide.Plugin.Floskell as Floskell
5859
import Ide.Plugin.Ormolu as Ormolu
5960

@@ -69,7 +70,8 @@ idePlugins includeExample
6970
CodeAction.plugin <>
7071
formatterPlugins [("ormolu", Ormolu.provider)
7172
,("floskell", Floskell.provider)] <>
72-
if includeExample then Example.plugin else mempty
73+
if includeExample then Example.plugin <> Example2.plugin
74+
else mempty
7375

7476
-- ---------------------------------------------------------------------
7577

‎haskell-language-server.cabal

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -28,11 +28,14 @@ source-repository head
2828
library
2929
exposed-modules:
3030
Ide.Cradle
31+
Ide.Plugin
3132
Ide.Plugin.Config
3233
Ide.Plugin.Example
34+
Ide.Plugin.Example2
3335
Ide.Plugin.Ormolu
3436
Ide.Plugin.Floskell
3537
Ide.Plugin.Formatter
38+
Ide.Types
3639
Ide.Version
3740
other-modules:
3841
Paths_haskell_language_server
@@ -176,10 +179,13 @@ test-suite func-test
176179
base >=4.7 && <5
177180
, aeson
178181
, data-default
182+
, haskell-lsp-types
179183
, hls-test-utils
184+
, hspec
185+
, lens
180186
, lsp-test >= 0.10.0.0
181187
, text
182-
, hspec
188+
, unordered-containers
183189
other-modules:
184190
-- CompletionSpec
185191
-- , CommandSpec
@@ -195,6 +201,7 @@ test-suite func-test
195201
-- , HieBiosSpec
196202
-- , HighlightSpec
197203
-- , HoverSpec
204+
, PluginSpec
198205
-- , ProgressSpec
199206
-- , ReferencesSpec
200207
-- , RenameSpec

‎src/Ide/Plugin.hs

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
{-# LANGUAGE GADTs #-}
2+
{-# LANGUAGE ScopedTypeVariables #-}
3+
4+
module Ide.Plugin
5+
(
6+
asGhcIdePlugin
7+
) where
8+
9+
import Data.Aeson hiding (defaultOptions)
10+
import qualified Data.Map as Map
11+
import qualified Data.Set as S
12+
import Data.String
13+
import qualified Data.Text as T
14+
import Data.Typeable
15+
import Development.IDE.Core.Rules
16+
import Development.IDE.Types.Diagnostics as D
17+
import Development.IDE.Types.Location
18+
import Language.Haskell.LSP.Types
19+
import Text.Regex.TDFA.Text()
20+
import Development.IDE.Plugin
21+
import Ide.Plugin.Config
22+
import Ide.Types
23+
24+
-- ---------------------------------------------------------------------
25+
26+
-- | Map a set of plugins to the underlying ghcide engine. Main point is
27+
-- IdePlugins are arranged by kind of operation, 'Plugin' is arranged by message
28+
-- category ('Notifaction', 'Request' etc).
29+
asGhcIdePlugin :: IdePlugins -> Plugin Config
30+
asGhcIdePlugin _ = Plugin mempty mempty
31+
32+
-- First strp will be to bring the machinery from Ide.Plugin.Formatter over.
33+
34+
-- ---------------------------------------------------------------------

‎src/Ide/Plugin/Example2.hs

Lines changed: 193 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,193 @@
1+
{-# LANGUAGE ViewPatterns #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE DuplicateRecordFields #-}
4+
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE FlexibleInstances #-}
6+
{-# LANGUAGE OverloadedStrings #-}
7+
{-# LANGUAGE RecordWildCards #-}
8+
{-# LANGUAGE TupleSections #-}
9+
{-# LANGUAGE TypeFamilies #-}
10+
11+
module Ide.Plugin.Example2
12+
(
13+
plugin
14+
) where
15+
16+
import Control.DeepSeq ( NFData )
17+
import Control.Monad.Trans.Maybe
18+
import Data.Aeson.Types (toJSON, fromJSON, Value(..), Result(..))
19+
import Data.Binary
20+
import Data.Functor
21+
import qualified Data.HashMap.Strict as Map
22+
import Data.Hashable
23+
import qualified Data.HashSet as HashSet
24+
import qualified Data.Text as T
25+
import Data.Typeable
26+
import Development.IDE.Core.OfInterest
27+
import Development.IDE.Core.Rules
28+
import Development.IDE.Core.RuleTypes
29+
import Development.IDE.Core.Service
30+
import Development.IDE.Core.Shake
31+
import Development.IDE.LSP.Server
32+
import Development.IDE.Plugin
33+
import Development.IDE.Types.Diagnostics as D
34+
import Development.IDE.Types.Location
35+
import Development.IDE.Types.Logger
36+
import Development.Shake hiding ( Diagnostic )
37+
import GHC.Generics
38+
import qualified Language.Haskell.LSP.Core as LSP
39+
import Language.Haskell.LSP.Messages
40+
import Language.Haskell.LSP.Types
41+
import Text.Regex.TDFA.Text()
42+
43+
-- ---------------------------------------------------------------------
44+
45+
plugin :: Plugin c
46+
plugin = Plugin exampleRules handlersExample2
47+
<> codeActionPlugin codeAction
48+
<> Plugin mempty handlersCodeLens
49+
50+
hover :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))
51+
hover = request "Hover" blah (Right Nothing) foundHover
52+
53+
blah :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.Text]))
54+
blah _ (Position line col)
55+
= return $ Just (Just (Range (Position line col) (Position (line+1) 0)), ["example hover"])
56+
57+
handlersExample2 :: PartialHandlers c
58+
handlersExample2 = PartialHandlers $ \WithMessage{..} x ->
59+
return x{LSP.hoverHandler = withResponse RspHover $ const hover}
60+
61+
62+
-- ---------------------------------------------------------------------
63+
64+
data Example2 = Example2
65+
deriving (Eq, Show, Typeable, Generic)
66+
instance Hashable Example2
67+
instance NFData Example2
68+
instance Binary Example2
69+
70+
type instance RuleResult Example2 = ()
71+
72+
exampleRules :: Rules ()
73+
exampleRules = do
74+
define $ \Example2 file -> do
75+
_pm <- getParsedModule file
76+
let diag = mkDiag file "example2" DsError (Range (Position 0 0) (Position 1 0)) "example2 diagnostic, hello world"
77+
return ([diag], Just ())
78+
79+
action $ do
80+
files <- getFilesOfInterest
81+
void $ uses Example2 $ HashSet.toList files
82+
83+
mkDiag :: NormalizedFilePath
84+
-> DiagnosticSource
85+
-> DiagnosticSeverity
86+
-> Range
87+
-> T.Text
88+
-> FileDiagnostic
89+
mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)
90+
Diagnostic
91+
{ _range = loc
92+
, _severity = Just sev
93+
, _source = Just diagSource
94+
, _message = msg
95+
, _code = Nothing
96+
, _relatedInformation = Nothing
97+
}
98+
99+
-- ---------------------------------------------------------------------
100+
101+
-- | Generate code actions.
102+
codeAction
103+
:: LSP.LspFuncs c
104+
-> IdeState
105+
-> TextDocumentIdentifier
106+
-> Range
107+
-> CodeActionContext
108+
-> IO (Either ResponseError [CAResult])
109+
codeAction _lsp _state (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs} = do
110+
let
111+
title = "Add TODO2 Item"
112+
tedit = [TextEdit (Range (Position 0 0) (Position 0 0))
113+
"-- TODO2 added by Example2 Plugin directly\n"]
114+
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
115+
pure $ Right
116+
[ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) (Just edit) Nothing ]
117+
118+
-- ---------------------------------------------------------------------
119+
120+
-- | Generate code lenses.
121+
handlersCodeLens :: PartialHandlers c
122+
handlersCodeLens = PartialHandlers $ \WithMessage{..} x -> return x{
123+
LSP.codeLensHandler = withResponse RspCodeLens codeLens,
124+
LSP.executeCommandHandler = withResponseAndRequest RspExecuteCommand ReqApplyWorkspaceEdit executeAddSignatureCommand
125+
}
126+
127+
codeLens
128+
:: LSP.LspFuncs c
129+
-> IdeState
130+
-> CodeLensParams
131+
-> IO (Either ResponseError (List CodeLens))
132+
codeLens _lsp ideState CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do
133+
case uriToFilePath' uri of
134+
Just (toNormalizedFilePath -> filePath) -> do
135+
_ <- runAction ideState $ runMaybeT $ useE TypeCheck filePath
136+
_diag <- getDiagnostics ideState
137+
_hDiag <- getHiddenDiagnostics ideState
138+
let
139+
title = "Add TODO2 Item via Code Lens"
140+
tedit = [TextEdit (Range (Position 3 0) (Position 3 0))
141+
"-- TODO2 added by Example2 Plugin via code lens action\n"]
142+
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
143+
range = (Range (Position 3 0) (Position 4 0))
144+
pure $ Right $ List
145+
-- [ CodeLens range (Just (Command title "codelens.do" (Just $ List [toJSON edit]))) Nothing
146+
[ CodeLens range (Just (Command title "codelens.todo" (Just $ List [toJSON edit]))) Nothing
147+
]
148+
Nothing -> pure $ Right $ List []
149+
150+
-- | Execute the "codelens.todo2" command.
151+
executeAddSignatureCommand
152+
:: LSP.LspFuncs c
153+
-> IdeState
154+
-> ExecuteCommandParams
155+
-> IO (Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
156+
executeAddSignatureCommand _lsp _ideState ExecuteCommandParams{..}
157+
| _command == "codelens.todo2"
158+
, Just (List [edit]) <- _arguments
159+
, Success wedit <- fromJSON edit
160+
= return (Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams wedit))
161+
| otherwise
162+
= return (Null, Nothing)
163+
164+
-- ---------------------------------------------------------------------
165+
166+
foundHover :: (Maybe Range, [T.Text]) -> Either ResponseError (Maybe Hover)
167+
foundHover (mbRange, contents) =
168+
Right $ Just $ Hover (HoverContents $ MarkupContent MkMarkdown
169+
$ T.intercalate sectionSeparator contents) mbRange
170+
171+
172+
-- | Respond to and log a hover or go-to-definition request
173+
request
174+
:: T.Text
175+
-> (NormalizedFilePath -> Position -> Action (Maybe a))
176+
-> Either ResponseError b
177+
-> (a -> Either ResponseError b)
178+
-> IdeState
179+
-> TextDocumentPositionParams
180+
-> IO (Either ResponseError b)
181+
request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos _) = do
182+
mbResult <- case uriToFilePath' uri of
183+
Just path -> logAndRunRequest label getResults ide pos path
184+
Nothing -> pure Nothing
185+
pure $ maybe notFound found mbResult
186+
187+
logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> Action b) -> IdeState -> Position -> String -> IO b
188+
logAndRunRequest label getResults ide pos path = do
189+
let filePath = toNormalizedFilePath path
190+
logInfo (ideLogger ide) $
191+
label <> " request at position " <> T.pack (showPosition pos) <>
192+
" in file: " <> T.pack path
193+
runAction ide $ getResults filePath pos

‎src/Ide/Plugin/Floskell.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ import Development.IDE.Types.Diagnostics as D
1818
import Development.IDE.Types.Location
1919
import Floskell
2020
import Ide.Plugin.Formatter
21+
import Ide.Types
2122
import Language.Haskell.LSP.Types
2223
import Text.Regex.TDFA.Text()
2324

‎src/Ide/Plugin/Formatter.hs

Lines changed: 1 addition & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,6 @@
88
module Ide.Plugin.Formatter
99
(
1010
formatterPlugins
11-
, FormattingType(..)
12-
, FormattingProvider
1311
, responseError
1412
, extractRange
1513
, fullRange
@@ -25,6 +23,7 @@ import Development.IDE.Plugin
2523
import Development.IDE.Types.Diagnostics as D
2624
import Development.IDE.Types.Location
2725
import Development.Shake hiding ( Diagnostic )
26+
import Ide.Types
2827
import Ide.Plugin.Config
2928
import qualified Language.Haskell.LSP.Core as LSP
3029
import Language.Haskell.LSP.Messages
@@ -89,27 +88,6 @@ doFormatting lf providers ideState ft uri params = do
8988

9089
-- ---------------------------------------------------------------------
9190

92-
-- | Format the given Text as a whole or only a @Range@ of it.
93-
-- Range must be relative to the text to format.
94-
-- To format the whole document, read the Text from the file and use 'FormatText'
95-
-- as the FormattingType.
96-
data FormattingType = FormatText
97-
| FormatRange Range
98-
99-
100-
-- | To format a whole document, the 'FormatText' @FormattingType@ can be used.
101-
-- It is required to pass in the whole Document Text for that to happen, an empty text
102-
-- and file uri, does not suffice.
103-
type FormattingProvider m
104-
= IdeState
105-
-> FormattingType -- ^ How much to format
106-
-> T.Text -- ^ Text to format
107-
-> NormalizedFilePath -- ^ location of the file being formatted
108-
-> FormattingOptions -- ^ Options for the formatter
109-
-> m (Either ResponseError (List TextEdit)) -- ^ Result of the formatting
110-
111-
-- ---------------------------------------------------------------------
112-
11391
noneProvider :: FormattingProvider IO
11492
noneProvider _ _ _ _ _ = return $ Right (List [])
11593

‎src/Ide/Plugin/Ormolu.hs

Lines changed: 8 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -11,26 +11,23 @@ module Ide.Plugin.Ormolu
1111
)
1212
where
1313

14-
#if __GLASGOW_HASKELL__ >= 806
1514
import Control.Exception
16-
import Data.Char
17-
import qualified Data.Text as T
18-
import GHC
19-
import Ormolu
20-
import qualified DynFlags as D
21-
import qualified EnumSet as S
22-
import qualified HIE.Bios as BIOS
23-
#endif
24-
2515
import Control.Monad
16+
import Data.Char
2617
import Data.List
2718
import Data.Maybe
19+
import qualified Data.Text as T
2820
import Development.IDE.Core.Rules
29-
-- import Development.IDE.Plugin
3021
import Development.IDE.Types.Diagnostics as D
3122
import Development.IDE.Types.Location
23+
import qualified DynFlags as D
24+
import qualified EnumSet as S
25+
import GHC
26+
import Ide.Types
27+
import qualified HIE.Bios as BIOS
3228
import Ide.Plugin.Formatter
3329
import Language.Haskell.LSP.Types
30+
import Ormolu
3431
import Text.Regex.TDFA.Text()
3532

3633
-- ---------------------------------------------------------------------

0 commit comments

Comments
 (0)