Skip to content

Commit b546609

Browse files
maralornmaralorn
committed
Pass VersionedTextDocumentIdentifier through
1 parent 0c57ac8 commit b546609

File tree

9 files changed

+78
-83
lines changed

9 files changed

+78
-83
lines changed

‎hls-plugin-api/src/Ide/PluginUtils.hs‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ where
4141

4242

4343
import Control.Arrow ((&&&))
44+
import Control.Lens ((^.))
4445
import Control.Monad.Extra (maybeM)
4546
import Control.Monad.Trans.Class (lift)
4647
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
@@ -63,6 +64,7 @@ import Language.LSP.Types hiding
6364
SemanticTokensEdit (_start))
6465
import qualified Language.LSP.Types as J
6566
import Language.LSP.Types.Capabilities
67+
import qualified Language.LSP.Types.Lens as J
6668
import qualified Text.Megaparsec as P
6769
import qualified Text.Megaparsec.Char as P
6870
import qualified Text.Megaparsec.Char.Lexer as P
@@ -98,7 +100,7 @@ data WithDeletions = IncludeDeletions | SkipDeletions
98100
deriving Eq
99101

100102
-- | Generate a 'WorkspaceEdit' value from a pair of source Text
101-
diffText :: ClientCapabilities -> (Uri,T.Text) -> T.Text -> WithDeletions -> TextDocumentVersion -> WorkspaceEdit
103+
diffText :: ClientCapabilities -> (VersionedTextDocumentIdentifier,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
102104
diffText clientCaps old new withDeletions =
103105
let
104106
supports = clientSupportsDocumentChanges clientCaps
@@ -161,16 +163,16 @@ diffTextEdit fText f2Text withDeletions = J.List r
161163

162164

163165
-- | A pure version of 'diffText' for testing
164-
diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> TextDocumentVersion -> WorkspaceEdit
165-
diffText' supports (f,fText) f2Text withDeletions version =
166+
diffText' :: Bool -> (VersionedTextDocumentIdentifier,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
167+
diffText' supports (verTxtDocId,fText) f2Text withDeletions =
166168
if supports
167169
then WorkspaceEdit Nothing (Just docChanges) Nothing
168170
else WorkspaceEdit (Just h) Nothing Nothing
169171
where
170172
diff = diffTextEdit fText f2Text withDeletions
171-
h = H.singleton f diff
173+
h = H.singleton (verTxtDocId ^. J.uri) diff
172174
docChanges = J.List [InL docEdit]
173-
docEdit = J.TextDocumentEdit (J.VersionedTextDocumentIdentifier f version) $ fmap InL diff
175+
docEdit = J.TextDocumentEdit verTxtDocId $ fmap InL diff
174176

175177
-- ---------------------------------------------------------------------
176178

‎plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs‎

Lines changed: 17 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsP
4242
addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do
4343
caps <- getClientCapabilities
4444
pluginResponse $ do
45-
nfp <- getNormalizedFilePath uri
45+
nfp <- getNormalizedFilePath (verTxtDocId ^. J.uri)
4646
pm <- handleMaybeM "Unable to GetParsedModule"
4747
$ liftIO
4848
$ runAction "classplugin.addMethodPlaceholders.GetParsedModule" state
@@ -57,15 +57,15 @@ addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do
5757
pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs
5858
let edit =
5959
if withSig
60-
then mergeEdit (workspaceEdit caps old new textVersion) pragmaInsertion
61-
else workspaceEdit caps old new textVersion
60+
then mergeEdit (workspaceEdit caps old new) pragmaInsertion
61+
else workspaceEdit caps old new
6262

6363
void $ lift $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ())
6464

6565
pure Null
6666
where
6767
toTextDocumentEdit edit =
68-
TextDocumentEdit (VersionedTextDocumentIdentifier uri textVersion) (List [InL edit])
68+
TextDocumentEdit verTxtDocId (List [InL edit])
6969

