Skip to content

Commit 7ca4531

Browse files
alanzalanz
authored
Merge pull request #4 from alanz/plugins-play
Add trivial diagnostic generation to the Example
2 parents e6d7f82 + 5a54966 commit 7ca4531

File tree

4 files changed

+124
-22
lines changed

4 files changed

+124
-22
lines changed

‎.gitmodules

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
11
[submodule "ghcide"]
22
path = ghcide
3-
url = https://github.com/digital-asset/ghcide.git
3+
# url = https://github.com/digital-asset/ghcide.git
4+
url = https://github.com/alanz/ghcide.git

‎ghcide

‎ide.cabal

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -62,11 +62,12 @@ library
6262
transformers,
6363
unordered-containers,
6464
utf8-string,
65-
hslogger
65+
hslogger,
66+
ghc
6667

6768
default-language: Haskell2010
6869

69-
executable ide
70+
executable haskell-ide
7071
main-is: Main.hs
7172
other-modules:
7273
Paths_ide

‎src/Ide/Plugin/Example.hs

Lines changed: 118 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,37 +1,68 @@
1+
{-# LANGUAGE DeriveGeneric #-}
2+
{-# LANGUAGE DuplicateRecordFields #-}
3+
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE FlexibleInstances #-}
15
{-# LANGUAGE OverloadedStrings #-}
2-
{-# LANGUAGE RecordWildCards #-}
6+
{-# LANGUAGE RecordWildCards #-}
7+
{-# LANGUAGE TupleSections #-}
8+
{-# LANGUAGE TypeFamilies #-}
39

410
module Ide.Plugin.Example
511
(
612
plugin
713
) where
8-
import Development.IDE.Core.Rules
9-
import Development.IDE.Core.Service
10-
import Development.IDE.LSP.Server
11-
import Development.IDE.Types.Location
12-
import Development.IDE.Types.Logger
13-
import Development.Shake
14-
import qualified Language.Haskell.LSP.Core as LSP
1514

16-
import Development.IDE.Plugin
17-
import Development.IDE.Core.Service
18-
import Development.IDE.Types.Location
15+
import Control.Concurrent.Extra
16+
import Control.DeepSeq
17+
import Control.Exception
18+
import Control.Monad (join)
19+
import Control.Monad.Trans.Maybe
20+
import Data.Aeson.Types (toJSON, fromJSON, Value(..), Result(..))
21+
import Data.Binary
22+
import qualified Data.ByteString.UTF8 as BS
23+
import Data.Char
24+
import Data.Functor
25+
import qualified Data.HashMap.Strict as Map
26+
import qualified Data.HashSet as HSet
27+
import Data.Hashable
28+
import Data.List.Extra
29+
import Data.Maybe
30+
import qualified Data.Rope.UTF16 as Rope
31+
import qualified Data.Set as Set
32+
import qualified Data.Text as T
33+
import Data.Tuple.Extra
34+
import Data.Typeable
35+
import Development.IDE.Core.OfInterest
1936
import Development.IDE.Core.PositionMapping
2037
import Development.IDE.Core.RuleTypes
38+
import Development.IDE.Core.Rules
39+
import Development.IDE.Core.Service
2140
import Development.IDE.Core.Shake
41+
import Development.IDE.GHC.Error
2242
import Development.IDE.GHC.Util
23-
import Development.IDE.LSP.Server
2443
import Development.IDE.Import.DependencyInformation
25-
26-
import Language.Haskell.LSP.Messages
27-
import Language.Haskell.LSP.Types
28-
29-
import qualified Data.Text as T
44+
import Development.IDE.LSP.Server
45+
import Development.IDE.Plugin
46+
import Development.IDE.Types.Diagnostics as D
47+
import Development.IDE.Types.Location
48+
import Development.IDE.Types.Logger
49+
import Development.IDE.Types.Options
50+
import Development.Shake hiding ( Diagnostic )
51+
import GHC
52+
import GHC.Generics
53+
import qualified Language.Haskell.LSP.Core as LSP
54+
import Language.Haskell.LSP.Messages
55+
import Language.Haskell.LSP.Types
56+
import Language.Haskell.LSP.VFS
57+
import Outputable (ppr, showSDocUnsafe)
58+
import SrcLoc
59+
import Text.Regex.TDFA ((=~), (=~~))
60+
import Text.Regex.TDFA.Text()
3061

3162
-- ---------------------------------------------------------------------
3263

3364
plugin :: Plugin
34-
plugin = Plugin mempty handlersExample
65+
plugin = Plugin exampleRules handlersExample <> codeActionPlugin codeAction
3566

3667
hover :: IdeState -> TextDocumentPositionParams -> IO (Maybe Hover)
3768
hover = request "Hover" blah Nothing foundHover
@@ -46,6 +77,75 @@ handlersExample = PartialHandlers $ \WithMessage{..} x ->
4677

4778

4879
-- ---------------------------------------------------------------------
80+
81+
data Example = Example
82+
deriving (Eq, Show, Typeable, Generic)
83+
instance Hashable Example
84+
instance NFData Example
85+
instance Binary Example
86+
87+
type instance RuleResult Example = ()
88+
89+
exampleRules = do
90+
define $ \Example file -> do
91+
getParsedModule file
92+
let diag = mkDiag file "example" DsError (Range (Position 0 0) (Position 1 0)) "example diagnostic, hello world"
93+
return ([diag], Just ())
94+
95+
action $ do
96+
files <- getFilesOfInterest
97+
void $ uses Example $ Set.toList files
98+
99+
mkDiag :: NormalizedFilePath
100+
-> DiagnosticSource
101+
-> DiagnosticSeverity
102+
-> Range
103+
-> T.Text
104+
-> FileDiagnostic
105+
mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)
106+
Diagnostic
107+
{ _range = loc
108+
, _severity = Just sev
109+
, _source = Just diagSource
110+
, _message = msg
111+
, _code = Nothing
112+
, _relatedInformation = Nothing
113+
}
114+
115+
-- ---------------------------------------------------------------------
116+
117+
-- | Generate code actions.
118+
codeAction
119+
:: LSP.LspFuncs ()
120+
-> IdeState
121+
-> TextDocumentIdentifier
122+
-> Range
123+
-> CodeActionContext
124+
-> IO [CAResult]
125+
codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List xs} = do
126+
contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
127+
let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
128+
(ideOptions, parsedModule) <- runAction state $
129+
(,) <$> getIdeOptions
130+
<*> (getParsedModule . toNormalizedFilePath) `traverse` uriToFilePath uri
131+
pure
132+
[ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
133+
| x <- xs, (title, tedit) <- suggestAction ideOptions ( join parsedModule ) text x
134+
, let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
135+
]
136+
137+
suggestAction :: IdeOptions -> Maybe ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
138+
suggestAction ideOptions parsedModule text diag = concat
139+
[ suggestAddTodo diag ]
140+
141+
suggestAddTodo :: Diagnostic -> [(T.Text, [TextEdit])]
142+
suggestAddTodo Diagnostic{_range=_range@Range{..},..}
143+
= [("Add TODO Item",
144+
-- [TextEdit _range "-- TODO added by Example Plugin\n"]) ]
145+
[TextEdit (Range (Position 0 0) (Position 1 0)) "-- TODO added by Example Plugin\n"]) ]
146+
147+
-- ---------------------------------------------------------------------
148+
49149
foundHover :: (Maybe Range, [T.Text]) -> Maybe Hover
50150
foundHover (mbRange, contents) =
51151
Just $ Hover (HoverContents $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator contents) mbRange

0 commit comments

Comments
 (0)