From 7aeccc181fc9af3339cf19178b2344f24b9f4218 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Fri, 3 Apr 2026 16:01:49 +0200 Subject: [PATCH 1/3] Avoid blocking when prepping pragmas for inlay --- ghcide/src/Development/IDE/Spans/Pragmas.hs | 12 ++++++++++-- .../src/Ide/Plugin/ExplicitImports.hs | 3 ++- .../src/Ide/Plugin/ExplicitFields.hs | 4 ++-- 3 files changed, 14 insertions(+), 5 deletions(-) diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index 96766c4e7c..5218e90643 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,7 @@ 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 (..)) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import qualified Language.LSP.Protocol.Types as LSP @@ -56,6 +57,13 @@ getFirstPragma (PluginId pId) state nfp = do fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp pure $ getNextPragmaInfo sessionDynFlags fileContents +getFirstPragmaFast :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m NextPragmaInfo +getFirstPragmaFast (PluginId pId) state nfp = do + runIdeActionE (T.unpack pId <> ".GhcSession") (shakeExtras state) $ do + (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- useWithStaleFastE GhcSession nfp + fileContents <- fmap (snd . fst) $ useWithStaleFastE GetFileContents nfp + pure $ getNextPragmaInfo sessionDynFlags fileContents + -- 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..0accf0ef70 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) @@ -227,8 +228,8 @@ codeActionResolveProvider ideState pId ca uri uid = do inlayHintDotdotProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentInlayHint inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumentIdentifier uri, _range = visibleRange} = do nfp <- getNormalizedFilePathE uri - pragma <- getFirstPragma pId state nfp runIdeActionE "ExplicitFields.CollectRecords" (shakeExtras state) $ do + pragma <- getFirstPragmaFast pId state nfp (crr@CRR {crCodeActions, crCodeActionResolve}, pm) <- useWithStaleFastE CollectRecords nfp let -- Get all records with dotdot in current nfp records = [ record @@ -691,4 +692,3 @@ getRecPatterns _ = ([], False) printFieldName :: Outputable a => a -> Text printFieldName = stripOccNamePrefix . printOutputable - From 6d50e3eb9bd2e777615366e440906b699f229389 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sat, 18 Apr 2026 22:15:24 +0200 Subject: [PATCH 2/3] Incorporate position mapping in pragma and record inlays --- ghcide/src/Development/IDE/Spans/Pragmas.hs | 14 ++++++------- .../src/Ide/Plugin/ExplicitFields.hs | 21 ++++++++++--------- 2 files changed, 18 insertions(+), 17 deletions(-) diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index 5218e90643..4527f28547 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -18,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, GetFileContents (..)) +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 @@ -57,12 +58,11 @@ getFirstPragma (PluginId pId) state nfp = do fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp pure $ getNextPragmaInfo sessionDynFlags fileContents -getFirstPragmaFast :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m NextPragmaInfo -getFirstPragmaFast (PluginId pId) state nfp = do - runIdeActionE (T.unpack pId <> ".GhcSession") (shakeExtras state) $ do - (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- useWithStaleFastE GhcSession nfp - fileContents <- fmap (snd . fst) $ useWithStaleFastE GetFileContents nfp - pure $ getNextPragmaInfo sessionDynFlags fileContents +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 ----------------------------------------------------- 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 0accf0ef70..0a56b93768 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 @@ -226,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 runIdeActionE "ExplicitFields.CollectRecords" (shakeExtras state) $ do - pragma <- getFirstPragmaFast pId state nfp - (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 @@ -241,16 +241,17 @@ 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 pm (TextEdit r t) = (\r' -> TextEdit r' t) <$> toCurrentRange pm r + 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 From 15774eb61664e0b5927758763a78fe18937fa62b Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sat, 18 Apr 2026 23:30:43 +0200 Subject: [PATCH 3/3] Add comments --- ghcide/src/Development/IDE/Spans/Pragmas.hs | 11 ++++++++++- .../src/Ide/Plugin/ExplicitFields.hs | 4 ++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index 4527f28547..3aa3eb4cf2 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -52,17 +52,26 @@ 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) + pure (getNextPragmaInfo sessionDynFlags fileContents, pm) -- Pre-declaration comments parser ----------------------------------------------------- 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 0a56b93768..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 @@ -243,7 +243,11 @@ inlayHintDotdotProvider _ state _pId InlayHintParams {_textDocument = TextDocume defnLocsList <- lift $ sequence locations pure $ InL $ mapMaybe (mkInlayHint crr pragmaInfo pragmaPM recordPM) defnLocsList where + 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