From 6c3c32363aede886de26c0194c0bd0b0721b5ee0 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 3 Apr 2021 12:58:32 +0100 Subject: [PATCH 1/4] Skip tracing unless eventlog is enabled This was done only for otTracedAction but not for otTracedHandler and otTracedProvider --- ghcide/src/Development/IDE/Core/Tracing.hs | 34 +++++++++++++--------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index b970ba7603..0f51294040 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -6,7 +6,10 @@ module Development.IDE.Core.Tracing , startTelemetry , measureMemory , getInstrumentCached - ,otTracedProvider,otSetUri) + , otTracedProvider + , otSetUri + , isTracingEnabled + ) where import Control.Concurrent.Async (Async, async) @@ -58,14 +61,15 @@ otTracedHandler -> (SpanInFlight -> m a) -> m a otTracedHandler requestType label act = - let !name = - if null label - then requestType - else requestType <> ":" <> show label - -- Add an event so all requests can be quickly seen in the viewer without searching - in do - runInIO <- askRunInIO - liftIO $ withSpan (fromString name) (\sp -> addEvent sp "" (fromString $ name <> " received") >> runInIO (act sp)) + | isTracingEnabled = do + let !name = + if null label + then requestType + else requestType <> ":" <> show label + -- Add an event so all requests can be quickly seen in the viewer without searching + runInIO <- askRunInIO + liftIO $ withSpan (fromString name) (\sp -> addEvent sp "" (fromString $ name <> " received") >> runInIO (act sp)) + | otherwise = act otSetUri :: SpanInFlight -> Uri -> IO () otSetUri sp (Uri t) = setTag sp "uri" (encodeUtf8 t) @@ -106,11 +110,13 @@ otTracedProvider :: MonadUnliftIO m => PluginId -> ByteString -> m a -> m a #else otTracedProvider :: MonadUnliftIO m => PluginId -> String -> m a -> m a #endif -otTracedProvider (PluginId pluginName) provider act = do - runInIO <- askRunInIO - liftIO $ withSpan (provider <> " provider") $ \sp -> do - setTag sp "plugin" (encodeUtf8 pluginName) - runInIO act +otTracedProvider (PluginId pluginName) provider act + | isTracingEnabled = do + runInIO <- askRunInIO + liftIO $ withSpan (provider <> " provider") $ \sp -> do + setTag sp "plugin" (encodeUtf8 pluginName) + runInIO act + | otherwise = act startTelemetry :: Bool -> Logger -> Var Values -> IO () startTelemetry allTheTime logger stateRef = do From e8c1a41911fcbc81f4211f6993ad2cb72c752eb2 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 3 Apr 2021 13:28:30 +0100 Subject: [PATCH 2/4] fix syntax --- ghcide/src/Development/IDE/Core/Tracing.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 0f51294040..f3e7845f5a 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -60,7 +60,7 @@ otTracedHandler -> String -- ^ Message label -> (SpanInFlight -> m a) -> m a -otTracedHandler requestType label act = +otTracedHandler requestType label act | isTracingEnabled = do let !name = if null label From ac25452fe6dcacb0c378026bcd74a66d299fc812 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 3 Apr 2021 13:34:01 +0100 Subject: [PATCH 3/4] make up a SpanInFlight --- ghcide/src/Development/IDE/Core/Tracing.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index f3e7845f5a..2b84119585 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -46,7 +46,7 @@ import Ide.Types (PluginId (..)) import Language.LSP.Types (NormalizedFilePath, fromNormalizedFilePath) import Numeric.Natural (Natural) -import OpenTelemetry.Eventlog (Instrument, SpanInFlight, +import OpenTelemetry.Eventlog (Instrument, SpanInFlight (..), Synchronicity (Asynchronous), addEvent, beginSpan, endSpan, mkValueObserver, observe, @@ -69,7 +69,7 @@ otTracedHandler requestType label act -- Add an event so all requests can be quickly seen in the viewer without searching runInIO <- askRunInIO liftIO $ withSpan (fromString name) (\sp -> addEvent sp "" (fromString $ name <> " received") >> runInIO (act sp)) - | otherwise = act + | otherwise = act (SpanInFlight 0) otSetUri :: SpanInFlight -> Uri -> IO () otSetUri sp (Uri t) = setTag sp "uri" (encodeUtf8 t) From 3dad4dbe1f116c88fce5f361b30f4cdabc9ef6d1 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 5 Apr 2021 11:41:21 +0100 Subject: [PATCH 4/4] reuse userTracingEnabled --- ghcide/ghcide.cabal | 1 + ghcide/src/Development/IDE/Core/Tracing.hs | 18 ++++-------------- 2 files changed, 5 insertions(+), 14 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index f327093eb8..7d61bc7795 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -52,6 +52,7 @@ library filepath, fingertree, ghc-exactprint, + ghc-trace-events, Glob, haddock-library ^>= 1.10.0, hashable, diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 2b84119585..9df747c49f 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -8,7 +8,6 @@ module Development.IDE.Core.Tracing , getInstrumentCached , otTracedProvider , otSetUri - , isTracingEnabled ) where @@ -29,6 +28,7 @@ import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef) import Data.String (IsString (fromString)) import Data.Text.Encoding (encodeUtf8) +import Debug.Trace.Flags (userTracingEnabled) import Development.IDE.Core.RuleTypes (GhcSession (GhcSession), GhcSessionDeps (GhcSessionDeps), GhcSessionIO (GhcSessionIO)) @@ -39,7 +39,6 @@ import Development.IDE.Types.Shake (Key (..), Value, Values) import Development.Shake (Action, actionBracket) import Foreign.Storable (Storable (sizeOf)) -import GHC.RTS.Flags import HeapSize (recursiveSize, runHeapsize) import Ide.PluginUtils (installSigUsr1Handler) import Ide.Types (PluginId (..)) @@ -51,7 +50,6 @@ import OpenTelemetry.Eventlog (Instrument, SpanInFlight (..), addEvent, beginSpan, endSpan, mkValueObserver, observe, setTag, withSpan, withSpan_) -import System.IO.Unsafe (unsafePerformIO) -- | Trace a handler using OpenTelemetry. Adds various useful info into tags in the OpenTelemetry span. otTracedHandler @@ -61,7 +59,7 @@ otTracedHandler -> (SpanInFlight -> m a) -> m a otTracedHandler requestType label act - | isTracingEnabled = do + | userTracingEnabled = do let !name = if null label then requestType @@ -74,14 +72,6 @@ otTracedHandler requestType label act otSetUri :: SpanInFlight -> Uri -> IO () otSetUri sp (Uri t) = setTag sp "uri" (encodeUtf8 t) -{-# NOINLINE isTracingEnabled #-} -isTracingEnabled :: Bool -isTracingEnabled = unsafePerformIO $ do - flags <- getTraceFlags - case tracing flags of - TraceNone -> return False - _ -> return True - -- | Trace a Shake action using opentelemetry. otTracedAction :: Show k @@ -91,7 +81,7 @@ otTracedAction -> Action a -- ^ The action -> Action a otTracedAction key file success act - | isTracingEnabled = + | userTracingEnabled = actionBracket (do sp <- beginSpan (fromString (show key)) @@ -111,7 +101,7 @@ otTracedProvider :: MonadUnliftIO m => PluginId -> ByteString -> m a -> m a otTracedProvider :: MonadUnliftIO m => PluginId -> String -> m a -> m a #endif otTracedProvider (PluginId pluginName) provider act - | isTracingEnabled = do + | userTracingEnabled = do runInIO <- askRunInIO liftIO $ withSpan (provider <> " provider") $ \sp -> do setTag sp "plugin" (encodeUtf8 pluginName)