Skip to content

Commit 147e3b6

Browse files
committed
trace recordDirtyKeys calls
1 parent 91df537 commit 147e3b6

File tree

3 files changed

+16
-6
lines changed

3 files changed

+16
-6
lines changed

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

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -439,8 +439,10 @@ recordDirtyKeys
439439
-> k
440440
-> [NormalizedFilePath]
441441
-> IO ()
442-
recordDirtyKeys ShakeExtras{dirtyKeys} key file =
442+
recordDirtyKeys ShakeExtras{dirtyKeys} key file = withEventTrace "recordDirtyKeys" $ \addEvent -> do
443443
atomicModifyIORef_ dirtyKeys $ \x -> foldl' (flip HSet.insert) x (toKey key <$> file)
444+
addEvent (fromString $ "dirty " <> show key) (fromString $ unlines $ map fromNormalizedFilePath file)
445+
444446

445447
-- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value.
446448
getValues ::

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

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ module Development.IDE.Core.Tracing
99
, otTracedProvider
1010
, otSetUri
1111
, withTrace
12-
)
12+
,withEventTrace)
1313
where
1414

1515
import Control.Concurrent.Async (Async, async)
@@ -67,6 +67,14 @@ withTrace name act
6767
act setSpan'
6868
| otherwise = act (\_ _ -> pure ())
6969

70+
withEventTrace :: (MonadMask m, MonadIO m) =>
71+
String -> ((ByteString -> ByteString -> m ()) -> m a) -> m a
72+
withEventTrace name act
73+
| userTracingEnabled
74+
= withSpan (fromString name) $ \sp -> do
75+
act (addEvent sp)
76+
| otherwise = act (\_ _ -> pure ())
77+
7078
-- | Trace a handler using OpenTelemetry. Adds various useful info into tags in the OpenTelemetry span.
7179
otTracedHandler
7280
:: MonadUnliftIO m

ghcide/src/Development/IDE/Main.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,8 @@ import Development.IDE.Core.Service (initialise, runAction)
5555
import Development.IDE.Core.Shake (IdeState (shakeExtras),
5656
ShakeExtras (state),
5757
shakeSessionInit, uses)
58-
import Development.IDE.Core.Tracing (measureMemory)
58+
import Development.IDE.Core.Tracing (measureMemory,
59+
withEventTrace)
5960
import Development.IDE.Graph (action)
6061
import Development.IDE.LSP.LanguageServer (runLanguageServer)
6162
import Development.IDE.Plugin (Plugin (pluginHandlers, pluginModifyDynflags, pluginRules))
@@ -101,7 +102,6 @@ import Ide.Types (IdeCommand (IdeCommand),
101102
ipMap)
102103
import qualified Language.LSP.Server as LSP
103104
import Numeric.Natural (Natural)
104-
import OpenTelemetry.Eventlog (addEvent, withSpan)
105105
import Options.Applicative hiding (action)
106106
import qualified System.Directory.Extra as IO
107107
import System.Exit (ExitCode (ExitFailure),
@@ -239,8 +239,8 @@ stderrLogger logLevel = do
239239
telemetryLogger :: IO Logger
240240
telemetryLogger
241241
| userTracingEnabled = return $ Logger $ \p m ->
242-
withSpan "log" $ \sp ->
243-
addEvent sp (fromString $ "Log " <> show p) (encodeUtf8 $ trim m)
242+
withEventTrace "Log" $ \addEvent ->
243+
addEvent (fromString $ "Log " <> show p) (encodeUtf8 $ trim m)
244244
| otherwise = mempty
245245
where
246246
-- eventlog message size is limited by EVENT_PAYLOAD_SIZE_MAX = STG_WORD16_MAX

0 commit comments

Comments
 (0)