generate linkables only when Evaluating

In addition, we tune the newness check of the redefined NeedsCompilation rule so that the generated linkables are not thrown away unnecessarily, as described in:

ndmitchell/shake#794

Author: pepeiborra

ghcide/src/Development/IDE/Core/Shake.hs

@@ -871,17 +871,25 @@ usesWithStale key files = do
 data RuleBody k v
   = Rule (k -> NormalizedFilePath -> Action (Maybe BS.ByteString, IdeResult v))
   | RuleNoDiagnostics (k -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe v))
-
+  | RuleWithCustomNewnessCheck
+    { newnessCheck :: BS.ByteString -> BS.ByteString -> Bool
+    , build :: k -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe v)
+    }
 
 -- | Define a new Rule with early cutoff
 defineEarlyCutoff
     :: IdeRule k v
     => RuleBody k v
     -> Rules ()
 defineEarlyCutoff (Rule op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode traceA $ do
-    defineEarlyCutoff' True key file old mode $ op key file
+    defineEarlyCutoff' True (==) key file old mode $ op key file
 defineEarlyCutoff (RuleNoDiagnostics op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode traceA $ do
-    defineEarlyCutoff' False key file old mode $ second (mempty,) <$> op key file
+    defineEarlyCutoff' False (==) key file old mode $ second (mempty,) <$> op key file
+defineEarlyCutoff RuleWithCustomNewnessCheck{..} =
+    addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode ->
+        otTracedAction key file mode traceA $
+            defineEarlyCutoff' False newnessCheck key file old mode $
+                second (mempty,) <$> build key file
 
 defineNoFile :: IdeRule k v => (k -> Action v) -> Rules ()
 defineNoFile f = defineNoDiagnostics $ \k file -> do
@@ -896,13 +904,15 @@ defineEarlyCutOffNoFile f = defineEarlyCutoff $ RuleNoDiagnostics $ \k file -> d
 defineEarlyCutoff'
     :: IdeRule k v
     => Bool  -- ^ update diagnostics
+    -- | compare previous and current for freshness
+    -> (BS.ByteString -> BS.ByteString -> Bool)
     -> k
     -> NormalizedFilePath
     -> Maybe BS.ByteString
     -> RunMode
     -> Action (Maybe BS.ByteString, IdeResult v)
     -> Action (RunResult (A (RuleResult k)))
-defineEarlyCutoff' doDiagnostics key file old mode action = do
+defineEarlyCutoff' doDiagnostics cmp key file old mode action = do
     extras@ShakeExtras{state, progress, logger, dirtyKeys} <- getShakeExtras
     options <- getIdeOptions
     (if optSkipProgress options key then id else inProgress progress file) $ do
@@ -947,8 +957,8 @@ defineEarlyCutoff' doDiagnostics key file old mode action = do
                     then updateFileDiagnostics file (Key key) extras $ map (\(_,y,z) -> (y,z)) diags
                     else forM_ diags $ \d -> liftIO $ logWarning logger $ showDiagnosticsColored [d]
                 let eq = case (bs, fmap decodeShakeValue old) of
-                        (ShakeResult a, Just (ShakeResult b)) -> a == b
-                        (ShakeStale a, Just (ShakeStale b))   -> a == b
+                        (ShakeResult a, Just (ShakeResult b)) -> cmp a b
+                        (ShakeStale a, Just (ShakeStale b))   -> cmp a b
                         -- If we do not have a previous result
                         -- or we got ShakeNoCutoff we always return False.
                         _                                     -> False

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

@@ -51,6 +51,7 @@ import           Development.IDE                 (Action, GetDependencies (..),
                                                   HiFileResult (hirHomeMod, hirModSummary),
                                                   HscEnvEq, IdeState,
                                                   ModSummaryResult (..),
+                                                  NeedsCompilation (NeedsCompilation),
                                                   evalGhcEnv,
                                                   hscEnvWithImportPaths,
                                                   prettyPrint, runAction,
@@ -109,7 +110,10 @@ import           UnliftIO.Temporary              (withSystemTempFile)
 import           GHC.Driver.Session              (unitDatabases, unitState)
 import           GHC.Types.SrcLoc                (UnhelpfulSpanReason (UnhelpfulInteractive))
 #else
+import           Development.IDE.Core.FileStore  (setSomethingModified)
+import           Development.IDE.Types.Shake     (toKey)
 import           DynFlags
+import           Ide.Plugin.Eval.Rules           (queueForEvaluation)
 #endif
 
 
@@ -196,6 +200,10 @@ runEvalCmd st EvalParams{..} =
             let nfp = toNormalizedFilePath' fp
             mdlText <- moduleText _uri
 
+            -- enable codegen
+            liftIO $ queueForEvaluation st nfp
+            liftIO $ setSomethingModified st [toKey NeedsCompilation nfp] "Eval"
+
             session <- runGetSession st nfp
 
             ms <- fmap msrModSummary $

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs

@@ -3,25 +3,34 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 
-module Ide.Plugin.Eval.Rules (GetEvalComments(..), rules) where
+module Ide.Plugin.Eval.Rules (GetEvalComments(..), rules,queueForEvaluation) where
 
+import           Control.Monad.IO.Class               (MonadIO (liftIO))
+import           Data.HashSet                         (HashSet)
+import qualified Data.HashSet                         as Set
+import           Data.IORef
 import qualified Data.Map.Strict                      as Map
 import           Data.String                          (fromString)
 import           Development.IDE                      (GetModSummaryWithoutTimestamps (GetModSummaryWithoutTimestamps),
                                                        GetParsedModuleWithComments (GetParsedModuleWithComments),
-                                                       IsFileOfInterest (IsFileOfInterest),
-                                                       IsFileOfInterestResult (NotFOI),
+                                                       IdeState,
                                                        NeedsCompilation (NeedsCompilation),
+                                                       NormalizedFilePath,
                                                        RuleBody (RuleNoDiagnostics),
                                                        Rules, defineEarlyCutoff,
                                                        encodeLinkableType,
                                                        fromNormalizedFilePath,
                                                        msrModSummary,
                                                        realSrcSpanToRange,
-                                                       useWithStale_, use_)
+                                                       useWithStale_)
 import           Development.IDE.Core.PositionMapping (toCurrentRange)
 import           Development.IDE.Core.Rules           (computeLinkableType,
                                                        needsCompilationRule)
+import           Development.IDE.Core.Shake           (IsIdeGlobal,
+                                                       RuleBody (RuleWithCustomNewnessCheck),
+                                                       addIdeGlobal,
+                                                       getIdeGlobalAction,
+                                                       getIdeGlobalState)
 import           Development.IDE.GHC.Compat
 import qualified Development.IDE.GHC.Compat           as SrcLoc
 import qualified Development.IDE.GHC.Compat.Util      as FastString
@@ -33,6 +42,15 @@ rules :: Rules ()
 rules = do
     evalParsedModuleRule
     redefinedNeedsCompilation
+    addIdeGlobal . EvaluatingVar =<< liftIO(newIORef mempty)
+
+newtype EvaluatingVar = EvaluatingVar (IORef (HashSet NormalizedFilePath))
+instance IsIdeGlobal EvaluatingVar
+
+queueForEvaluation :: IdeState -> NormalizedFilePath -> IO ()
+queueForEvaluation ide nfp = do
+    EvaluatingVar var <- getIdeGlobalState ide
+    modifyIORef var (Set.insert nfp)
 
 #if MIN_VERSION_ghc(9,0,0)
 pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcLoc.RealSrcSpan
@@ -75,18 +93,24 @@ evalParsedModuleRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetEvalComments
     return (Just fingerPrint, Just comments)
 
 -- Redefine the NeedsCompilation rule to set the linkable type to Just _
--- whenever the module has Eval comments and is of interest.
+-- whenever the module is being evaluated
 -- This will ensure that the modules are loaded with linkables
 -- and the interactive session won't try to compile them on the fly,
 -- leading to much better performance of the evaluate code lens
 redefinedNeedsCompilation :: Rules ()
-redefinedNeedsCompilation = defineEarlyCutoff $ RuleNoDiagnostics $ \NeedsCompilation f -> do
-    (comments, _) <- useWithStale_ GetEvalComments f
-    isFOI <- use_ IsFileOfInterest f
-    if nullComments comments || isFOI == NotFOI then needsCompilationRule f else do
+redefinedNeedsCompilation = defineEarlyCutoff $ RuleWithCustomNewnessCheck (<=) $ \NeedsCompilation f -> do
+    EvaluatingVar var <- getIdeGlobalAction
+
+    isEvaluating <- liftIO $ (f `elem`) <$> readIORef var
+
+    if not isEvaluating then needsCompilationRule f else do
         ms <- msrModSummary . fst <$> useWithStale_ GetModSummaryWithoutTimestamps f
         let ms' = ms{ms_hspp_opts = df'}
             df' = xopt_set (ms_hspp_opts ms) LangExt.TemplateHaskell
             linkableType = computeLinkableType ms' [] []
             fp = encodeLinkableType linkableType
+
+        -- remove the module from the Evaluating state
+        liftIO $ modifyIORef var (Set.delete f)
+
         pure (Just fp, Just linkableType)