Tracing: avoid calling actionBracket for no reason

Author: pepeiborra

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

@@ -36,6 +36,7 @@ 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 (..))
@@ -47,6 +48,7 @@ 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
@@ -68,6 +70,14 @@ 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
@@ -76,23 +86,26 @@ otTracedAction
     -> (a -> Bool) -- ^ Did this action succeed?
     -> Action a -- ^ The action
     -> Action a
-otTracedAction key file success act = actionBracket
-    (do
-        sp <- beginSpan (fromString (show key))
-        setTag sp "File" (fromString $ fromNormalizedFilePath file)
-        return sp
-    )
-    endSpan
-    (\sp -> do
-        res <- act
-        unless (success res) $ setTag sp "error" "1"
-        return res)
-
-#if MIN_GHC_API_VERSION(8,8,0)
+otTracedAction key file success act
+  | isTracingEnabled =
+    actionBracket
+        (do
+            sp <- beginSpan (fromString (show key))
+            setTag sp "File" (fromString $ fromNormalizedFilePath file)
+            return sp
+        )
+        endSpan
+        (\sp -> do
+            res <- act
+            unless (success res) $ setTag sp "error" "1"
+            return res)
+  | otherwise = act
+
+
 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
@@ -220,3 +233,4 @@ repeatUntilJust nattempts action = do
     case res of
         Nothing -> repeatUntilJust (nattempts-1) action
         Just{}  -> return res
+