7070
mergeEdit :: WorkspaceEdit -> [TextEdit] -> WorkspaceEdit
7171
mergeEdit WorkspaceEdit{..} edits = WorkspaceEdit
@@ -76,30 +76,29 @@ addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do
7676
}
7777

7878
workspaceEdit caps old new
79-
= diffText caps (uri, old) new IncludeDeletions
79+
= diffText caps (verTxtDocId, old) new IncludeDeletions
8080

8181
-- |
8282
-- This implementation is ad-hoc in a sense that the diagnostic detection mechanism is
8383
-- sensitive to the format of diagnostic messages from GHC.
8484
codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState TextDocumentCodeAction
8585
codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginResponse $ do
86-
nfp <- getNormalizedFilePath uri
87-
version <- lift $ (^. J.version) <$> getVersionedTextDoc docId
88-
actions <- join <$> mapM (mkActions nfp version) methodDiags
86+
verTxtDocId <- lift $ getVersionedTextDoc docId
87+
nfp <- getNormalizedFilePath (verTxtDocId ^. J.uri)
88+
actions <- join <$> mapM (mkActions nfp verTxtDocId) methodDiags
8989
pure $ List actions
9090
where
91-
uri = docId ^. J.uri
9291
List diags = context ^. J.diagnostics
9392

9493
ghcDiags = filter (\d -> d ^. J.source == Just "typecheck") diags
9594
methodDiags = filter (\d -> isClassMethodWarning (d ^. J.message)) ghcDiags
9695

9796
mkActions
9897
:: NormalizedFilePath
99-
-> TextDocumentVersion
98+
-> VersionedTextDocumentIdentifier
10099
-> Diagnostic
101100
-> ExceptT String (LspT Ide.Plugin.Config.Config IO) [Command |? CodeAction]
102-
mkActions docPath textVersion diag = do
101+
mkActions docPath verTxtDocId diag = do
103102
(HAR {hieAst = ast}, pmap) <- handleMaybeM "Unable to GetHieAst"
104103
. liftIO
105104
. runAction "classplugin.findClassIdentifier.GetHieAst" state
@@ -116,7 +115,7 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe
116115
implemented <- findImplementedMethods ast instancePosition
117116
logWith recorder Info (LogImplementedMethods cls implemented)
118117
pure
119-
$ concatMap (mkAction textVersion)
118+
$ concatMap mkAction
120119
$ nubOrdOn snd
121120
$ filter ((/=) mempty . snd)
122121
$ fmap (second (filter (\(bind, _) -> bind `notElem` implemented)))
@@ -130,21 +129,21 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe
130129
minimalDef = minDefToMethodGroups range sigs $ classMinimalDef cls
131130
allClassMethods = ("all missing methods", makeMethodDefinitions range sigs)
132131

133-
mkAction :: TextDocumentVersion -> MethodGroup -> [Command |? CodeAction]
134-
mkAction textVersion (name, methods)
132+
mkAction :: MethodGroup -> [Command |? CodeAction]
133+
mkAction (name, methods)
135134
= [ mkCodeAction title
136135
$ mkLspCommand plId codeActionCommandId title
137-
(Just $ mkCmdParams methods textVersion False)
136+
(Just $ mkCmdParams methods False)
138137
, mkCodeAction titleWithSig
139138
$ mkLspCommand plId codeActionCommandId titleWithSig
140-
(Just $ mkCmdParams methods textVersion True)
139+
(Just $ mkCmdParams methods True)
141140
]
142141
where
143142
title = "Add placeholders for " <> name
144143
titleWithSig = title <> " with signature(s)"
145144

146-
mkCmdParams methodGroup textVersion withSig =
147-
[toJSON (AddMinimalMethodsParams uri range (List methodGroup) withSig textVersion)]
145+
mkCmdParams methodGroup withSig =
146+
[toJSON (AddMinimalMethodsParams verTxtDocId range (List methodGroup) withSig)]
148147

