From b84b995e0bdaf62a52c3fab9b19f9d2151bb2206 Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Wed, 19 Apr 2023 22:21:30 +0800 Subject: [PATCH 1/7] Update version while editing to conform lsp spec --- .../src/Ide/Plugin/Class/CodeAction.hs | 22 +++++++++-------- .../src/Ide/Plugin/Class/Types.hs | 4 +++- plugins/hls-class-plugin/test/Main.hs | 24 +++++++++++++++++++ 3 files changed, 39 insertions(+), 11 deletions(-) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs index 6b18a8e1df..3f50b982d7 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs @@ -65,7 +65,7 @@ addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do pure Null where toTextDocumentEdit edit = - TextDocumentEdit (VersionedTextDocumentIdentifier uri (Just 0)) (List [InL edit]) + TextDocumentEdit (VersionedTextDocumentIdentifier uri textVersion) (List [InL edit]) mergeEdit :: WorkspaceEdit -> [TextEdit] -> WorkspaceEdit mergeEdit WorkspaceEdit{..} edits = WorkspaceEdit @@ -84,7 +84,8 @@ addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState TextDocumentCodeAction codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginResponse $ do nfp <- getNormalizedFilePath uri - actions <- join <$> mapM (mkActions nfp) methodDiags + version <- lift $ (^. J.version) <$> getVersionedTextDoc docId + actions <- join <$> mapM (mkActions nfp version) methodDiags pure $ List actions where uri = docId ^. J.uri @@ -95,9 +96,10 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe mkActions :: NormalizedFilePath + -> TextDocumentVersion -> Diagnostic -> ExceptT String (LspT Ide.Plugin.Config.Config IO) [Command |? CodeAction] - mkActions docPath diag = do + mkActions docPath textVersion diag = do (HAR {hieAst = ast}, pmap) <- handleMaybeM "Unable to GetHieAst" . liftIO . runAction "classplugin.findClassIdentifier.GetHieAst" state @@ -114,7 +116,7 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe implemented <- findImplementedMethods ast instancePosition logWith recorder Info (LogImplementedMethods cls implemented) pure - $ concatMap mkAction + $ concatMap (mkAction textVersion) $ nubOrdOn snd $ filter ((/=) mempty . snd) $ fmap (second (filter (\(bind, _) -> bind `notElem` implemented))) @@ -128,21 +130,21 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe minimalDef = minDefToMethodGroups range sigs $ classMinimalDef cls allClassMethods = ("all missing methods", makeMethodDefinitions range sigs) - mkAction :: MethodGroup -> [Command |? CodeAction] - mkAction (name, methods) + mkAction :: TextDocumentVersion -> MethodGroup -> [Command |? CodeAction] + mkAction textVersion (name, methods) = [ mkCodeAction title $ mkLspCommand plId codeActionCommandId title - (Just $ mkCmdParams methods False) + (Just $ mkCmdParams methods textVersion False) , mkCodeAction titleWithSig $ mkLspCommand plId codeActionCommandId titleWithSig - (Just $ mkCmdParams methods True) + (Just $ mkCmdParams methods textVersion True) ] where title = "Add placeholders for " <> name titleWithSig = title <> " with signature(s)" - mkCmdParams methodGroup withSig = - [toJSON (AddMinimalMethodsParams uri range (List methodGroup) withSig)] + mkCmdParams methodGroup textVersion withSig = + [toJSON (AddMinimalMethodsParams uri range (List methodGroup) withSig textVersion)] mkCodeAction title cmd = InR diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs index 8530b0f18f..8eddce1df7 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs @@ -1,10 +1,10 @@ + {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE BangPatterns #-} module Ide.Plugin.Class.Types where @@ -21,6 +21,7 @@ import Development.IDE.Graph.Classes import GHC.Generics import Ide.Plugin.Class.Utils import Ide.Types +import Language.LSP.Types (TextDocumentVersion) typeLensCommandId :: CommandId typeLensCommandId = "classplugin.typelens" @@ -38,6 +39,7 @@ data AddMinimalMethodsParams = AddMinimalMethodsParams , methodGroup :: List (T.Text, T.Text) -- ^ (name text, signature text) , withSig :: Bool + , textVersion :: TextDocumentVersion } deriving (Show, Eq, Generic, ToJSON, FromJSON) diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index b8c8cfaebc..c8215dbbf3 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/plugins/hls-class-plugin/test/Main.hs @@ -76,6 +76,30 @@ codeActionTests = testGroup [ "Add placeholders for 'f','g'" , "Add placeholders for 'f','g' with signature(s)" ] + , testCase "" $ runSessionWithServer classPlugin testDataDir $ do + doc <- createDoc "Version.hs" "haskell" "module Version where" + ver1 <- (^.J.version) <$> getVersionedDoc doc + liftIO $ ver1 @?= Just 0 + + -- Change the doc to ensure the version is not 0 + changeDoc doc + [ TextDocumentContentChangeEvent + Nothing + Nothing + (T.unlines ["module Version where", "data A a = A a", "instance Functor A where"]) + ] + ver2 <- (^.J.version) <$> getVersionedDoc doc + _ <- waitForDiagnostics + liftIO $ ver2 @?= Just 1 + + -- Execute the action and see what the version is + action <- head . concatMap (^.. _CACodeAction) <$> getAllCodeActions doc + executeCodeAction action + _ <- waitForDiagnostics + -- TODO: uncomment this after lsp-test fixed + -- ver3 <- (^.J.version) <$> getVersionedDoc doc + -- liftIO $ ver3 @?= Just 3 + pure mempty ] codeLensTests :: TestTree From b840a2745152f6c3c11c03ddff7c5f96b72cf15c Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Sat, 22 Apr 2023 18:25:54 +0800 Subject: [PATCH 2/7] Init fields --- hls-plugin-api/src/Ide/PluginUtils.hs | 8 ++-- .../src/Ide/Plugin/Class/CodeAction.hs | 4 +- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 43 +++++++++++-------- .../src/Development/IDE/GHC/ExactPrint.hs | 10 +++-- .../src/Ide/Plugin/Rename.hs | 21 +++++---- .../src/Ide/Plugin/Splice.hs | 11 +++-- .../src/Ide/Plugin/Splice/Types.hs | 2 + 7 files changed, 57 insertions(+), 42 deletions(-) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index f98b38ff80..4230decc12 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -98,7 +98,7 @@ data WithDeletions = IncludeDeletions | SkipDeletions deriving Eq -- | Generate a 'WorkspaceEdit' value from a pair of source Text -diffText :: ClientCapabilities -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit +diffText :: ClientCapabilities -> (Uri,T.Text) -> T.Text -> WithDeletions -> TextDocumentVersion -> WorkspaceEdit diffText clientCaps old new withDeletions = let supports = clientSupportsDocumentChanges clientCaps @@ -161,8 +161,8 @@ diffTextEdit fText f2Text withDeletions = J.List r -- | A pure version of 'diffText' for testing -diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit -diffText' supports (f,fText) f2Text withDeletions = +diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> TextDocumentVersion -> WorkspaceEdit +diffText' supports (f,fText) f2Text withDeletions version = if supports then WorkspaceEdit Nothing (Just docChanges) Nothing else WorkspaceEdit (Just h) Nothing Nothing @@ -170,7 +170,7 @@ diffText' supports (f,fText) f2Text withDeletions = diff = diffTextEdit fText f2Text withDeletions h = H.singleton f diff docChanges = J.List [InL docEdit] - docEdit = J.TextDocumentEdit (J.VersionedTextDocumentIdentifier f (Just 0)) $ fmap InL diff + docEdit = J.TextDocumentEdit (J.VersionedTextDocumentIdentifier f version) $ fmap InL diff -- --------------------------------------------------------------------- diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs index 3f50b982d7..010c6b9ebd 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs @@ -57,8 +57,8 @@ addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs let edit = if withSig - then mergeEdit (workspaceEdit caps old new) pragmaInsertion - else workspaceEdit caps old new + then mergeEdit (workspaceEdit caps old new textVersion) pragmaInsertion + else workspaceEdit caps old new textVersion void $ lift $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 89c07e55f1..f34a2786ca 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -121,6 +121,7 @@ import Ide.Types hiding import Language.Haskell.HLint as Hlint hiding (Error) import Language.LSP.Server (ProgressCancellable (Cancellable), + getVersionedTextDoc, sendRequest, withIndefiniteProgress) import Language.LSP.Types hiding @@ -407,8 +408,11 @@ codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction codeActionProvider ideState pluginId (CodeActionParams _ _ documentId _ context) | let TextDocumentIdentifier uri = documentId , Just docNormalizedFilePath <- uriToNormalizedFilePath (toNormalizedUri uri) - = liftIO $ fmap (Right . LSP.List . map LSP.InR) $ do + = do + version <- (^. LSP.version) <$> getVersionedTextDoc documentId + liftIO $ fmap (Right . LSP.List . map LSP.InR) $ do allDiagnostics <- atomically $ getDiagnostics ideState + let numHintsInDoc = length [diagnostic | (diagnosticNormalizedFilePath, _, diagnostic) <- allDiagnostics , validCommand diagnostic @@ -425,19 +429,19 @@ codeActionProvider ideState pluginId (CodeActionParams _ _ documentId _ context) pure if | Just modSummaryResult <- modSummaryResult , Just source <- source , let dynFlags = ms_hspp_opts $ msrModSummary modSummaryResult -> - diags >>= diagnosticToCodeActions dynFlags source pluginId documentId + diags >>= diagnosticToCodeActions dynFlags source pluginId documentId version | otherwise -> [] | otherwise -> pure [] if numHintsInDoc > 1 && numHintsInContext > 0 then do - pure $ singleHintCodeActions ++ [applyAllAction] + pure $ singleHintCodeActions ++ [applyAllAction version] else pure singleHintCodeActions | otherwise = pure $ Right $ LSP.List [] where - applyAllAction = - let args = Just [toJSON (documentId ^. LSP.uri)] + applyAllAction version = + let args = Just [toJSON (documentId ^. LSP.uri, version)] cmd = mkLspCommand pluginId "applyAll" "Apply all hints" args in LSP.CodeAction "Apply all hints" (Just LSP.CodeActionQuickFix) Nothing Nothing Nothing Nothing (Just cmd) Nothing @@ -451,8 +455,8 @@ codeActionProvider ideState pluginId (CodeActionParams _ _ documentId _ context) -- | Convert a hlint diagnostic into an apply and an ignore code action -- if applicable -diagnosticToCodeActions :: DynFlags -> T.Text -> PluginId -> TextDocumentIdentifier -> LSP.Diagnostic -> [LSP.CodeAction] -diagnosticToCodeActions dynFlags fileContents pluginId documentId diagnostic +diagnosticToCodeActions :: DynFlags -> T.Text -> PluginId -> TextDocumentIdentifier -> TextDocumentVersion -> LSP.Diagnostic -> [LSP.CodeAction] +diagnosticToCodeActions dynFlags fileContents pluginId documentId version diagnostic | LSP.Diagnostic{ _source = Just "hlint", _code = Just (InR code), _range = LSP.Range start _ } <- diagnostic , let TextDocumentIdentifier uri = documentId , let isHintApplicable = "refact:" `T.isPrefixOf` code @@ -469,7 +473,7 @@ diagnosticToCodeActions dynFlags fileContents pluginId documentId diagnostic -- Disabling the rule isn't, because less often used and configuration can be adapted. [ if | isHintApplicable , let applyHintTitle = "Apply hint \"" <> hint <> "\"" - applyHintArguments = [toJSON (AOP (documentId ^. LSP.uri) start hint)] + applyHintArguments = [toJSON (AOP (documentId ^. LSP.uri) start hint version)] applyHintCommand = mkLspCommand pluginId "applyOne" applyHintTitle (Just applyHintArguments) -> Just (mkCodeAction applyHintTitle diagnostic Nothing (Just applyHintCommand) True) | otherwise -> Nothing @@ -511,13 +515,13 @@ mkSuppressHintTextEdits dynFlags fileContents hint = combinedTextEdit : lineSplitTextEditList -- --------------------------------------------------------------------- -applyAllCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState Uri -applyAllCmd recorder ide uri = do +applyAllCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState (Uri, TextDocumentVersion) +applyAllCmd recorder ide (uri, version) = do let file = maybe (error $ show uri ++ " is not a file.") toNormalizedFilePath' (uriToFilePath' uri) withIndefiniteProgress "Applying all hints" Cancellable $ do - res <- liftIO $ applyHint recorder ide file Nothing + res <- liftIO $ applyHint recorder ide file Nothing version logWith recorder Debug $ LogApplying file res case res of Left err -> pure $ Left (responseError (T.pack $ "hlint:applyAll: " ++ show err)) @@ -528,10 +532,11 @@ applyAllCmd recorder ide uri = do -- --------------------------------------------------------------------- data ApplyOneParams = AOP - { file :: Uri - , start_pos :: Position + { file :: Uri + , start_pos :: Position -- | There can be more than one hint suggested at the same position, so HintTitle is used to distinguish between them. - , hintTitle :: HintTitle + , hintTitle :: HintTitle + , textVersion :: TextDocumentVersion } deriving (Eq,Show,Generic,FromJSON,ToJSON) type HintTitle = T.Text @@ -542,13 +547,13 @@ data OneHint = OneHint } deriving (Eq, Show) applyOneCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState ApplyOneParams -applyOneCmd recorder ide (AOP uri pos title) = do +applyOneCmd recorder ide (AOP uri pos title version) = do let oneHint = OneHint pos title let file = maybe (error $ show uri ++ " is not a file.") toNormalizedFilePath' (uriToFilePath' uri) let progTitle = "Applying hint: " <> title withIndefiniteProgress progTitle Cancellable $ do - res <- liftIO $ applyHint recorder ide file (Just oneHint) + res <- liftIO $ applyHint recorder ide file (Just oneHint) version logWith recorder Debug $ LogApplying file res case res of Left err -> pure $ Left (responseError (T.pack $ "hlint:applyOne: " ++ show err)) @@ -556,8 +561,8 @@ applyOneCmd recorder ide (AOP uri pos title) = do _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ()) pure $ Right Null -applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> IO (Either String WorkspaceEdit) -applyHint recorder ide nfp mhint = +applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> TextDocumentVersion -> IO (Either String WorkspaceEdit) +applyHint recorder ide nfp mhint version = runExceptT $ do let runAction' :: Action a -> IO a runAction' = runAction "applyHint" ide @@ -615,7 +620,7 @@ applyHint recorder ide nfp mhint = case res of Right appliedFile -> do let uri = fromNormalizedUri (filePathToUri' nfp) - let wsEdit = diffText' True (uri, oldContent) (T.pack appliedFile) IncludeDeletions + let wsEdit = diffText' True (uri, oldContent) (T.pack appliedFile) IncludeDeletions version ExceptT $ return (Right wsEdit) Left err -> throwE err diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index a265a1b505..6782c4e45a 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -211,14 +211,15 @@ transform :: DynFlags -> ClientCapabilities -> Uri -> + TextDocumentVersion -> Graft (Either String) ParsedSource -> Annotated ParsedSource -> Either String WorkspaceEdit -transform dflags ccs uri f a = do +transform dflags ccs uri version f a = do let src = printA a a' <- transformA a $ runGraft f dflags let res = printA a' - pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions + pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions version ------------------------------------------------------------------------------ @@ -228,15 +229,16 @@ transformM :: DynFlags -> ClientCapabilities -> Uri -> + TextDocumentVersion -> Graft (ExceptStringT m) ParsedSource -> Annotated ParsedSource -> m (Either String WorkspaceEdit) -transformM dflags ccs uri f a = runExceptT $ +transformM dflags ccs uri version f a = runExceptT $ runExceptString $ do let src = printA a a' <- transformA a $ runGraft f dflags let res = printA a' - pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions + pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions version -- | Returns whether or not this node requires its immediate children to have diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index f711eea36a..375be9fa11 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -6,9 +6,9 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE RecordWildCards #-} module Ide.Plugin.Rename (descriptor, E.Log) where @@ -17,20 +17,21 @@ import GHC.Parser.Annotation (AnnContext, AnnList, AnnParen, AnnPragma) #endif +import Compat.HieTypes import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Except -import Data.Generics import Data.Bifunctor (first) +import Data.Generics import Data.Hashable import Data.HashSet (HashSet) import qualified Data.HashSet as HS import Data.List.Extra hiding (length) import qualified Data.Map as M -import qualified Data.Set as S import Data.Maybe import Data.Mod.Word +import qualified Data.Set as S import qualified Data.Text as T import Development.IDE (Recorder, WithPriority, usePropertyAction) @@ -54,7 +55,7 @@ import Ide.PluginUtils import Ide.Types import Language.LSP.Server import Language.LSP.Types -import Compat.HieTypes +import qualified Language.LSP.Types.Lens as J instance Hashable (Mod a) where hash n = hash (unMod n) @@ -66,9 +67,10 @@ descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ (defaultP } renameProvider :: PluginMethodHandler IdeState TextDocumentRename -renameProvider state pluginId (RenameParams (TextDocumentIdentifier uri) pos _prog newNameText) = +renameProvider state pluginId (RenameParams docId@(TextDocumentIdentifier uri) pos _prog newNameText) = pluginResponse $ do nfp <- handleUriToNfp uri + VersionedTextDocumentIdentifier{_version = version} <- lift $ getVersionedTextDoc docId directOldNames <- getNamesAtPos state nfp pos directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames @@ -78,7 +80,7 @@ renameProvider state pluginId (RenameParams (TextDocumentIdentifier uri) pos _pr See the `IndirectPuns` test for an example. -} indirectOldNames <- concat . filter ((>1) . Prelude.length) <$> mapM (uncurry (getNamesAtPos state) . locToFilePos) directRefs - let oldNames = (filter matchesDirect indirectOldNames) ++ directOldNames + let oldNames = filter matchesDirect indirectOldNames ++ directOldNames matchesDirect n = occNameFS (nameOccName n) `elem` directFS where directFS = map (occNameFS. nameOccName) directOldNames @@ -92,7 +94,7 @@ renameProvider state pluginId (RenameParams (TextDocumentIdentifier uri) pos _pr -- Perform rename let newName = mkTcOcc $ T.unpack newNameText filesRefs = collectWith locToUri refs - getFileEdit = flip $ getSrcEdit state . replaceRefs newName + getFileEdit = flip $ getSrcEdit state version . replaceRefs newName fileEdits <- mapM (uncurry getFileEdit) filesRefs pure $ foldl' (<>) mempty fileEdits @@ -125,10 +127,11 @@ failWhenImportOrExport state nfp refLocs names = do getSrcEdit :: (MonadLsp config m) => IdeState -> + TextDocumentVersion -> (ParsedSource -> ParsedSource) -> Uri -> ExceptT String m WorkspaceEdit -getSrcEdit state updatePs uri = do +getSrcEdit state version updatePs uri = do ccs <- lift getClientCapabilities nfp <- handleUriToNfp uri annAst <- handleMaybeM ("No parsed source for: " ++ show nfp) $ liftIO $ runAction @@ -143,7 +146,7 @@ getSrcEdit state updatePs uri = do let src = T.pack $ exactPrint ps res = T.pack $ exactPrint (updatePs ps) #endif - pure $ diffText ccs (uri, src) res IncludeDeletions + pure $ diffText ccs (uri, src) res IncludeDeletions version -- | Replace names at every given `Location` (in a given `ParsedSource`) with a given new name. replaceRefs :: diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 6cd0b9ab7a..8c00100573 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -151,6 +151,7 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do dflags clientCapabilities uri + textVersion (graft (RealSrcSpan spliceSpan Nothing) expanded) ps maybe (throwE "No splice information found") (either throwE pure) $ @@ -167,6 +168,7 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do dflags clientCapabilities uri + textVersion (graftDecls (RealSrcSpan spliceSpan Nothing) expanded) ps <&> @@ -377,7 +379,7 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e initTcWithGbl hscEnv typechkd srcSpan $ case classifyAST spliceContext of IsHsDecl -> fmap (fmap $ adjustToRange uri ran) $ - flip (transformM dflags clientCapabilities uri) ps $ + flip (transformM dflags clientCapabilities uri textVersion) ps $ graftDeclsWithM (RealSrcSpan srcSpan Nothing) $ \case (L _spn (SpliceD _ (SpliceDecl _ (L _ spl) _))) -> do eExpr <- @@ -390,7 +392,7 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e pure $ Just eExpr _ -> pure Nothing OneToOneAST astP -> - flip (transformM dflags clientCapabilities uri) ps $ + flip (transformM dflags clientCapabilities uri textVersion) ps $ graftWithM (RealSrcSpan srcSpan Nothing) $ \case (L _spn (matchSplice astP -> Just spl)) -> do eExpr <- @@ -484,8 +486,9 @@ fromSearchResult _ = Nothing -- TODO: workaround when HieAst unavailable (e.g. when the module itself errors) -- TODO: Declaration Splices won't appear in HieAst; perhaps we must just use Parsed/Renamed ASTs? codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction -codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $ - fmap (maybe (Right $ List []) Right) $ +codeAction state plId (CodeActionParams _ _ docId ran _) = do + textVersion <- (^. J.version) <$> getVersionedTextDoc docId + liftIO $ fmap (maybe (Right $ List []) Right) $ runMaybeT $ do fp <- MaybeT $ pure $ uriToNormalizedFilePath $ toNormalizedUri theUri ParsedModule {..} <- diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs index b9e2124196..75395e8a4f 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs @@ -11,12 +11,14 @@ import Development.IDE (Uri) import Development.IDE.GHC.Compat (RealSrcSpan) import GHC.Generics (Generic) import Ide.Types (CommandId) +import Language.LSP.Types (TextDocumentVersion) -- | Parameter for the addMethods PluginCommand. data ExpandSpliceParams = ExpandSpliceParams { uri :: Uri , spliceSpan :: RealSrcSpan , spliceContext :: SpliceContext + , textVersion :: TextDocumentVersion } deriving (Show, Eq, Generic) deriving anyclass (ToJSON, FromJSON) From 871679450c770a05d444628ea7f39806875d4d07 Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Sat, 22 Apr 2023 18:27:51 +0800 Subject: [PATCH 3/7] Remove the empty line --- plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs index 8eddce1df7..e7caa99a90 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs @@ -1,4 +1,3 @@ - {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} From ab9cd349e9a370add1c23b98e9c33136eee54c40 Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Sat, 22 Apr 2023 21:12:57 +0800 Subject: [PATCH 4/7] modify for hls-tactics-plugin --- .../old/src/Wingman/AbstractLSP.hs | 14 ++++++++++---- .../old/src/Wingman/AbstractLSP/Types.hs | 1 + .../old/src/Wingman/EmptyCase.hs | 2 +- .../old/src/Wingman/LanguageServer.hs | 5 +++-- 4 files changed, 15 insertions(+), 7 deletions(-) diff --git a/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP.hs b/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP.hs index 000e2f3740..430f49d196 100644 --- a/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP.hs +++ b/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP.hs @@ -23,14 +23,16 @@ import Development.IDE.Core.UseStale import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource(GetAnnotatedParsedSource)) import qualified Ide.Plugin.Config as Plugin import Ide.Types -import Language.LSP.Server (LspM, sendRequest, getClientCapabilities) +import Language.LSP.Server (LspM, sendRequest, getClientCapabilities, getVersionedTextDoc) import qualified Language.LSP.Types as LSP +import qualified Language.LSP.Types.Lens as J import Language.LSP.Types hiding (CodeLens, CodeAction) import Wingman.AbstractLSP.Types import Wingman.EmptyCase (fromMaybeT) import Wingman.LanguageServer (runIde, getTacticConfigAction, getIdeDynflags, mkWorkspaceEdits, runStaleIde, showLspMessage, mkShowMessageParams) import Wingman.StaticPlugin (enableQuasiQuotes) import Wingman.Types +import Control.Lens ((^.)) ------------------------------------------------------------------------------ @@ -111,7 +113,7 @@ runContinuation plId cont state (fc, b) = do GraftEdit gr -> do ccs <- lift getClientCapabilities TrackedStale pm _ <- mapMaybeT liftIO $ stale GetAnnotatedParsedSource - case mkWorkspaceEdits (enableQuasiQuotes le_dflags) ccs (fc_uri le_fileContext) (unTrack pm) gr of + case mkWorkspaceEdits (enableQuasiQuotes le_dflags) ccs (fc_uri le_fileContext) (textVersion fc) (unTrack pm) gr of Left errs -> pure $ Just $ ResponseError { _code = InternalError @@ -176,11 +178,13 @@ codeActionProvider ) -> PluginMethodHandler IdeState TextDocumentCodeAction codeActionProvider sort k state plId - (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) = do + (CodeActionParams _ _ docId@(TextDocumentIdentifier uri) range _) = do + version <- (^. J.version) <$> getVersionedTextDoc docId fromMaybeT (Right $ List []) $ do let fc = FileContext { fc_uri = uri , fc_range = Just $ unsafeMkCurrent range + , textVersion = version } env <- buildEnv state plId fc args <- fetchTargetArgs @target env @@ -203,11 +207,13 @@ codeLensProvider ) -> PluginMethodHandler IdeState TextDocumentCodeLens codeLensProvider sort k state plId - (CodeLensParams _ _ (TextDocumentIdentifier uri)) = do + (CodeLensParams _ _ docId@(TextDocumentIdentifier uri)) = do + version <- (^. J.version) <$> getVersionedTextDoc docId fromMaybeT (Right $ List []) $ do let fc = FileContext { fc_uri = uri , fc_range = Nothing + , textVersion = version } env <- buildEnv state plId fc args <- fetchTargetArgs @target env diff --git a/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/Types.hs b/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/Types.hs index 750bdfaa2d..9301a0a17b 100644 --- a/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/Types.hs +++ b/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/Types.hs @@ -124,6 +124,7 @@ data FileContext = FileContext , fc_range :: Maybe (Tracked 'Current Range) -- ^ For code actions, this is 'Just'. For code lenses, you'll get -- a 'Nothing' in the request, and a 'Just' in the response. + , textVersion :: TextDocumentVersion } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (A.ToJSON, A.FromJSON) diff --git a/plugins/hls-tactics-plugin/old/src/Wingman/EmptyCase.hs b/plugins/hls-tactics-plugin/old/src/Wingman/EmptyCase.hs index a13d7c1a65..b65577ce4f 100644 --- a/plugins/hls-tactics-plugin/old/src/Wingman/EmptyCase.hs +++ b/plugins/hls-tactics-plugin/old/src/Wingman/EmptyCase.hs @@ -69,7 +69,7 @@ emptyCaseInteraction = Interaction $ (foldMap (hySingleton . occName . fst) bindings) ty edits <- liftMaybe $ hush $ - mkWorkspaceEdits le_dflags ccs fc_uri (unTrack pm) $ + mkWorkspaceEdits le_dflags ccs fc_uri textVersion (unTrack pm) $ graftMatchGroup (RealSrcSpan (unTrack ss) Nothing) $ noLoc matches pure diff --git a/plugins/hls-tactics-plugin/old/src/Wingman/LanguageServer.hs b/plugins/hls-tactics-plugin/old/src/Wingman/LanguageServer.hs index ad6d1b3ca1..7ff17a2241 100644 --- a/plugins/hls-tactics-plugin/old/src/Wingman/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/old/src/Wingman/LanguageServer.hs @@ -622,12 +622,13 @@ mkWorkspaceEdits :: DynFlags -> ClientCapabilities -> Uri + -> TextDocumentVersion -> Annotated ParsedSource -> Graft (Either String) ParsedSource -> Either UserFacingMessage WorkspaceEdit -mkWorkspaceEdits dflags ccs uri pm g = do +mkWorkspaceEdits dflags ccs uri version pm g = do let pm' = runIdentity $ transformA pm annotateMetaprograms - let response = transform dflags ccs uri g pm' + let response = transform dflags ccs uri version g pm' in first (InfrastructureError . T.pack) response From 0c57ac867089057074cb7651a98474604aaf4d54 Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Sat, 22 Apr 2023 21:14:35 +0800 Subject: [PATCH 5/7] name test --- plugins/hls-class-plugin/test/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index c8215dbbf3..586b117cb9 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/plugins/hls-class-plugin/test/Main.hs @@ -76,7 +76,7 @@ codeActionTests = testGroup [ "Add placeholders for 'f','g'" , "Add placeholders for 'f','g' with signature(s)" ] - , testCase "" $ runSessionWithServer classPlugin testDataDir $ do + , testCase "Update text document version" $ runSessionWithServer classPlugin testDataDir $ do doc <- createDoc "Version.hs" "haskell" "module Version where" ver1 <- (^.J.version) <$> getVersionedDoc doc liftIO $ ver1 @?= Just 0 From b54660998d1acdfe3f3ea2110192801156c99f64 Mon Sep 17 00:00:00 2001 From: maralorn Date: Sat, 10 Jun 2023 19:16:49 +0200 Subject: [PATCH 6/7] Pass VersionedTextDocumentIdentifier through --- hls-plugin-api/src/Ide/PluginUtils.hs | 12 +++-- .../src/Ide/Plugin/Class/CodeAction.hs | 35 +++++++------- .../src/Ide/Plugin/Class/Types.hs | 5 +- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 47 +++++++++---------- .../src/Development/IDE/GHC/ExactPrint.hs | 14 +++--- .../hls-rename-plugin/hls-rename-plugin.cabal | 1 + .../src/Ide/Plugin/Rename.hs | 19 ++++---- .../src/Ide/Plugin/Splice.hs | 20 ++++---- .../src/Ide/Plugin/Splice/Types.hs | 8 ++-- 9 files changed, 78 insertions(+), 83 deletions(-) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 4230decc12..14da81039a 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -41,6 +41,7 @@ where import Control.Arrow ((&&&)) +import Control.Lens ((^.)) import Control.Monad.Extra (maybeM) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) @@ -63,6 +64,7 @@ import Language.LSP.Types hiding SemanticTokensEdit (_start)) import qualified Language.LSP.Types as J import Language.LSP.Types.Capabilities +import qualified Language.LSP.Types.Lens as J import qualified Text.Megaparsec as P import qualified Text.Megaparsec.Char as P import qualified Text.Megaparsec.Char.Lexer as P @@ -98,7 +100,7 @@ data WithDeletions = IncludeDeletions | SkipDeletions deriving Eq -- | Generate a 'WorkspaceEdit' value from a pair of source Text -diffText :: ClientCapabilities -> (Uri,T.Text) -> T.Text -> WithDeletions -> TextDocumentVersion -> WorkspaceEdit +diffText :: ClientCapabilities -> (VersionedTextDocumentIdentifier,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit diffText clientCaps old new withDeletions = let supports = clientSupportsDocumentChanges clientCaps @@ -161,16 +163,16 @@ diffTextEdit fText f2Text withDeletions = J.List r -- | A pure version of 'diffText' for testing -diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> TextDocumentVersion -> WorkspaceEdit -diffText' supports (f,fText) f2Text withDeletions version = +diffText' :: Bool -> (VersionedTextDocumentIdentifier,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit +diffText' supports (verTxtDocId,fText) f2Text withDeletions = if supports then WorkspaceEdit Nothing (Just docChanges) Nothing else WorkspaceEdit (Just h) Nothing Nothing where diff = diffTextEdit fText f2Text withDeletions - h = H.singleton f diff + h = H.singleton (verTxtDocId ^. J.uri) diff docChanges = J.List [InL docEdit] - docEdit = J.TextDocumentEdit (J.VersionedTextDocumentIdentifier f version) $ fmap InL diff + docEdit = J.TextDocumentEdit verTxtDocId $ fmap InL diff -- --------------------------------------------------------------------- diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs index 010c6b9ebd..3af9ae8ce2 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs @@ -42,7 +42,7 @@ addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsP addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do caps <- getClientCapabilities pluginResponse $ do - nfp <- getNormalizedFilePath uri + nfp <- getNormalizedFilePath (verTxtDocId ^. J.uri) pm <- handleMaybeM "Unable to GetParsedModule" $ liftIO $ runAction "classplugin.addMethodPlaceholders.GetParsedModule" state @@ -57,15 +57,15 @@ addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs let edit = if withSig - then mergeEdit (workspaceEdit caps old new textVersion) pragmaInsertion - else workspaceEdit caps old new textVersion + then mergeEdit (workspaceEdit caps old new) pragmaInsertion + else workspaceEdit caps old new void $ lift $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) pure Null where toTextDocumentEdit edit = - TextDocumentEdit (VersionedTextDocumentIdentifier uri textVersion) (List [InL edit]) + TextDocumentEdit verTxtDocId (List [InL edit]) mergeEdit :: WorkspaceEdit -> [TextEdit] -> WorkspaceEdit mergeEdit WorkspaceEdit{..} edits = WorkspaceEdit @@ -76,19 +76,18 @@ addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do } workspaceEdit caps old new - = diffText caps (uri, old) new IncludeDeletions + = diffText caps (verTxtDocId, old) new IncludeDeletions -- | -- This implementation is ad-hoc in a sense that the diagnostic detection mechanism is -- sensitive to the format of diagnostic messages from GHC. codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState TextDocumentCodeAction codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginResponse $ do - nfp <- getNormalizedFilePath uri - version <- lift $ (^. J.version) <$> getVersionedTextDoc docId - actions <- join <$> mapM (mkActions nfp version) methodDiags + verTxtDocId <- lift $ getVersionedTextDoc docId + nfp <- getNormalizedFilePath (verTxtDocId ^. J.uri) + actions <- join <$> mapM (mkActions nfp verTxtDocId) methodDiags pure $ List actions where - uri = docId ^. J.uri List diags = context ^. J.diagnostics ghcDiags = filter (\d -> d ^. J.source == Just "typecheck") diags @@ -96,10 +95,10 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe mkActions :: NormalizedFilePath - -> TextDocumentVersion + -> VersionedTextDocumentIdentifier -> Diagnostic -> ExceptT String (LspT Ide.Plugin.Config.Config IO) [Command |? CodeAction] - mkActions docPath textVersion diag = do + mkActions docPath verTxtDocId diag = do (HAR {hieAst = ast}, pmap) <- handleMaybeM "Unable to GetHieAst" . liftIO . runAction "classplugin.findClassIdentifier.GetHieAst" state @@ -116,7 +115,7 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe implemented <- findImplementedMethods ast instancePosition logWith recorder Info (LogImplementedMethods cls implemented) pure - $ concatMap (mkAction textVersion) + $ concatMap mkAction $ nubOrdOn snd $ filter ((/=) mempty . snd) $ fmap (second (filter (\(bind, _) -> bind `notElem` implemented))) @@ -130,21 +129,21 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe minimalDef = minDefToMethodGroups range sigs $ classMinimalDef cls allClassMethods = ("all missing methods", makeMethodDefinitions range sigs) - mkAction :: TextDocumentVersion -> MethodGroup -> [Command |? CodeAction] - mkAction textVersion (name, methods) + mkAction :: MethodGroup -> [Command |? CodeAction] + mkAction (name, methods) = [ mkCodeAction title $ mkLspCommand plId codeActionCommandId title - (Just $ mkCmdParams methods textVersion False) + (Just $ mkCmdParams methods False) , mkCodeAction titleWithSig $ mkLspCommand plId codeActionCommandId titleWithSig - (Just $ mkCmdParams methods textVersion True) + (Just $ mkCmdParams methods True) ] where title = "Add placeholders for " <> name titleWithSig = title <> " with signature(s)" - mkCmdParams methodGroup textVersion withSig = - [toJSON (AddMinimalMethodsParams uri range (List methodGroup) withSig textVersion)] + mkCmdParams methodGroup withSig = + [toJSON (AddMinimalMethodsParams verTxtDocId range (List methodGroup) withSig)] mkCodeAction title cmd = InR diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs index e7caa99a90..ac1a4e02b3 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs @@ -20,7 +20,7 @@ import Development.IDE.Graph.Classes import GHC.Generics import Ide.Plugin.Class.Utils import Ide.Types -import Language.LSP.Types (TextDocumentVersion) +import Language.LSP.Types (VersionedTextDocumentIdentifier) typeLensCommandId :: CommandId typeLensCommandId = "classplugin.typelens" @@ -33,12 +33,11 @@ defaultIndent :: Int defaultIndent = 2 data AddMinimalMethodsParams = AddMinimalMethodsParams - { uri :: Uri + { verTxtDocId :: VersionedTextDocumentIdentifier , range :: Range , methodGroup :: List (T.Text, T.Text) -- ^ (name text, signature text) , withSig :: Bool - , textVersion :: TextDocumentVersion } deriving (Show, Eq, Generic, ToJSON, FromJSON) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index f34a2786ca..2c657a10c6 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -409,7 +409,7 @@ codeActionProvider ideState pluginId (CodeActionParams _ _ documentId _ context) | let TextDocumentIdentifier uri = documentId , Just docNormalizedFilePath <- uriToNormalizedFilePath (toNormalizedUri uri) = do - version <- (^. LSP.version) <$> getVersionedTextDoc documentId + verTxtDocId <- getVersionedTextDoc documentId liftIO $ fmap (Right . LSP.List . map LSP.InR) $ do allDiagnostics <- atomically $ getDiagnostics ideState @@ -429,19 +429,19 @@ codeActionProvider ideState pluginId (CodeActionParams _ _ documentId _ context) pure if | Just modSummaryResult <- modSummaryResult , Just source <- source , let dynFlags = ms_hspp_opts $ msrModSummary modSummaryResult -> - diags >>= diagnosticToCodeActions dynFlags source pluginId documentId version + diags >>= diagnosticToCodeActions dynFlags source pluginId verTxtDocId | otherwise -> [] | otherwise -> pure [] if numHintsInDoc > 1 && numHintsInContext > 0 then do - pure $ singleHintCodeActions ++ [applyAllAction version] + pure $ singleHintCodeActions ++ [applyAllAction verTxtDocId] else pure singleHintCodeActions | otherwise = pure $ Right $ LSP.List [] where - applyAllAction version = - let args = Just [toJSON (documentId ^. LSP.uri, version)] + applyAllAction verTxtDocId = + let args = Just [toJSON verTxtDocId] cmd = mkLspCommand pluginId "applyAll" "Apply all hints" args in LSP.CodeAction "Apply all hints" (Just LSP.CodeActionQuickFix) Nothing Nothing Nothing Nothing (Just cmd) Nothing @@ -455,17 +455,16 @@ codeActionProvider ideState pluginId (CodeActionParams _ _ documentId _ context) -- | Convert a hlint diagnostic into an apply and an ignore code action -- if applicable -diagnosticToCodeActions :: DynFlags -> T.Text -> PluginId -> TextDocumentIdentifier -> TextDocumentVersion -> LSP.Diagnostic -> [LSP.CodeAction] -diagnosticToCodeActions dynFlags fileContents pluginId documentId version diagnostic +diagnosticToCodeActions :: DynFlags -> T.Text -> PluginId -> VersionedTextDocumentIdentifier -> LSP.Diagnostic -> [LSP.CodeAction] +diagnosticToCodeActions dynFlags fileContents pluginId verTxtDocId diagnostic | LSP.Diagnostic{ _source = Just "hlint", _code = Just (InR code), _range = LSP.Range start _ } <- diagnostic - , let TextDocumentIdentifier uri = documentId , let isHintApplicable = "refact:" `T.isPrefixOf` code , let hint = T.replace "refact:" "" code , let suppressHintTitle = "Ignore hint \"" <> hint <> "\" in this module" , let suppressHintTextEdits = mkSuppressHintTextEdits dynFlags fileContents hint , let suppressHintWorkspaceEdit = LSP.WorkspaceEdit - (Just (Map.singleton uri (List suppressHintTextEdits))) + (Just (Map.singleton (verTxtDocId ^. LSP.uri) (List suppressHintTextEdits))) Nothing Nothing = catMaybes @@ -473,7 +472,7 @@ diagnosticToCodeActions dynFlags fileContents pluginId documentId version diagno -- Disabling the rule isn't, because less often used and configuration can be adapted. [ if | isHintApplicable , let applyHintTitle = "Apply hint \"" <> hint <> "\"" - applyHintArguments = [toJSON (AOP (documentId ^. LSP.uri) start hint version)] + applyHintArguments = [toJSON (AOP verTxtDocId start hint)] applyHintCommand = mkLspCommand pluginId "applyOne" applyHintTitle (Just applyHintArguments) -> Just (mkCodeAction applyHintTitle diagnostic Nothing (Just applyHintCommand) True) | otherwise -> Nothing @@ -515,13 +514,13 @@ mkSuppressHintTextEdits dynFlags fileContents hint = combinedTextEdit : lineSplitTextEditList -- --------------------------------------------------------------------- -applyAllCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState (Uri, TextDocumentVersion) -applyAllCmd recorder ide (uri, version) = do - let file = maybe (error $ show uri ++ " is not a file.") +applyAllCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState VersionedTextDocumentIdentifier +applyAllCmd recorder ide verTxtDocId = do + let file = maybe (error $ show (verTxtDocId ^. LSP.uri) ++ " is not a file.") toNormalizedFilePath' - (uriToFilePath' uri) + (uriToFilePath' (verTxtDocId ^. LSP.uri)) withIndefiniteProgress "Applying all hints" Cancellable $ do - res <- liftIO $ applyHint recorder ide file Nothing version + res <- liftIO $ applyHint recorder ide file Nothing verTxtDocId logWith recorder Debug $ LogApplying file res case res of Left err -> pure $ Left (responseError (T.pack $ "hlint:applyAll: " ++ show err)) @@ -532,11 +531,10 @@ applyAllCmd recorder ide (uri, version) = do -- --------------------------------------------------------------------- data ApplyOneParams = AOP - { file :: Uri + { verTxtDocId :: VersionedTextDocumentIdentifier , start_pos :: Position -- | There can be more than one hint suggested at the same position, so HintTitle is used to distinguish between them. , hintTitle :: HintTitle - , textVersion :: TextDocumentVersion } deriving (Eq,Show,Generic,FromJSON,ToJSON) type HintTitle = T.Text @@ -547,13 +545,13 @@ data OneHint = OneHint } deriving (Eq, Show) applyOneCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState ApplyOneParams -applyOneCmd recorder ide (AOP uri pos title version) = do +applyOneCmd recorder ide (AOP verTxtDocId pos title) = do let oneHint = OneHint pos title - let file = maybe (error $ show uri ++ " is not a file.") toNormalizedFilePath' - (uriToFilePath' uri) + let file = maybe (error $ show (verTxtDocId ^. LSP.uri) ++ " is not a file.") toNormalizedFilePath' + (uriToFilePath' (verTxtDocId ^. LSP.uri)) let progTitle = "Applying hint: " <> title withIndefiniteProgress progTitle Cancellable $ do - res <- liftIO $ applyHint recorder ide file (Just oneHint) version + res <- liftIO $ applyHint recorder ide file (Just oneHint) verTxtDocId logWith recorder Debug $ LogApplying file res case res of Left err -> pure $ Left (responseError (T.pack $ "hlint:applyOne: " ++ show err)) @@ -561,8 +559,8 @@ applyOneCmd recorder ide (AOP uri pos title version) = do _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ()) pure $ Right Null -applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> TextDocumentVersion -> IO (Either String WorkspaceEdit) -applyHint recorder ide nfp mhint version = +applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either String WorkspaceEdit) +applyHint recorder ide nfp mhint verTxtDocId = runExceptT $ do let runAction' :: Action a -> IO a runAction' = runAction "applyHint" ide @@ -619,8 +617,7 @@ applyHint recorder ide nfp mhint version = #endif case res of Right appliedFile -> do - let uri = fromNormalizedUri (filePathToUri' nfp) - let wsEdit = diffText' True (uri, oldContent) (T.pack appliedFile) IncludeDeletions version + let wsEdit = diffText' True (verTxtDocId, oldContent) (T.pack appliedFile) IncludeDeletions ExceptT $ return (Right wsEdit) Left err -> throwE err diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index 6782c4e45a..cd522278fa 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -210,16 +210,15 @@ instance Monad m => Monoid (Graft m a) where transform :: DynFlags -> ClientCapabilities -> - Uri -> - TextDocumentVersion -> + VersionedTextDocumentIdentifier -> Graft (Either String) ParsedSource -> Annotated ParsedSource -> Either String WorkspaceEdit -transform dflags ccs uri version f a = do +transform dflags ccs verTxtDocId f a = do let src = printA a a' <- transformA a $ runGraft f dflags let res = printA a' - pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions version + pure $ diffText ccs (verTxtDocId, T.pack src) (T.pack res) IncludeDeletions ------------------------------------------------------------------------------ @@ -228,17 +227,16 @@ transformM :: Monad m => DynFlags -> ClientCapabilities -> - Uri -> - TextDocumentVersion -> + VersionedTextDocumentIdentifier -> Graft (ExceptStringT m) ParsedSource -> Annotated ParsedSource -> m (Either String WorkspaceEdit) -transformM dflags ccs uri version f a = runExceptT $ +transformM dflags ccs verTextDocId f a = runExceptT $ runExceptString $ do let src = printA a a' <- transformA a $ runGraft f dflags let res = printA a' - pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions version + pure $ diffText ccs (verTextDocId, T.pack src) (T.pack res) IncludeDeletions -- | Returns whether or not this node requires its immediate children to have diff --git a/plugins/hls-rename-plugin/hls-rename-plugin.cabal b/plugins/hls-rename-plugin/hls-rename-plugin.cabal index 12476e2252..160eda6e92 100644 --- a/plugins/hls-rename-plugin/hls-rename-plugin.cabal +++ b/plugins/hls-rename-plugin/hls-rename-plugin.cabal @@ -35,6 +35,7 @@ library , hie-compat , hls-plugin-api == 2.0.0.0 , hls-refactor-plugin + , lens , lsp , lsp-types , mod diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index 375be9fa11..8506bb4b2c 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -18,6 +18,7 @@ import GHC.Parser.Annotation (AnnContext, AnnList, #endif import Compat.HieTypes +import Control.Lens ((^.)) import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class @@ -55,7 +56,7 @@ import Ide.PluginUtils import Ide.Types import Language.LSP.Server import Language.LSP.Types -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Types.Lens as LSP instance Hashable (Mod a) where hash n = hash (unMod n) @@ -70,7 +71,6 @@ renameProvider :: PluginMethodHandler IdeState TextDocumentRename renameProvider state pluginId (RenameParams docId@(TextDocumentIdentifier uri) pos _prog newNameText) = pluginResponse $ do nfp <- handleUriToNfp uri - VersionedTextDocumentIdentifier{_version = version} <- lift $ getVersionedTextDoc docId directOldNames <- getNamesAtPos state nfp pos directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames @@ -94,8 +94,10 @@ renameProvider state pluginId (RenameParams docId@(TextDocumentIdentifier uri) p -- Perform rename let newName = mkTcOcc $ T.unpack newNameText filesRefs = collectWith locToUri refs - getFileEdit = flip $ getSrcEdit state version . replaceRefs newName - fileEdits <- mapM (uncurry getFileEdit) filesRefs + getFileEdit (uri, locations) = do + verTxtDocId <- lift $ getVersionedTextDoc (TextDocumentIdentifier uri) + getSrcEdit state verTxtDocId (replaceRefs newName locations) + fileEdits <- mapM getFileEdit filesRefs pure $ foldl' (<>) mempty fileEdits -- | Limit renaming across modules. @@ -127,13 +129,12 @@ failWhenImportOrExport state nfp refLocs names = do getSrcEdit :: (MonadLsp config m) => IdeState -> - TextDocumentVersion -> + VersionedTextDocumentIdentifier -> (ParsedSource -> ParsedSource) -> - Uri -> ExceptT String m WorkspaceEdit -getSrcEdit state version updatePs uri = do +getSrcEdit state verTxtDocId updatePs = do ccs <- lift getClientCapabilities - nfp <- handleUriToNfp uri + nfp <- handleUriToNfp (verTxtDocId ^. LSP.uri) annAst <- handleMaybeM ("No parsed source for: " ++ show nfp) $ liftIO $ runAction "Rename.GetAnnotatedParsedSource" state @@ -146,7 +147,7 @@ getSrcEdit state version updatePs uri = do let src = T.pack $ exactPrint ps res = T.pack $ exactPrint (updatePs ps) #endif - pure $ diffText ccs (uri, src) res IncludeDeletions version + pure $ diffText ccs (verTxtDocId, src) res IncludeDeletions -- | Replace names at every given `Location` (in a given `ParsedSource`) with a given new name. replaceRefs :: diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 8c00100573..651e31308c 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -150,8 +150,7 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do transform dflags clientCapabilities - uri - textVersion + verTxtDocId (graft (RealSrcSpan spliceSpan Nothing) expanded) ps maybe (throwE "No splice information found") (either throwE pure) $ @@ -167,17 +166,16 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do transform dflags clientCapabilities - uri - textVersion + verTxtDocId (graftDecls (RealSrcSpan spliceSpan Nothing) expanded) ps <&> -- FIXME: Why ghc-exactprint sweeps preceding comments? - adjustToRange uri range + adjustToRange (verTxtDocId ^. J.uri) range res <- liftIO $ runMaybeT $ do - fp <- MaybeT $ pure $ uriToNormalizedFilePath $ toNormalizedUri uri + fp <- MaybeT $ pure $ uriToNormalizedFilePath $ toNormalizedUri (verTxtDocId ^. J.uri) eedits <- ( lift . runExceptT . withTypeChecked fp =<< MaybeT @@ -378,8 +376,8 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e (msgs, eresl) <- initTcWithGbl hscEnv typechkd srcSpan $ case classifyAST spliceContext of - IsHsDecl -> fmap (fmap $ adjustToRange uri ran) $ - flip (transformM dflags clientCapabilities uri textVersion) ps $ + IsHsDecl -> fmap (fmap $ adjustToRange (verTxtDocId ^. J.uri) ran) $ + flip (transformM dflags clientCapabilities verTxtDocId) ps $ graftDeclsWithM (RealSrcSpan srcSpan Nothing) $ \case (L _spn (SpliceD _ (SpliceDecl _ (L _ spl) _))) -> do eExpr <- @@ -392,7 +390,7 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e pure $ Just eExpr _ -> pure Nothing OneToOneAST astP -> - flip (transformM dflags clientCapabilities uri textVersion) ps $ + flip (transformM dflags clientCapabilities verTxtDocId) ps $ graftWithM (RealSrcSpan srcSpan Nothing) $ \case (L _spn (matchSplice astP -> Just spl)) -> do eExpr <- @@ -487,7 +485,7 @@ fromSearchResult _ = Nothing -- TODO: Declaration Splices won't appear in HieAst; perhaps we must just use Parsed/Renamed ASTs? codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction codeAction state plId (CodeActionParams _ _ docId ran _) = do - textVersion <- (^. J.version) <$> getVersionedTextDoc docId + verTxtDocId <- getVersionedTextDoc docId liftIO $ fmap (maybe (Right $ List []) Right) $ runMaybeT $ do fp <- MaybeT $ pure $ uriToNormalizedFilePath $ toNormalizedUri theUri @@ -499,7 +497,7 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = do mcmds <- forM mouterSplice $ \(spliceSpan, spliceContext) -> forM expandStyles $ \(_, (title, cmdId)) -> do - let params = ExpandSpliceParams {uri = theUri, ..} + let params = ExpandSpliceParams {verTxtDocId, ..} act = mkLspCommand plId cmdId title (Just [toJSON params]) pure $ InR $ diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs index 75395e8a4f..f74816519a 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice/Types.hs @@ -7,18 +7,18 @@ module Ide.Plugin.Splice.Types where import Data.Aeson (FromJSON, ToJSON) import qualified Data.Text as T -import Development.IDE (Uri) + -- This import is needed for the ToJSON/FromJSON instances of RealSrcSpan +import Development.IDE () import Development.IDE.GHC.Compat (RealSrcSpan) import GHC.Generics (Generic) import Ide.Types (CommandId) -import Language.LSP.Types (TextDocumentVersion) +import Language.LSP.Types (VersionedTextDocumentIdentifier) -- | Parameter for the addMethods PluginCommand. data ExpandSpliceParams = ExpandSpliceParams - { uri :: Uri + { verTxtDocId :: VersionedTextDocumentIdentifier , spliceSpan :: RealSrcSpan , spliceContext :: SpliceContext - , textVersion :: TextDocumentVersion } deriving (Show, Eq, Generic) deriving anyclass (ToJSON, FromJSON) From b6f4c666750ae7ccdc785899725096d90f2feec9 Mon Sep 17 00:00:00 2001 From: maralorn Date: Sun, 11 Jun 2023 15:25:03 +0200 Subject: [PATCH 7/7] Also use VersionedTextDocumentIdentifier in wingman --- .../old/src/Wingman/AbstractLSP.hs | 20 +++++++++---------- .../src/Wingman/AbstractLSP/TacticActions.hs | 4 +++- .../old/src/Wingman/AbstractLSP/Types.hs | 11 +++++----- .../old/src/Wingman/EmptyCase.hs | 6 ++++-- .../old/src/Wingman/LanguageServer.hs | 7 +++---- 5 files changed, 25 insertions(+), 23 deletions(-) diff --git a/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP.hs b/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP.hs index 430f49d196..65e8b2e508 100644 --- a/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP.hs +++ b/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP.hs @@ -96,7 +96,7 @@ runContinuation plId cont state (fc, b) = do , _xdata = Nothing } ) $ do env@LspEnv{..} <- buildEnv state plId fc - nfp <- getNfp $ fc_uri le_fileContext + nfp <- getNfp $ fc_verTxtDocId le_fileContext ^. J.uri let stale a = runStaleIde "runContinuation" state nfp a args <- fetchTargetArgs @a env res <- c_runCommand cont env args fc b @@ -113,7 +113,7 @@ runContinuation plId cont state (fc, b) = do GraftEdit gr -> do ccs <- lift getClientCapabilities TrackedStale pm _ <- mapMaybeT liftIO $ stale GetAnnotatedParsedSource - case mkWorkspaceEdits (enableQuasiQuotes le_dflags) ccs (fc_uri le_fileContext) (textVersion fc) (unTrack pm) gr of + case mkWorkspaceEdits (enableQuasiQuotes le_dflags) ccs (fc_verTxtDocId le_fileContext) (unTrack pm) gr of Left errs -> pure $ Just $ ResponseError { _code = InternalError @@ -155,7 +155,7 @@ buildEnv -> MaybeT (LspM Plugin.Config) LspEnv buildEnv state plId fc = do cfg <- liftIO $ runIde "plugin" "config" state $ getTacticConfigAction plId - nfp <- getNfp $ fc_uri fc + nfp <- getNfp $ fc_verTxtDocId fc ^. J.uri dflags <- mapMaybeT liftIO $ getIdeDynflags state nfp pure $ LspEnv { le_ideState = state @@ -178,13 +178,12 @@ codeActionProvider ) -> PluginMethodHandler IdeState TextDocumentCodeAction codeActionProvider sort k state plId - (CodeActionParams _ _ docId@(TextDocumentIdentifier uri) range _) = do - version <- (^. J.version) <$> getVersionedTextDoc docId + (CodeActionParams _ _ docId range _) = do + verTxtDocId <- getVersionedTextDoc docId fromMaybeT (Right $ List []) $ do let fc = FileContext - { fc_uri = uri + { fc_verTxtDocId = verTxtDocId , fc_range = Just $ unsafeMkCurrent range - , textVersion = version } env <- buildEnv state plId fc args <- fetchTargetArgs @target env @@ -207,13 +206,12 @@ codeLensProvider ) -> PluginMethodHandler IdeState TextDocumentCodeLens codeLensProvider sort k state plId - (CodeLensParams _ _ docId@(TextDocumentIdentifier uri)) = do - version <- (^. J.version) <$> getVersionedTextDoc docId + (CodeLensParams _ _ docId) = do + verTxtDocId <- getVersionedTextDoc docId fromMaybeT (Right $ List []) $ do let fc = FileContext - { fc_uri = uri + { fc_verTxtDocId = verTxtDocId , fc_range = Nothing - , textVersion = version } env <- buildEnv state plId fc args <- fetchTargetArgs @target env diff --git a/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/TacticActions.hs b/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/TacticActions.hs index bb30f27b02..fde29db9f7 100644 --- a/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/TacticActions.hs +++ b/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/TacticActions.hs @@ -4,6 +4,7 @@ module Wingman.AbstractLSP.TacticActions where +import Control.Lens ((^.)) import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans (lift) @@ -16,6 +17,7 @@ import Development.IDE.Core.UseStale import Development.IDE.GHC.Compat import Development.IDE.GHC.ExactPrint import Generics.SYB.GHC (mkBindListT, everywhereM') +import qualified Language.LSP.Types.Lens as LSP import Wingman.AbstractLSP.Types import Wingman.CaseSplit import Wingman.GHC (liftMaybe, isHole, pattern AMatch) @@ -45,7 +47,7 @@ makeTacticInteraction cmd = } ) $ \LspEnv{..} HoleJudgment{..} FileContext{..} var_name -> do - nfp <- getNfp fc_uri + nfp <- getNfp (fc_verTxtDocId ^. LSP.uri) let stale a = runStaleIde "tacticCmd" le_ideState nfp a let span = fmap (rangeToRealSrcSpan (fromNormalizedFilePath nfp)) hj_range diff --git a/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/Types.hs b/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/Types.hs index 9301a0a17b..eea5c70b15 100644 --- a/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/Types.hs +++ b/plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/Types.hs @@ -9,6 +9,7 @@ module Wingman.AbstractLSP.Types where import Control.Monad.IO.Class import Control.Monad.Trans.Maybe (MaybeT (MaybeT), mapMaybeT) +import Control.Lens ((^.)) import qualified Data.Aeson as A import Data.Text (Text) import Development.IDE (IdeState) @@ -20,6 +21,7 @@ import qualified Ide.Plugin.Config as Plugin import Ide.Types hiding (Config) import Language.LSP.Server (LspM) import Language.LSP.Types hiding (CodeLens, CodeAction) +import qualified Language.LSP.Types.Lens as LSP import Wingman.LanguageServer (judgementForHole) import Wingman.Types @@ -120,13 +122,12 @@ data Continuation sort target payload = Continuation ------------------------------------------------------------------------------ -- | What file are we looking at, and what bit of it? data FileContext = FileContext - { fc_uri :: Uri - , fc_range :: Maybe (Tracked 'Current Range) + { fc_verTxtDocId :: VersionedTextDocumentIdentifier + , fc_range :: Maybe (Tracked 'Current Range) -- ^ For code actions, this is 'Just'. For code lenses, you'll get -- a 'Nothing' in the request, and a 'Just' in the response. - , textVersion :: TextDocumentVersion } - deriving stock (Eq, Ord, Show, Generic) + deriving stock (Eq, Show, Generic) deriving anyclass (A.ToJSON, A.FromJSON) @@ -165,6 +166,6 @@ instance IsTarget HoleTarget where fetchTargetArgs LspEnv{..} = do let FileContext{..} = le_fileContext range <- MaybeT $ pure fc_range - nfp <- getNfp fc_uri + nfp <- getNfp (fc_verTxtDocId ^. LSP.uri) mapMaybeT liftIO $ judgementForHole le_ideState nfp range le_config diff --git a/plugins/hls-tactics-plugin/old/src/Wingman/EmptyCase.hs b/plugins/hls-tactics-plugin/old/src/Wingman/EmptyCase.hs index b65577ce4f..48a490f9d5 100644 --- a/plugins/hls-tactics-plugin/old/src/Wingman/EmptyCase.hs +++ b/plugins/hls-tactics-plugin/old/src/Wingman/EmptyCase.hs @@ -7,6 +7,7 @@ module Wingman.EmptyCase where import Control.Applicative (empty) +import Control.Lens import Control.Monad import Control.Monad.Except (runExcept) import Control.Monad.Trans @@ -27,6 +28,7 @@ import Development.IDE.Spans.LocalBindings (getLocalScope) import Ide.Types import Language.LSP.Server import Language.LSP.Types +import qualified Language.LSP.Types.Lens as LSP import Prelude hiding (span) import Wingman.AbstractLSP.Types import Wingman.CodeGen (destructionFor) @@ -50,7 +52,7 @@ emptyCaseInteraction = Interaction $ Continuation @EmptyCaseT @EmptyCaseT @WorkspaceEdit EmptyCaseT (SynthesizeCodeLens $ \LspEnv{..} _ -> do let FileContext{..} = le_fileContext - nfp <- getNfp fc_uri + nfp <- getNfp (fc_verTxtDocId ^. LSP.uri) let stale a = runStaleIde "codeLensProvider" le_ideState nfp a @@ -69,7 +71,7 @@ emptyCaseInteraction = Interaction $ (foldMap (hySingleton . occName . fst) bindings) ty edits <- liftMaybe $ hush $ - mkWorkspaceEdits le_dflags ccs fc_uri textVersion (unTrack pm) $ + mkWorkspaceEdits le_dflags ccs fc_verTxtDocId (unTrack pm) $ graftMatchGroup (RealSrcSpan (unTrack ss) Nothing) $ noLoc matches pure diff --git a/plugins/hls-tactics-plugin/old/src/Wingman/LanguageServer.hs b/plugins/hls-tactics-plugin/old/src/Wingman/LanguageServer.hs index 7ff17a2241..3c3ba22ce3 100644 --- a/plugins/hls-tactics-plugin/old/src/Wingman/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/old/src/Wingman/LanguageServer.hs @@ -621,14 +621,13 @@ mkDiagnostic severity r = mkWorkspaceEdits :: DynFlags -> ClientCapabilities - -> Uri - -> TextDocumentVersion + -> VersionedTextDocumentIdentifier -> Annotated ParsedSource -> Graft (Either String) ParsedSource -> Either UserFacingMessage WorkspaceEdit -mkWorkspaceEdits dflags ccs uri version pm g = do +mkWorkspaceEdits dflags ccs verTxtDocId pm g = do let pm' = runIdentity $ transformA pm annotateMetaprograms - let response = transform dflags ccs uri version g pm' + let response = transform dflags ccs verTxtDocId g pm' in first (InfrastructureError . T.pack) response