Lighterweight Platform.silentHandler

nri-observability/scripts/memory-leak-test/Main.hs

@@ -1,21 +1,21 @@
-{-# LANGUAGE OverloadedRecordDot, OverloadedRecordUpdate #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedRecordUpdate #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Main where
 
-
-import Control.Monad (void, sequence, forM_)
-import Control.Concurrent.Async (mapConcurrently_)
-import Control.Concurrent (threadDelay)
 import qualified Conduit
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.Async (mapConcurrently_)
+import Control.Monad (forM_, sequence, void)
+import Data.List (splitAt)
 import qualified Environment
+import GHC.Conc (numCapabilities)
 import qualified Observability
-import qualified Process
 import qualified Platform
-import Data.List (splitAt)
-import Prelude (IO, show, putStrLn, fromIntegral, pure, mapM_, div)
-import GHC.Conc (numCapabilities)
+import qualified Process
+import Prelude (IO, div, fromIntegral, mapM_, pure, putStrLn, show)
 
 threads :: Int
 threads = fromIntegral numCapabilities
@@ -24,27 +24,31 @@ main :: IO ()
 main = do
   settings' <- Environment.decode Observability.decoder
   putStrLn (show settings'.enabledReporters)
-  let ids = [1..12] |> List.map Text.fromInt
+  let ids = [1 .. 12] |> List.map Text.fromInt
   Conduit.withAcquire (Observability.handler settings') <| \handler -> do
-    forM_ [1..(floor (1_000_000 / fromIntegral threads))] <| \n -> do
+    forM_ [1 .. (floor (1_000_000 / fromIntegral threads))] <| \n -> do
       runRequests handler ids
 
 runRequests :: Observability.Handler -> [Text] -> IO ()
 runRequests handler =
-  mapConcurrently_ (\requestId -> do
-            Platform.rootTracingSpanIO
-                requestId
-                (handler.report requestId)
-                ("Running task" ++ requestId)
-                ( \log -> do
-                    Task.perform log (do
-                      Process.sleep 5
-                      Task.succeed ())
+  mapConcurrently_
+    ( \requestId -> do
+        Platform.rootTracingSpanIO
+          requestId
+          (handler.report requestId)
+          ("Running task" ++ requestId)
+          ( \log -> do
+              Task.perform
+                log
+                ( do
+                    Process.sleep 5
+                    Task.succeed ()
                 )
           )
+    )
 
 chunks :: Int -> [a] -> [[a]]
 chunks _ [] = []
 chunks n xs =
-    let (ys, zs) = splitAt (fromIntegral n) xs
-    in  ys : chunks n zs
+  let (ys, zs) = splitAt (fromIntegral n) xs
+   in ys : chunks n zs

nri-observability/tests/Spec/Reporter/File.hs

@@ -152,7 +152,8 @@ logTest name span =
       Ok reEncoded ->
         Text.join "\n" reEncoded
           |> Expect.equalToContentsOf
-            ( goldenResultsDir ++ "/file-reporter-"
+            ( goldenResultsDir
+                ++ "/file-reporter-"
                 ++ Text.replace " " "-" name
             )
 

nri-prelude/src/Platform.hs

@@ -171,7 +171,7 @@ requestId = map Internal.requestId logHandler
 
 -- | A log handler that doesn't log anything.
 silentHandler :: IO Internal.LogHandler
-silentHandler = Internal.mkHandler "" (Internal.Clock (pure 0)) (\_ -> pure ()) Nothing ""
+silentHandler = pure Internal.nullHandler
 
 -- | Throw a runtime exception that cannot be caught. This function, like
 -- @Debug.todo@, breaks type level guarantees and should be avoided. Where

nri-prelude/src/Platform/Internal.hs

@@ -616,6 +616,25 @@ mkHandler requestId clock onFinish onFinishRoot' name' = do
         finishTracingSpan = finalizeTracingSpan clock allocationCounterStartVal tracingSpanRef >> andThen onFinish
       }
 
+-- | Helper that creates a handler that does nothing. This is intended to power
+-- basically @Platform.silentHandler@ and nothing else. We provide this to make
+-- @Platform.silentHandler@ as efficient as possible, skipping all side effects.
+--
+-- The underlying desire for an IO-free `silentHandler`, aside from principles,
+-- is we saw space leaks carrying @TracingSpan@ and @TracingSpanDetails@ we
+-- couldn't understand, which went away when we switched to this no-op handler.
+nullHandler :: LogHandler
+nullHandler = do
+  LogHandler
+    { requestId = "",
+      startChildTracingSpan = \_ -> pure nullHandler,
+      startNewRoot = \_ -> pure nullHandler,
+      setTracingSpanDetailsIO = \_ -> pure (),
+      setTracingSpanSummaryIO = \_ -> pure (),
+      markTracingSpanFailedIO = pure (),
+      finishTracingSpan = \_ -> pure ()
+    }
+
 -- | Set the details for a tracingSpan created using the @tracingSpan@
 -- function. Like @tracingSpan@ this is intended for use in writing libraries
 -- that define custom types of effects, such as database queries or http