Skip to content

Commit

Permalink
Also use VersionedTextDocumentIdentifier in wingman
Browse files Browse the repository at this point in the history
  • Loading branch information
maralorn committed Jun 11, 2023
1 parent b546609 commit b6f4c66
Show file tree
Hide file tree
Showing 5 changed files with 25 additions and 23 deletions.
20 changes: 9 additions & 11 deletions plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down
11 changes: 6 additions & 5 deletions plugins/hls-tactics-plugin/old/src/Wingman/AbstractLSP/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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

Expand Down Expand Up @@ -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)


Expand Down Expand Up @@ -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

6 changes: 4 additions & 2 deletions plugins/hls-tactics-plugin/old/src/Wingman/EmptyCase.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand All @@ -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

Expand All @@ -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
Expand Down
7 changes: 3 additions & 4 deletions plugins/hls-tactics-plugin/old/src/Wingman/LanguageServer.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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


Expand Down

0 comments on commit b6f4c66

Please sign in to comment.