diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index 96766c4e7c..3aa3eb4cf2 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -7,7 +7,8 @@ module Development.IDE.Spans.Pragmas , LineSplitTextEdits(..) , getNextPragmaInfo , insertNewPragma - , getFirstPragma ) where + , getFirstPragma + , getFirstPragmaFast ) where import Control.Lens ((&), (.~)) import Data.Bits (Bits (setBit)) @@ -17,7 +18,8 @@ import Data.Text (Text, pack) import qualified Data.Text as Text import Data.Text.Utf16.Rope.Mixed (Rope) import qualified Data.Text.Utf16.Rope.Mixed as Rope -import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, GhcSession (..), getFileContents, hscEnv, runAction) +import Development.IDE (srcSpanToRange, IdeState (..), NormalizedFilePath, GhcSession (..), getFileContents, hscEnv, runAction, GetFileContents (..), IdeAction) +import Development.IDE.Core.PositionMapping (PositionMapping) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import qualified Language.LSP.Protocol.Types as LSP @@ -50,12 +52,27 @@ insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit prag pragmaInsertPosition = LSP.Position (fromIntegral nextPragmaLine) 0 pragmaInsertRange = LSP.Range pragmaInsertPosition pragmaInsertPosition +-- | Compute where to insert the next pragma in @nfp@. +-- +-- Blocks the calling thread via 'runAction'. +-- NB: Prefer 'getFirstPragmaFast' when already inside an 'IdeAction' context. getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m NextPragmaInfo getFirstPragma (PluginId pId) state nfp = do (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE (T.unpack pId <> ".GhcSession") state $ useWithStaleE GhcSession nfp fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp pure $ getNextPragmaInfo sessionDynFlags fileContents +-- | Non-blocking variant of 'getFirstPragma' for use inside 'IdeAction'. +-- +-- Returns the pragma insertion info together with a 'PositionMapping' that +-- translates positions in the (possibly stale) file-contents snapshot to the +-- current editor view. +getFirstPragmaFast :: NormalizedFilePath -> ExceptT PluginError IdeAction (NextPragmaInfo, PositionMapping) +getFirstPragmaFast nfp = do + (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- useWithStaleFastE GhcSession nfp + ((_, fileContents), pm) <- useWithStaleFastE GetFileContents nfp + pure (getNextPragmaInfo sessionDynFlags fileContents, pm) + -- Pre-declaration comments parser ----------------------------------------------------- -- | Each mode represents the "strongest" thing we've seen so far. diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 17634491fe..774230dc89 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -197,7 +197,8 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif if isInlayHintsSupported state then do nfp <- getNormalizedFilePathE _uri - (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp + (ImportActionsResult {forLens, forResolve}, pm) <- + runIdeActionE "ImportActions" (shakeExtras state) $ useWithStaleFastE ImportActions nfp let inlayHints = [ inlayHint | (range, (int, _)) <- forLens , Just newRange <- [toCurrentRange pm range] diff --git a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs index 4d7ae6f353..de837ab35b 100644 --- a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs +++ b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs @@ -92,6 +92,7 @@ import Development.IDE.Graph (RuleResult) import Development.IDE.Graph.Classes (Hashable, NFData) import Development.IDE.Spans.Pragmas (NextPragmaInfo (..), getFirstPragma, + getFirstPragmaFast, insertNewPragma) import GHC.Generics (Generic) import GHC.Iface.Ext.Types (Identifier) @@ -225,14 +226,14 @@ codeActionResolveProvider ideState pId ca uri uid = do mkWorkspaceEdit edits = WorkspaceEdit (Just $ Map.singleton uri edits) Nothing Nothing inlayHintDotdotProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentInlayHint -inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumentIdentifier uri, _range = visibleRange} = do +inlayHintDotdotProvider _ state _pId InlayHintParams {_textDocument = TextDocumentIdentifier uri, _range = visibleRange} = do nfp <- getNormalizedFilePathE uri - pragma <- getFirstPragma pId state nfp runIdeActionE "ExplicitFields.CollectRecords" (shakeExtras state) $ do - (crr@CRR {crCodeActions, crCodeActionResolve}, pm) <- useWithStaleFastE CollectRecords nfp + (pragmaInfo, pragmaPM) <- getFirstPragmaFast nfp + (crr@CRR {crCodeActions, crCodeActionResolve}, recordPM) <- useWithStaleFastE CollectRecords nfp let -- Get all records with dotdot in current nfp records = [ record - | Just range <- [toCurrentRange pm visibleRange] + | Just range <- [toCurrentRange recordPM visibleRange] , uid <- RangeMap.elementsInRange range crCodeActions , Just record <- [IntMap.lookup uid crCodeActionResolve] ] -- Get the definition of each dotdot of record @@ -240,16 +241,21 @@ inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumen | record <- records , pos <- maybeToList $ fmap _start $ recordInfoToDotDotRange record ] defnLocsList <- lift $ sequence locations - pure $ InL $ mapMaybe (mkInlayHint crr pragma pm) defnLocsList + pure $ InL $ mapMaybe (mkInlayHint crr pragmaInfo pragmaPM recordPM) defnLocsList where - mkInlayHint :: CollectRecordsResult -> NextPragmaInfo -> PositionMapping -> (Maybe [(Location, Identifier)], RecordInfo) -> Maybe InlayHint - mkInlayHint CRR {enabledExtensions, nameMap} pragma pm (defnLocs, record) = + mapTextEditRange :: PositionMapping -> TextEdit -> Maybe TextEdit + mapTextEditRange pm (TextEdit r t) = (\r' -> TextEdit r' t) <$> toCurrentRange pm r + -- Two separate position mappings are required because 'GetFileContents' and + -- 'CollectRecords' can be at different stale generations: 'CollectRecords' + -- depends on 'TypeCheck', which is further downstream than 'GetFileContents'. + mkInlayHint :: CollectRecordsResult -> NextPragmaInfo -> PositionMapping -> PositionMapping -> (Maybe [(Location, Identifier)], RecordInfo) -> Maybe InlayHint + mkInlayHint CRR {enabledExtensions, nameMap} pragma pragmaPM recordPM (defnLocs, record) = let range = recordInfoToDotDotRange record - textEdits = maybeToList (renderRecordInfoAsTextEdit nameMap record) - <> maybeToList (pragmaEdit enabledExtensions pragma) + textEdits = mapMaybe (mapTextEditRange recordPM) (maybeToList (renderRecordInfoAsTextEdit nameMap record)) + <> mapMaybe (mapTextEditRange pragmaPM) (maybeToList (pragmaEdit enabledExtensions pragma)) names = renderRecordInfoAsDotdotLabelName record in do - currentEnd <- range >>= toCurrentPosition pm . _end + currentEnd <- range >>= toCurrentPosition recordPM . _end names' <- names defnLocs' <- defnLocs let excludeDotDot (Location _ (Range _ end)) = end /= currentEnd @@ -691,4 +697,3 @@ getRecPatterns _ = ([], False) printFieldName :: Outputable a => a -> Text printFieldName = stripOccNamePrefix . printOutputable -