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

@@ -139,6 +139,7 @@ library
         Development.IDE
         Development.IDE.Main
         Development.IDE.Core.Actions
+        Development.IDE.Main.HeapStats
         Development.IDE.Core.Debouncer
         Development.IDE.Core.FileStore
         Development.IDE.Core.IdeConfiguration
@@ -260,7 +261,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

@@ -64,6 +64,8 @@ import           Development.IDE.Types.Options         (IdeGhcSession,
 import           Development.IDE.Types.Shake           (Key (Key))
 import           GHC.IO.Encoding                       (setLocaleEncoding)
 import           GHC.IO.Handle                         (hDuplicate)
+import           Development.IDE.Main.HeapStats        (withHeapStats)
+import           Development.Shake                     (action)
 import           HIE.Bios.Cradle                       (findCradle)
 import qualified HieDb.Run                             as HieDb
 import           Ide.Plugin.Config                     (CheckParents (NeverCheck),
@@ -178,7 +180,7 @@ stderrLogger = do
         T.hPutStrLn stderr $ "[" <> T.pack (show p) <> "] " <> m
 
 defaultMain :: Arguments -> IO ()
-defaultMain Arguments{..} = do
+defaultMain Arguments{..} = withHeapStats argsLogger $ do
     setLocaleEncoding utf8
     pid <- T.pack . show <$> getProcessID
     logger <- argsLogger

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

@@ -0,0 +1,53 @@
+{-# LANGUAGE NumericUnderscores #-}
+-- | Logging utilities for reporting heap statistics
+module Development.IDE.Main.HeapStats ( withHeapStats ) 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) (const k)
+    else do
+      logInfo l "Heap statistics are not enabled (RTS option -T is needed)"
+      k

haskell-language-server.cabal

@@ -311,7 +311,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