Skip to content

Commit 84a291a

Browse files
dyniecdyniec
committed
Use context in code actions for cabal files
1 parent 233c36c commit 84a291a

File tree

2 files changed

+115
-101
lines changed

2 files changed

+115
-101
lines changed

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

+90-46
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,13 @@
1-
{-# LANGUAGE DataKinds #-}
2-
{-# LANGUAGE DeriveGeneric #-}
3-
{-# LANGUAGE DuplicateRecordFields #-}
4-
{-# LANGUAGE FlexibleContexts #-}
5-
{-# LANGUAGE FlexibleInstances #-}
6-
{-# LANGUAGE LambdaCase #-}
7-
{-# LANGUAGE NamedFieldPuns #-}
8-
{-# LANGUAGE OverloadedStrings #-}
9-
{-# LANGUAGE TypeFamilies #-}
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE DuplicateRecordFields #-}
4+
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE FlexibleInstances #-}
6+
{-# LANGUAGE LambdaCase #-}
7+
{-# LANGUAGE NamedFieldPuns #-}
8+
{-# LANGUAGE OverloadedStrings #-}
9+
{-# LANGUAGE TypeFamilies #-}
10+
{-# LANGUAGE DisambiguateRecordFields#-}
1011

1112
module Ide.Plugin.Cabal where
1213

@@ -44,6 +45,7 @@ import qualified Data.Map as Map
4445
import Language.LSP.VFS (VirtualFile)
4546
import qualified Data.Text.Utf16.Rope as Rope
4647
import qualified Data.List as List
48+
import qualified Data.HashMap.Strict as MapStrict
4749
data Log
4850
= LogModificationTime NormalizedFilePath (Maybe FileVersion)
4951
| LogDiagnostics NormalizedFilePath [FileDiagnostic]
@@ -73,7 +75,7 @@ instance Pretty Log where
7375
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
7476
descriptor recorder plId = (defaultCabalPluginDescriptor plId)
7577
{ pluginRules = cabalRules recorder
76-
, pluginHandlers = mkPluginHandler STextDocumentCodeAction licenseSuggestCodeAction
78+
, pluginHandlers = mkPluginHandler STextDocumentCodeAction licenseSuggestCodeAction
7779
<> mkPluginHandler J.STextDocumentCompletion completion
7880
<> mkPluginHandler STextDocumentCodeAction fieldSuggestCodeAction
7981
, pluginNotificationHandlers = mconcat
@@ -157,6 +159,7 @@ cabalRules recorder = do
157159
-- Code Actions
158160
-- ----------------------------------------------------------------
159161

162+
-- | CodeActions for unsupported license values
160163
licenseSuggestCodeAction
161164
:: IdeState
162165
-> PluginId
@@ -165,42 +168,62 @@ licenseSuggestCodeAction
165168
licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) =
166169
pure $ Right $ List $ mapMaybe (fmap InR . LicenseSuggest.licenseErrorAction uri) diags
167170

171+
-- | CodeActions for misspelled fields in cabal files
172+
-- both for toplevel fields, and fields in stanzas.
173+
-- uses same logic as completions but reacts on diagnostics from cabal
174+
fieldSuggestCodeAction
175+
:: IdeState
176+
-> PluginId
177+
-> CodeActionParams
178+
-> LSP.LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))
179+
fieldSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=List diags}) =do
180+
cnts <- LSP.getVirtualFile $ toNormalizedUri uri
181+
let fields = mapMaybe FieldSuggest.fieldErrorName diags
182+
results <- forM fields (getSuggestion cnts)
183+
return $ Right $ J.List $ map InR $ concat results
184+
where
185+
getSuggestion :: Maybe VirtualFile -> (T.Text,Diagnostic) -> LSP.LspM Config [CodeAction]
186+
getSuggestion cnts (field,Diagnostic{ _range=_range@(Range (Position lineNr col) _) })= do
187+
completions <- completionAtPosition uri (Position lineNr (col + fromIntegral (T.length field))) cnts
188+
pure $ fieldErrorAction uri field completions _range
168189
-- ----------------------------------------------------------------
169190
-- Completion
170191
-- ----------------------------------------------------------------
171-
completion :: PluginMethodHandler IdeState 'J.TextDocumentCompletion
172-
completion _ide _ complParams = do
173-
let (J.TextDocumentIdentifier uri) = complParams ^. JL.textDocument
174-
position = complParams ^. JL.position
175-
contents <- LSP.getVirtualFile $ toNormalizedUri uri
176-
fmap (Right . J.InL) $ case (contents, uriToFilePath' uri) of
192+
-- | Generates similiar field names for given file, position and contents of file
193+
completionAtPosition :: Uri -> Position -> Maybe VirtualFile -> LSP.LspM Config [T.Text]
194+
completionAtPosition uri pos contents = do
195+
case (contents, uriToFilePath' uri) of
177196
(Just cnts, Just _path) -> do
178-
pref <- VFS.getCompletionPrefix position cnts
197+
pref <- VFS.getCompletionPrefix pos cnts
179198
return $ result pref cnts
180-
_ -> return $ J.List []
199+
_ -> return []
181200
where
182-
result :: Maybe VFS.PosPrefixInfo -> VirtualFile -> J.List CompletionItem
183-
result Nothing _ = J.List []
201+
result :: Maybe VFS.PosPrefixInfo -> VirtualFile -> [T.Text]
202+
result Nothing _ = []
184203
result (Just pfix) cnts
185-
| (VFS.cursorPos pfix) ^. JL.line == 0 = J.List [buildCompletion cabalVersionKeyword]
186-
| Stanza s <- findCurrentLevel (getPreviousLines pfix cnts) =
187-
case (Map.lookup s stanzaKeywordMap) of
188-
Nothing ->
189-
J.List $
190-
makeCompletionItems pfix topLevelKeywords
191-
Just l -> J.List $ (makeCompletionItems pfix l) ++ (makeCompletionItems pfix $ Map.keys stanzaKeywordMap)
204+
| VFS.cursorPos pfix ^. JL.line == 0 = [cabalVersionKeyword]
205+
| Stanza s <- findCurrentLevel (getPreviousLines pfix cnts) =
206+
case Map.lookup s stanzaKeywordMap of
207+
Nothing ->getCompletions pfix topLevelKeywords
208+
Just l -> getCompletions pfix l ++ (getCompletions pfix $ Map.keys stanzaKeywordMap)
192209
| otherwise =
193-
J.List $
194-
makeCompletionItems pfix topLevelKeywords
195-
where
210+
getCompletions pfix topLevelKeywords
211+
where
196212
topLevelKeywords = cabalKeywords ++ Map.keys stanzaKeywordMap
197213

214+
completion :: PluginMethodHandler IdeState 'J.TextDocumentCompletion
215+
completion _ide _ complParams = do
216+
let (J.TextDocumentIdentifier uri) = complParams ^. JL.textDocument
217+
position = complParams ^. JL.position
218+
contents <- LSP.getVirtualFile $ toNormalizedUri uri
219+
fmap (Right . J.InL . J.List . fmap buildCompletion) $ completionAtPosition uri position contents
220+
198221
-- | Takes info about the current cursor position and a set of possible keywords
199222
-- and creates completion suggestions that fit the current input from the given list
200-
makeCompletionItems :: VFS.PosPrefixInfo -> [T.Text] -> [CompletionItem]
201-
makeCompletionItems pfix l =
223+
getCompletions :: VFS.PosPrefixInfo -> [T.Text] -> [T.Text]
224+
getCompletions pfix l =
202225
map
203-
(buildCompletion . Fuzzy.original)
226+
Fuzzy.original
204227
(Fuzzy.simpleFilter 1000 10 (VFS.prefixText pfix) l)
205228

206229
-- | Parse the given set of lines (starting before current cursor position
@@ -220,11 +243,11 @@ getPreviousLines :: VFS.PosPrefixInfo -> VirtualFile -> [T.Text]
220243
getPreviousLines pos cont = reverse $ take (fromIntegral currentLine) allLines
221244
where
222245
allLines = Rope.lines $ cont ^. VFS.file_text
223-
currentLine = (VFS.cursorPos pos) ^. JL.line
246+
currentLine = VFS.cursorPos pos ^. JL.line
224247

225248

226-
data Context
227-
= TopLevel
249+
data Context
250+
= TopLevel
228251
-- ^ top level context in a cabal file such as 'author'
229252
| Stanza T.Text
230253
-- ^ nested context in a cabal file, such as 'library', which has nested keywords, specific to the stanza
@@ -236,7 +259,7 @@ cabalVersionKeyword = "cabal-version:"
236259

237260
-- | Top level keywords of a cabal file
238261
cabalKeywords :: [T.Text]
239-
cabalKeywords =
262+
cabalKeywords =
240263
[
241264
"name:",
242265
"version:",
@@ -264,15 +287,15 @@ cabalKeywords =
264287

265288
-- | Map, containing all stanzas in a cabal file as keys and lists of their possible nested keywords as values
266289
stanzaKeywordMap :: Map T.Text [T.Text]
267-
stanzaKeywordMap = Map.fromList [("library", [
290+
stanzaKeywordMap = Map.fromList [("library", [
268291
"exposed-modules:",
269292
"virtual-modules:",
270293
"exposed:",
271294
"visibility:",
272295
"reexported-modules:",
273296
"signatures:"
274297
])]
275-
298+
276299

277300
-- TODO move out toplevel commands i.e. test-suite
278301
-- cabalTestKeywords :: [T.Text]
@@ -366,11 +389,32 @@ buildCompletion label =
366389
J.CompletionItem label (Just J.CiKeyword) Nothing Nothing
367390
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
368391
Nothing Nothing Nothing Nothing Nothing Nothing
369-
fieldSuggestCodeAction
370-
:: IdeState
371-
-> PluginId
372-
-> CodeActionParams
373-
-> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))
374392

375-
fieldSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) =
376-
pure $ Right $ List $ diags >>=(fmap InR . FieldSuggest.fieldErrorAction uri)
393+
-- | Generate all code action for given file, error field in position and suggestions
394+
fieldErrorAction
395+
:: Uri
396+
-- ^ File for which the diagnostic was generated
397+
-> T.Text
398+
-- ^ Original field
399+
-> [T.Text]
400+
-- ^ Suggestions
401+
-> Range
402+
-- ^ location of diagnostic
403+
-> [CodeAction]
404+
fieldErrorAction uri original suggestions range =
405+
fmap mkCodeAction suggestions
406+
where
407+
mkCodeAction suggestion =
408+
let
409+
-- Range returned by cabal here represents fragment from start of
410+
-- offending identifier to end of line, we modify it to the end of identifier
411+
adjustRange (Range rangeFrom@(Position lineNr col) _) =
412+
Range rangeFrom (Position lineNr (col + fromIntegral (T.length original)))
413+
title = "Replace with " <> suggestion'
414+
tedit = [TextEdit (adjustRange range ) suggestion']
415+
edit = WorkspaceEdit (Just $ MapStrict.singleton uri $ List tedit) Nothing Nothing
416+
in CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing
417+
where
418+
-- dropping colon from the end of suggestion
419+
suggestion' :: T.Text
420+
suggestion' = T.dropEnd 1 suggestion

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs

+25-55
Original file line numberDiff line numberDiff line change
@@ -1,66 +1,36 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
2-
{-# LANGUAGE ExplicitNamespaces #-}
3-
{-# LANGUAGE FlexibleContexts #-}
4-
{-# LANGUAGE LambdaCase #-}
5-
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE ExplicitNamespaces #-}
3+
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE LambdaCase #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
67
module Ide.Plugin.Cabal.FieldSuggest
7-
( fieldErrorSuggestion
8-
, fieldErrorAction
9-
-- * Re-exports
10-
, T.Text
11-
, Diagnostic(..)
12-
)
13-
where
8+
( fieldErrorName,
149

15-
import qualified Data.HashMap.Strict as Map
16-
import qualified Data.Text as T
17-
import Language.LSP.Types (CodeAction (CodeAction),
18-
CodeActionKind (CodeActionQuickFix),
19-
Diagnostic (..), List (List),
20-
Position (Position), Range (Range),
21-
TextEdit (TextEdit), Uri,
22-
WorkspaceEdit (WorkspaceEdit))
23-
import Text.Regex.TDFA
10+
-- * Re-exports
11+
T.Text,
12+
Diagnostic (..),
13+
)
14+
where
2415

25-
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
26-
-- if it represents an "Unknown field"-error along
27-
-- with a incorrect field, then return a 'CodeAction' for replacing the
28-
-- the incorrect field with the suggestion.
29-
-- It should be context sensitive, but for now it isn't
30-
fieldErrorAction
31-
:: Uri
32-
-- ^ File for which the diagnostic was generated
33-
-> Diagnostic
34-
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
35-
-> [CodeAction]
36-
fieldErrorAction uri diag =
37-
mkCodeAction <$> fieldErrorSuggestion diag
38-
where
39-
mkCodeAction (original, suggestion) =
40-
let
41-
-- Range returned by cabal here represents fragment from start of
42-
-- offending identifier to end of line, we modify it to the end of identifier
43-
adjustRange (Range rangeFrom@(Position line col) _) =
44-
Range rangeFrom (Position line (col + fromIntegral (T.length original)))
45-
title = "Replace with " <> suggestion
46-
tedit = [TextEdit (adjustRange $ _range diag) suggestion]
47-
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing
48-
in CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing
16+
import qualified Data.Text as T
17+
import Language.LSP.Types
18+
( Diagnostic (..),
19+
)
20+
import Text.Regex.TDFA
4921

5022
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
5123
-- if it represents an "Unknown field"- error with incorrect identifier
52-
-- then return the suggestion (for now placeholder "name")
53-
-- along with the incorrect identifier.
54-
--
55-
fieldErrorSuggestion
56-
:: Diagnostic
57-
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
58-
-> [(T.Text, T.Text)]
59-
-- ^ (Original (incorrect) license identifier, suggested replacement)
60-
fieldErrorSuggestion diag =
24+
-- then return the incorrect identifier together with original diagnostics.
25+
fieldErrorName ::
26+
-- | Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
27+
Diagnostic ->
28+
-- | (Original (incorrect) license identifier, suggested replacement)
29+
Maybe (T.Text, Diagnostic)
30+
fieldErrorName diag =
6131
mSuggestion (_message diag) >>= \case
62-
[original] -> [(original, "name")]
63-
_ -> []
32+
[original] -> Just (original, diag)
33+
_ -> Nothing
6434
where
6535
regex :: T.Text
6636
regex = "Unknown field: \"(.*)\""

0 commit comments

Comments
 (0)