149148
mkCodeAction title cmd
150149
= InR

‎plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ import Development.IDE.Graph.Classes
2020
import GHC.Generics
2121
import Ide.Plugin.Class.Utils
2222
import Ide.Types
23-
import Language.LSP.Types (TextDocumentVersion)
23+
import Language.LSP.Types (VersionedTextDocumentIdentifier)
2424

2525
typeLensCommandId :: CommandId
2626
typeLensCommandId = "classplugin.typelens"
@@ -33,12 +33,11 @@ defaultIndent :: Int
3333
defaultIndent = 2
3434

3535
data AddMinimalMethodsParams = AddMinimalMethodsParams
36-
{ uri :: Uri
36+
{ verTxtDocId :: VersionedTextDocumentIdentifier
3737
, range :: Range
3838
, methodGroup :: List (T.Text, T.Text)
3939
-- ^ (name text, signature text)
4040
, withSig :: Bool
41-
, textVersion :: TextDocumentVersion
4241
}
4342
deriving (Show, Eq, Generic, ToJSON, FromJSON)
4443

‎plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs‎

Lines changed: 22 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -409,7 +409,7 @@ codeActionProvider ideState pluginId (CodeActionParams _ _ documentId _ context)
409409
| let TextDocumentIdentifier uri = documentId
410410
, Just docNormalizedFilePath <- uriToNormalizedFilePath (toNormalizedUri uri)
411411
= do
412-
version <- (^. LSP.version) <$> getVersionedTextDoc documentId
412+
verTxtDocId <- getVersionedTextDoc documentId
413413
liftIO $ fmap (Right . LSP.List . map LSP.InR) $ do
414414
allDiagnostics <- atomically $ getDiagnostics ideState
415415

@@ -429,19 +429,19 @@ codeActionProvider ideState pluginId (CodeActionParams _ _ documentId _ context)
429429
pure if | Just modSummaryResult <- modSummaryResult
430430
, Just source <- source
431431
, let dynFlags = ms_hspp_opts $ msrModSummary modSummaryResult ->
432-
diags >>= diagnosticToCodeActions dynFlags source pluginId documentId version
432+
diags >>= diagnosticToCodeActions dynFlags source pluginId verTxtDocId
433433
| otherwise -> []
434434
| otherwise -> pure []
435435
if numHintsInDoc > 1 && numHintsInContext > 0 then do
436-
pure $ singleHintCodeActions ++ [applyAllAction version]
436+
pure $ singleHintCodeActions ++ [applyAllAction verTxtDocId]
437437
else
438438
pure singleHintCodeActions
439439
| otherwise
440440
= pure $ Right $ LSP.List []
441441

442442
where
443-
applyAllAction version =
444-
let args = Just [toJSON (documentId ^. LSP.uri, version)]
443+
applyAllAction verTxtDocId =
444+
let args = Just [toJSON verTxtDocId]
445445
cmd = mkLspCommand pluginId "applyAll" "Apply all hints" args
446446
in LSP.CodeAction "Apply all hints" (Just LSP.CodeActionQuickFix) Nothing Nothing Nothing Nothing (Just cmd) Nothing
447447

@@ -455,25 +455,24 @@ codeActionProvider ideState pluginId (CodeActionParams _ _ documentId _ context)
455455

456456
-- | Convert a hlint diagnostic into an apply and an ignore code action
457457
-- if applicable
458-
diagnosticToCodeActions :: DynFlags -> T.Text -> PluginId -> TextDocumentIdentifier -> TextDocumentVersion -> LSP.Diagnostic -> [LSP.CodeAction]
459-
diagnosticToCodeActions dynFlags fileContents pluginId documentId version diagnostic
458+
diagnosticToCodeActions :: DynFlags -> T.Text -> PluginId -> VersionedTextDocumentIdentifier -> LSP.Diagnostic -> [LSP.CodeAction]
459+
diagnosticToCodeActions dynFlags fileContents pluginId verTxtDocId diagnostic
460460
| LSP.Diagnostic{ _source = Just "hlint", _code = Just (InR code), _range = LSP.Range start _ } <- diagnostic
461-
, let TextDocumentIdentifier uri = documentId
462461
, let isHintApplicable = "refact:" `T.isPrefixOf` code
463462
, let hint = T.replace "refact:" "" code
464463
, let suppressHintTitle = "Ignore hint \"" <> hint <> "\" in this module"
465464
, let suppressHintTextEdits = mkSuppressHintTextEdits dynFlags fileContents hint
466465
, let suppressHintWorkspaceEdit =
467466
LSP.WorkspaceEdit
468-
(Just (Map.singleton uri (List suppressHintTextEdits)))
467+
(Just (Map.singleton (verTxtDocId ^. LSP.uri) (List suppressHintTextEdits)))
469468
Nothing
470469
Nothing
471470
= catMaybes
472471
-- Applying the hint is marked preferred because it addresses the underlying error.
473472
-- Disabling the rule isn't, because less often used and configuration can be adapted.
474473
[ if | isHintApplicable
475474
, let applyHintTitle = "Apply hint \"" <> hint <> "\""
476-
applyHintArguments = [toJSON (AOP (documentId ^. LSP.uri) start hint version)]
475+
applyHintArguments = [toJSON (AOP verTxtDocId start hint)]
477476
applyHintCommand = mkLspCommand pluginId "applyOne" applyHintTitle (Just applyHintArguments) ->
478477
Just (mkCodeAction applyHintTitle diagnostic Nothing (Just applyHintCommand) True)
479478
| otherwise -> Nothing
@@ -515,13 +514,13 @@ mkSuppressHintTextEdits dynFlags fileContents hint =
515514
combinedTextEdit : lineSplitTextEditList
516515
-- ---------------------------------------------------------------------
517516

518-
applyAllCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState (Uri, TextDocumentVersion)
519-
applyAllCmd recorder ide (uri, version) = do
520-
let file = maybe (error $ show uri ++ " is not a file.")
517+
applyAllCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState VersionedTextDocumentIdentifier
518+
applyAllCmd recorder ide verTxtDocId = do
519+
let file = maybe (error $ show (verTxtDocId ^. LSP.uri) ++ " is not a file.")
521520
toNormalizedFilePath'
522-
(uriToFilePath' uri)
521+
(uriToFilePath' (verTxtDocId ^. LSP.uri))
523522
withIndefiniteProgress "Applying all hints" Cancellable $ do
524-
res <- liftIO $ applyHint recorder ide file Nothing version
523+
res <- liftIO $ applyHint recorder ide file Nothing verTxtDocId
525524
logWith recorder Debug $ LogApplying file res
526525
case res of
527526
Left err -> pure $ Left (responseError (T.pack $ "hlint:applyAll: " ++ show err))
@@ -532,11 +531,10 @@ applyAllCmd recorder ide (uri, version) = do
532531
-- ---------------------------------------------------------------------
533532

534533
data ApplyOneParams = AOP
535-
{ file :: Uri
534+
{ verTxtDocId :: VersionedTextDocumentIdentifier
536535
, start_pos :: Position
537536
-- | There can be more than one hint suggested at the same position, so HintTitle is used to distinguish between them.
538537
, hintTitle :: HintTitle
539-
, textVersion :: TextDocumentVersion
540538
} deriving (Eq,Show,Generic,FromJSON,ToJSON)
541539

542540
type HintTitle = T.Text
@@ -547,22 +545,22 @@ data OneHint = OneHint
547545
} deriving (Eq, Show)
548546

549547
applyOneCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState ApplyOneParams
550-
applyOneCmd recorder ide (AOP uri pos title version) = do
548+
applyOneCmd recorder ide (AOP verTxtDocId pos title) = do
551549
let oneHint = OneHint pos title
552-
let file = maybe (error $ show uri ++ " is not a file.") toNormalizedFilePath'
553-
(uriToFilePath' uri)
550+
let file = maybe (error $ show (verTxtDocId ^. LSP.uri) ++ " is not a file.") toNormalizedFilePath'
551+
(uriToFilePath' (verTxtDocId ^. LSP.uri))
554552
let progTitle = "Applying hint: " <> title
555553
withIndefiniteProgress progTitle Cancellable $ do
556-
res <- liftIO $ applyHint recorder ide file (Just oneHint) version
554+
res <- liftIO $ applyHint recorder ide file (Just oneHint) verTxtDocId
557555
logWith recorder Debug $ LogApplying file res
558556
case res of
559557
Left err -> pure $ Left (responseError (T.pack $ "hlint:applyOne: " ++ show err))
560558
Right fs -> do
561559
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ())
562560
pure $ Right Null
563561

564-
applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> TextDocumentVersion -> IO (Either String WorkspaceEdit)
565-
applyHint recorder ide nfp mhint version =
562+
applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either String WorkspaceEdit)
563+
applyHint recorder ide nfp mhint verTxtDocId =
566564
runExceptT $ do
567565
let runAction' :: Action a -> IO a
568566
runAction' = runAction "applyHint" ide
@@ -619,8 +617,7 @@ applyHint recorder ide nfp mhint version =
619617
#endif
620618
case res of
621619
Right appliedFile -> do
622-
let uri = fromNormalizedUri (filePathToUri' nfp)
623-
let wsEdit = diffText' True (uri, oldContent) (T.pack appliedFile) IncludeDeletions version
620+
let wsEdit = diffText' True (verTxtDocId, oldContent) (T.pack appliedFile) IncludeDeletions
624621
ExceptT $ return (Right wsEdit)
625622
Left err ->
626623
throwE err

‎plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs‎

Lines changed: 6 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -210,16 +210,15 @@ instance Monad m => Monoid (Graft m a) where
210210
transform ::
211211
DynFlags ->
212212
ClientCapabilities ->
213-
Uri ->
214-
TextDocumentVersion ->
213+
VersionedTextDocumentIdentifier ->
215214
Graft (Either String) ParsedSource ->
216215
Annotated ParsedSource ->
217216
Either String WorkspaceEdit
218-
transform dflags ccs uri version f a = do
217+
transform dflags ccs verTxtDocId f a = do
219218
let src = printA a
220219
a' <- transformA a $ runGraft f dflags
221220
let res = printA a'
222-
pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions version
221+
pure $ diffText ccs (verTxtDocId, T.pack src) (T.pack res) IncludeDeletions
223222

224223
------------------------------------------------------------------------------
225224

@@ -228,17 +227,16 @@ transformM ::
228227
Monad m =>
229228
DynFlags ->
230229
ClientCapabilities ->
231-
Uri ->
232-
TextDocumentVersion ->
230+
VersionedTextDocumentIdentifier ->
233231
Graft (ExceptStringT m) ParsedSource ->
234232
Annotated ParsedSource ->
235233
m (Either String WorkspaceEdit)
236-
transformM dflags ccs uri version f a = runExceptT $
234+
transformM dflags ccs verTextDocId f a = runExceptT $
237235
runExceptString $ do
238236
let src = printA a
239237
a' <- transformA a $ runGraft f dflags
240238
let res = printA a'
241-
pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions version
239+
pure $ diffText ccs (verTextDocId, T.pack src) (T.pack res) IncludeDeletions
242240

243241

244242
-- | Returns whether or not this node requires its immediate children to have

‎plugins/hls-rename-plugin/hls-rename-plugin.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ library
3535
, hie-compat
3636
, hls-plugin-api == 2.0.0.0
3737
, hls-refactor-plugin
38+
, lens
3839
, lsp
3940
, lsp-types
4041
, mod

0 commit comments

Comments
 (0)