Do not send Heap Stats to the LSP log (haskell#3111)

sloorush · Sep 12, 2022 · a7f1f0e · a7f1f0e
1 parent ff4cd44
commit a7f1f0e
Showing 1 changed file with 17 additions and 7 deletions.
diff --git a/exe/Main.hs b/exe/Main.hs
@@ -5,17 +5,19 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main(main) where
 
+import           Control.Arrow                ((&&&))
 import           Control.Monad.IO.Class       (liftIO)
 import           Data.Function                ((&))
 import           Data.Text                    (Text)
+import qualified Development.IDE.Main         as GhcideMain
 import           Development.IDE.Types.Logger (Doc,
                                                Priority (Debug, Error, Info),
                                                WithPriority (WithPriority, priority),
                                                cfilter, cmapWithPrio,
                                                defaultLayoutOptions,
                                                layoutPretty,
                                                makeDefaultStderrRecorder,
-                                               renderStrict,
+                                               payload, renderStrict,
                                                withDefaultRecorder)
 import qualified Development.IDE.Types.Logger as Logger
 import           Ide.Arguments                (Arguments (..),
@@ -62,24 +64,28 @@ main = do
               liftIO $ (cb1 <> cb2) env
           }
 
-    let (minPriority, logFilePath, includeExamplePlugins) =
+    let (argsTesting, minPriority, logFilePath, includeExamplePlugins) =
           case args of
             Ghcide GhcideArguments{ argsTesting, argsDebugOn, argsLogFile, argsExamplePlugin } ->
               let minPriority = if argsDebugOn || argsTesting then Debug else Info
-              in (minPriority, argsLogFile, argsExamplePlugin)
-            _ -> (Info, Nothing, False)
+              in (argsTesting, minPriority, argsLogFile, argsExamplePlugin)
+            _ -> (False, Info, Nothing, False)
 
     withDefaultRecorder logFilePath Nothing minPriority $ \textWithPriorityRecorder -> do
       let
-        recorder = cmapWithPrio pretty $ mconcat
+        recorder = cmapWithPrio (pretty &&& id) $ mconcat
             [textWithPriorityRecorder
                 & cfilter (\WithPriority{ priority } -> priority >= minPriority)
+                & cmapWithPrio fst
             , lspMessageRecorder
                 & cfilter (\WithPriority{ priority } -> priority >= Error)
-                & cmapWithPrio renderDoc
+                & cmapWithPrio (renderDoc . fst)
             , lspLogRecorder
                 & cfilter (\WithPriority{ priority } -> priority >= minPriority)
-                & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions)
+                & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions . fst)
+                -- do not log heap stats to the LSP log as they interfere with the
+                -- ability of lsp-test to detect a stuck server in tests and benchmarks
+                & if argsTesting then cfilter (not . heapStats . snd . payload) else id
             ]
         plugins = (Plugins.idePlugins (cmapWithPrio LogPlugins recorder) includeExamplePlugins)
 
@@ -96,3 +102,7 @@ renderDoc d = renderStrict $ layoutPretty defaultLayoutOptions $ vsep
 
 issueTrackerUrl :: Doc a
 issueTrackerUrl = "https://github.com/haskell/haskell-language-server/issues"
+
+heapStats :: Log -> Bool
+heapStats (LogIdeMain (IdeMain.LogIDEMain (GhcideMain.LogHeapStats _))) = True
+heapStats _                                                             = False