trace recordDirtyKeys calls

Author: pepeiborra

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

@@ -439,8 +439,10 @@ recordDirtyKeys
   -> k
   -> [NormalizedFilePath]
   -> IO ()
-recordDirtyKeys ShakeExtras{dirtyKeys} key file =
+recordDirtyKeys ShakeExtras{dirtyKeys} key file = withEventTrace "recordDirtyKeys" $ \addEvent -> do
     atomicModifyIORef_ dirtyKeys $ \x -> foldl' (flip HSet.insert) x (toKey key <$> file)
+    addEvent (fromString $ "dirty " <> show key) (fromString $ unlines $ map fromNormalizedFilePath file)
+
 
 -- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value.
 getValues ::

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

@@ -9,7 +9,7 @@ module Development.IDE.Core.Tracing
     , otTracedProvider
     , otSetUri
     , withTrace
-    )
+    ,withEventTrace)
 where
 
 import           Control.Concurrent.Async       (Async, async)
@@ -67,6 +67,14 @@ withTrace name act
       act setSpan'
   | otherwise = act (\_ _ -> pure ())
 
+withEventTrace :: (MonadMask m, MonadIO m) =>
+    String -> ((ByteString -> ByteString -> m ()) -> m a) -> m a
+withEventTrace name act
+  | userTracingEnabled
+  = withSpan (fromString name) $ \sp -> do
+      act (addEvent sp)
+  | otherwise = act (\_ _ -> pure ())
+
 -- | Trace a handler using OpenTelemetry. Adds various useful info into tags in the OpenTelemetry span.
 otTracedHandler
     :: MonadUnliftIO m

ghcide/src/Development/IDE/Main.hs

@@ -55,7 +55,8 @@ import           Development.IDE.Core.Service          (initialise, runAction)
 import           Development.IDE.Core.Shake            (IdeState (shakeExtras),
                                                         ShakeExtras (state),
                                                         shakeSessionInit, uses)
-import           Development.IDE.Core.Tracing          (measureMemory)
+import           Development.IDE.Core.Tracing          (measureMemory,
+                                                        withEventTrace)
 import           Development.IDE.Graph                 (action)
 import           Development.IDE.LSP.LanguageServer    (runLanguageServer)
 import           Development.IDE.Plugin                (Plugin (pluginHandlers, pluginModifyDynflags, pluginRules))
@@ -101,7 +102,6 @@ import           Ide.Types                             (IdeCommand (IdeCommand),
                                                         ipMap)
 import qualified Language.LSP.Server                   as LSP
 import           Numeric.Natural                       (Natural)
-import           OpenTelemetry.Eventlog                (addEvent, withSpan)
 import           Options.Applicative                   hiding (action)
 import qualified System.Directory.Extra                as IO
 import           System.Exit                           (ExitCode (ExitFailure),
@@ -239,8 +239,8 @@ stderrLogger logLevel = do
 telemetryLogger :: IO Logger
 telemetryLogger
     | userTracingEnabled = return $ Logger $ \p m ->
-        withSpan "log" $ \sp ->
-            addEvent sp (fromString $ "Log " <> show p) (encodeUtf8 $ trim m)
+        withEventTrace "Log" $ \addEvent ->
+            addEvent (fromString $ "Log " <> show p) (encodeUtf8 $ trim m)
     | otherwise = mempty
     where
         -- eventlog message size is limited by EVENT_PAYLOAD_SIZE_MAX = STG_WORD16_MAX