trace interface regeneration events

Author: pepeiborra

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

@@ -102,6 +102,7 @@ import           Data.Functor
 import qualified Data.HashMap.Strict               as HashMap
 import           Data.Tuple.Extra                  (dupe)
 import           Data.Unique                       as Unique
+import           Development.IDE.Core.Tracing      (withTrace)
 import qualified Language.LSP.Server               as LSP
 import qualified Language.LSP.Types                as LSP
 
@@ -899,7 +900,8 @@ loadHieFile ncu f = do
 --   Assumes file exists.
 --   Requires the 'HscEnv' to be set up with dependencies
 loadInterface
-  :: MonadIO m => HscEnv
+  :: (MonadIO m, MonadMask m)
+  => HscEnv
   -> ModSummary
   -> SourceModified
   -> Maybe LinkableType
@@ -939,7 +941,15 @@ loadInterface session ms sourceMod linkableNeeded regen = do
                hmi <- liftIO $ mkDetailsFromIface sessionWithMsDynFlags iface linkable
                return ([], Just $ mkHiFileResult ms hmi)
              else regen linkableNeeded
-          (_reason, _) -> regen linkableNeeded
+          (_reason, _) -> withTrace "regenerate interface" $ \setTag -> do
+                 setTag "Module" $ moduleNameString $ moduleName $ ms_mod ms
+                 setTag "Reason" $ showReason _reason
+                 regen linkableNeeded
+
+showReason :: RecompileRequired -> String
+showReason UpToDate          = "UpToDate"
+showReason MustCompile       = "MustCompile"
+showReason (RecompBecause s) = s
 
 mkDetailsFromIface :: HscEnv -> ModIface -> Maybe Linkable -> IO HomeModInfo
 mkDetailsFromIface session iface linkable = do

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

@@ -8,6 +8,7 @@ module Development.IDE.Core.Tracing
     , getInstrumentCached
     , otTracedProvider
     , otSetUri
+    , withTrace
     )
 where
 
@@ -19,7 +20,7 @@ import           Control.Exception.Safe         (SomeException, catch,
                                                  generalBracket)
 import           Control.Monad                  (forM_, forever, void, when,
                                                  (>=>))
-import           Control.Monad.Catch            (ExitCase (..))
+import           Control.Monad.Catch            (ExitCase (..), MonadMask)
 import           Control.Monad.Extra            (whenJust)
 import           Control.Monad.IO.Unlift
 import           Control.Seq                    (r0, seqList, seqTuple2, using)
@@ -57,6 +58,15 @@ import           OpenTelemetry.Eventlog         (Instrument, SpanInFlight (..),
                                                  mkValueObserver, observe,
                                                  setTag, withSpan, withSpan_)
 
+withTrace :: (MonadMask m, MonadIO m) =>
+    String -> ((String -> String -> m ()) -> m a) -> m a
+withTrace name act
+  | userTracingEnabled
+  = withSpan (fromString name) $ \sp -> do
+      let setSpan' k v = setTag sp (fromString k) (fromString v)
+      act setSpan'
+  | otherwise = act (\_ _ -> pure ())
+
 -- | Trace a handler using OpenTelemetry. Adds various useful info into tags in the OpenTelemetry span.
 otTracedHandler
     :: MonadUnliftIO m