diff --git a/nri-observability/scripts/memory-leak-test/Main.hs b/nri-observability/scripts/memory-leak-test/Main.hs index 5dd74d3e..ead5c1ad 100644 --- a/nri-observability/scripts/memory-leak-test/Main.hs +++ b/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 \ No newline at end of file + let (ys, zs) = splitAt (fromIntegral n) xs + in ys : chunks n zs diff --git a/nri-observability/tests/Spec/Reporter/File.hs b/nri-observability/tests/Spec/Reporter/File.hs index 8f3eb229..c705a713 100644 --- a/nri-observability/tests/Spec/Reporter/File.hs +++ b/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 ) diff --git a/nri-prelude/src/Platform.hs b/nri-prelude/src/Platform.hs index efd8ca47..9da52d00 100644 --- a/nri-prelude/src/Platform.hs +++ b/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 diff --git a/nri-prelude/src/Platform/Internal.hs b/nri-prelude/src/Platform/Internal.hs index 4a91d39a..d39554b7 100644 --- a/nri-prelude/src/Platform/Internal.hs +++ b/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