From b6f4c666750ae7ccdc785899725096d90f2feec9 Mon Sep 17 00:00:00 2001 From: maralorn Date: Sun, 11 Jun 2023 15:25:03 +0200 Subject: [PATCH] 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