Skip to content

Commit 59ff903

Browse files
VenInfVenInf
committed
diagnostic optimisation
1 parent f2f1697 commit 59ff903

File tree

3 files changed

+60
-36
lines changed

3 files changed

+60
-36
lines changed

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

Lines changed: 20 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -303,23 +303,26 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
303303
cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
304304
cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
305305
maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction
306-
case uriToFilePath uri of
307-
Nothing -> pure $ InL []
308-
Just haskellFilePath -> do
309-
mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath
310-
case mbCabalFile of
311-
Nothing -> pure $ InL [InR noCabalFileAction]
312-
Just cabalFilePath -> do
313-
verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath)
314-
mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath
315-
case mbGPD of
316-
Nothing -> pure $ InL []
317-
Just (gpd, _) -> do
318-
actions <- liftIO $ mapM (\diag ->
319-
CabalAdd.addDependencySuggestCodeAction cabalAddRecorder plId
320-
verTxtDocId maxCompls diag
321-
haskellFilePath cabalFilePath gpd) diags
322-
pure $ InL $ fmap InR (concat actions)
306+
let suggestions = concatMap (\diag -> CabalAdd.hiddenPackageSuggestion maxCompls diag) diags
307+
case suggestions of
308+
[] -> pure $ InL []
309+
_ ->
310+
case uriToFilePath uri of
311+
Nothing -> pure $ InL []
312+
Just haskellFilePath -> do
313+
mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath
314+
case mbCabalFile of
315+
Nothing -> pure $ InL [InR noCabalFileAction]
316+
Just cabalFilePath -> do
317+
verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath)
318+
mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath
319+
case mbGPD of
320+
Nothing -> pure $ InL []
321+
Just (gpd, _) -> do
322+
actions <- liftIO $ CabalAdd.addDependencySuggestCodeAction cabalAddRecorder plId
323+
verTxtDocId suggestions
324+
haskellFilePath cabalFilePath gpd
325+
pure $ InL $ fmap InR actions
323326
where
324327
noCabalFileAction = CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing
325328
(Just (CodeActionDisabled "No .cabal file found")) Nothing Nothing Nothing

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

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -128,19 +128,18 @@ addDependencySuggestCodeAction
128128
:: Logger.Recorder (Logger.WithPriority Log)
129129
-> PluginId
130130
-> VersionedTextDocumentIdentifier -- ^ Cabal's versioned text identifier
131-
-> Int -- ^ Maximum number of suggestions to return
132-
-> Diagnostic -- ^ Diagnostic from a code action
131+
-> [(T.Text, T.Text)] -- ^ A dependency-version suggestion pairs
133132
-> FilePath -- ^ Path to the haskell file
134133
-> FilePath -- ^ Path to the cabal file
135134
-> GenericPackageDescription
136135
-> IO [CodeAction]
137-
addDependencySuggestCodeAction recorder plId verTxtDocId maxCompletions diag haskellFilePath cabalFilePath gpd = do
136+
addDependencySuggestCodeAction recorder plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do
138137
buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath
139138
Logger.logWith recorder Logger.Info LogCalledCabalAddCodeAction
140139
case buildTargets of
141-
[] -> pure $ mkCodeAction cabalFilePath Nothing <$> hiddenPackageSuggestion maxCompletions (_message diag)
140+
[] -> pure $ mkCodeAction cabalFilePath Nothing <$> suggestions
142141
targets -> pure $ concat [mkCodeAction cabalFilePath (Just $ buildTargetToStringRepr target) <$>
143-
hiddenPackageSuggestion maxCompletions (_message diag) | target <- targets]
142+
suggestions | target <- targets]
144143
where
145144
buildTargetToStringRepr target = render $ pretty $ buildTargetComponentName target
146145

@@ -168,10 +167,12 @@ addDependencySuggestCodeAction recorder plId verTxtDocId maxCompletions diag has
168167
in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing
169168

