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 b970ba7603..9df747c49f 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -6,7 +6,9 @@ module Development.IDE.Core.Tracing , startTelemetry , measureMemory , getInstrumentCached - ,otTracedProvider,otSetUri) + , otTracedProvider + , otSetUri + ) where import Control.Concurrent.Async (Async, async) @@ -26,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)) @@ -36,19 +39,17 @@ 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 (..)) 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, setTag, withSpan, withSpan_) -import System.IO.Unsafe (unsafePerformIO) -- | Trace a handler using OpenTelemetry. Adds various useful info into tags in the OpenTelemetry span. otTracedHandler @@ -57,27 +58,20 @@ otTracedHandler -> String -- ^ Message label -> (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)) +otTracedHandler requestType label act + | userTracingEnabled = 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 (SpanInFlight 0) 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 @@ -87,7 +81,7 @@ otTracedAction -> Action a -- ^ The action -> Action a otTracedAction key file success act - | isTracingEnabled = + | userTracingEnabled = actionBracket (do sp <- beginSpan (fromString (show key)) @@ -106,11 +100,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 + | userTracingEnabled = 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