Avoid blocking when prepping pragmas for inlay

Author: crtschin

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
@@ -61,6 +62,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.

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]

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
-