170169
-- | Gives a mentioned number of @(dependency, version)@ pairs
171-
-- found in the "hidden package" message
172-
hiddenPackageSuggestion :: Int -> T.Text -> [(T.Text, T.Text)]
173-
hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex)
170+
-- found in the "hidden package" diagnostic message
171+
hiddenPackageSuggestion :: Int -> Diagnostic -> [(T.Text, T.Text)]
172+
hiddenPackageSuggestion maxCompletions diag = take maxCompletions $ getMatch (msg =~ regex)
174173
where
174+
msg :: T.Text
175+
msg = _message diag
175176
regex :: T.Text -- TODO: Support multiple packages suggestion
176177
regex = "It is a member of the hidden package [\8216']([a-zA-Z0-9-]*[a-zA-Z0-9])(-([0-9\\.]*))?[\8217']"
177178
-- Have to do this matching because `Regex.TDFA` doesn't(?) support

‎plugins/hls-cabal-plugin/test/CabalAdd.hs

Lines changed: 31 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -4,19 +4,26 @@ module CabalAdd (
44
cabalAddTests,
55
) where
66

7-
import Control.Lens ((^.))
8-
import Control.Lens.Fold ((^?))
9-
import qualified Data.Maybe as Maybe
10-
import qualified Data.Text as T
11-
import qualified Data.Text.Internal.Search as T
12-
import Distribution.Utils.Generic (safeHead)
13-
import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion)
14-
import qualified Language.LSP.Protocol.Lens as L
7+
import Control.Lens ((^.))
8+
import Control.Lens.Fold ((^?))
9+
import qualified Data.Maybe as Maybe
10+
import qualified Data.Text as T
11+
import qualified Data.Text.Internal.Search as T
12+
import Distribution.Utils.Generic (safeHead)
13+
import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion)
14+
import qualified Language.LSP.Protocol.Lens as L
15+
import Language.LSP.Protocol.Types (Diagnostic (..), mkRange)
1516
import System.FilePath
16-
import Test.Hls
17+
import Test.Hls (Session, TestTree, _R, anyMessage,
18+
assertEqual, documentContents,
19+
executeCodeAction,
20+
expectFailBecause,
21+
getAllCodeActions,
22+
getDocumentEdit, liftIO, openDoc,
23+
skipManyTill, testCase, testGroup,
24+
waitForDiagnosticsFrom, (@?=))
1725
import Utils
1826

19-
2027
cabalAddTests :: TestTree
2128
cabalAddTests =
2229
testGroup
@@ -116,8 +123,21 @@ cabalAddTests =
116123
liftIO $ assertEqual (T.unpack dependency <> " isn't found in the cabal file") indicesRes (T.indices dependency contents)
117124
testHiddenPackageSuggestions :: String -> [T.Text] -> [(T.Text, T.Text)] -> TestTree
118125
testHiddenPackageSuggestions testTitle messages suggestions =
119-
let suggestions' = map (safeHead . hiddenPackageSuggestion 1) messages
126+
let diags = map (\msg -> messageToDiagnostic msg ) messages
127+
suggestions' = map (safeHead . hiddenPackageSuggestion 1) diags
120128
assertions = zipWith (@?=) suggestions' (map Just suggestions)
121129
testNames = map (\(f, s) -> "Check if " ++ T.unpack f ++ (if s == "" then "" else "-") ++ T.unpack s ++ " was parsed correctly") suggestions
122130
test = testGroup testTitle $ zipWith testCase testNames assertions
123131
in test
132+
messageToDiagnostic :: T.Text -> Diagnostic
133+
messageToDiagnostic msg = Diagnostic {
134+
_range = mkRange 0 0 0 0
135+
, _severity = Nothing
136+
, _code = Nothing
137+
, _source = Nothing
138+
, _message = msg
139+
, _relatedInformation = Nothing
140+
, _tags = Nothing
141+
, _codeDescription = Nothing
142+
, _data_ = Nothing
143+
}

0 commit comments

Comments
 (0)