Log live_bytes and heap_size as reported by GHC.Stats

A thread is spawned which at a prespecified interval will report the
live bytes and heap size at the last major collection.

Live bytes corresponds to how much live data a program has and should
match closely the value reported during heap profiling.

Heap size reports the total amount of memory the RTS is using, which
corresponds more closely to OS memory usage.

```
[INFO] Live bytes: 367.45MB Heap size: 676.33MB
```

Closes haskell#1493

Author: mpickering

ghcide/ghcide.cabal

@@ -138,6 +138,7 @@ library
     exposed-modules:
         Development.IDE
         Development.IDE.Main
+        Development.IDE.Main.HeapStats
         Development.IDE.Core.Debouncer
         Development.IDE.Core.FileStore
         Development.IDE.Core.IdeConfiguration
@@ -258,7 +259,8 @@ executable ghcide
                 -rtsopts
                 -- disable idle GC
                 -- increase nursery size
-                "-with-rtsopts=-I0 -A128M"
+                -- Enable collection of heap statistics
+                "-with-rtsopts="-I0 -A128M -T"
     main-is: Main.hs
     build-depends:
         hiedb,

ghcide/src/Development/IDE/Main.hs

@@ -27,6 +27,7 @@ import           Development.IDE.Core.Shake         (IdeState (shakeExtras),
                                                      ShakeExtras (state), uses)
 import           Development.IDE.Core.Tracing       (measureMemory)
 import           Development.IDE.Core.IdeConfiguration (registerIdeConfiguration, IdeConfiguration(..))
+import           Development.IDE.Main.HeapStats     (withHeapStats)
 import           Development.IDE.LSP.LanguageServer (runLanguageServer)
 import           Development.IDE.Plugin             (Plugin (pluginHandlers, pluginRules))
 import           Development.IDE.Plugin.HLS         (asGhcIdePlugin)
@@ -94,7 +95,7 @@ instance Default Arguments where
         }
 
 defaultMain :: Arguments -> IO ()
-defaultMain Arguments{..} = do
+defaultMain Arguments{..} = withHeapStats argsLogger $ do
     pid <- T.pack . show <$> getProcessID
 
     let hlsPlugin = asGhcIdePlugin argsDefaultHlsConfig argsHlsPlugins

ghcide/src/Development/IDE/Main/HeapStats.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE TypeApplications  #-}
+-- | Logging utilities for reporting heap statistics
+module Development.IDE.Main.HeapStats where
+
+import           GHC.Stats
+import           Development.IDE.Types.Logger       (Logger, logInfo)
+import           Control.Concurrent.Async
+import qualified Data.Text as T
+import           Data.Word
+import           Control.Monad
+import           Control.Concurrent
+import           Text.Printf                        (printf)
+
+-- | Interval at which to report the latest heap statistics.
+heapStatsInterval :: Int
+heapStatsInterval = 60_000_000 -- 60s
+
+-- | Report the live bytes and heap size at the last major collection.
+logHeapStats :: Logger -> IO ()
+logHeapStats l = do
+  stats <- getRTSStats
+  -- live_bytes is the total amount of live memory in a program
+  -- (corresponding to the amount on a heap profile)
+  let live_bytes = gcdetails_live_bytes (gc stats)
+  -- heap_size is the total amount of memory the RTS is using
+  -- this corresponds closer to OS memory usage
+      heap_size  = gcdetails_mem_in_use_bytes (gc stats)
+      format :: Word64 -> T.Text
+      format m = T.pack (printf "%.2fMB" (fromIntegral @Word64 @Double m / 1e6))
+      message = "Live bytes: " <> format live_bytes  <> " " <>
+                "Heap size: " <> format heap_size
+  logInfo l message
+
+-- | An action which logs heap statistics at the 'heapStatsInterval'
+heapStatsThread :: Logger -> IO r
+heapStatsThread l = forever $ do
+  threadDelay heapStatsInterval
+  logHeapStats l
+
+-- | A helper function which lauches the 'heapStatsThread' and kills it
+-- appropiately when the inner action finishes. It also checks to see
+-- if `-T` is enabled.
+withHeapStats :: Logger -> IO r -> IO r
+withHeapStats l k = do
+  enabled <- getRTSStatsEnabled
+  if enabled
+    then do
+      logInfo l ("Logging heap statistics every "
+                  <> T.pack (printf "%.2fs" (fromIntegral @Int @Double heapStatsInterval / 1e6)))
+      withAsync (heapStatsThread l) (\_ -> k)
+    else do
+      logInfo l "Heap statistics are not enabled (RTS option -T is needed)"
+      k

haskell-language-server.cabal

@@ -306,7 +306,8 @@ executable haskell-language-server
     -rtsopts
     -- disable idle GC
     -- increase nursery size
-    "-with-rtsopts=-I0 -A128M"
+    -- Enable collection of heap statistics
+    "-with-rtsopts=-I0 -A128M -T"
     -Wno-unticked-promoted-constructors
   if flag(pedantic)
     ghc-options: -Werror