Log live_bytes and heap_size as reported by GHC.Stats

ghcide/ghcide.cabal

@@ -146,6 +146,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
@@ -300,7 +301,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

@@ -77,10 +77,12 @@ import           Development.IDE.Types.Options         (IdeGhcSession,
                                                         defaultIdeOptions,
                                                         optModifyDynFlags,
                                                         optTesting)
-import           Development.IDE.Types.Shake           (fromKeyType)
+import           Development.IDE.Types.Shake           (Key(Key),
+                                                        fromKeyType)
 import           GHC.Conc                              (getNumProcessors)
 import           GHC.IO.Encoding                       (setLocaleEncoding)
 import           GHC.IO.Handle                         (hDuplicate)
+import           Development.IDE.Main.HeapStats        (withHeapStats)
 import           HIE.Bios.Cradle                       (findCradle)
 import qualified HieDb.Run                             as HieDb
 import           Ide.Plugin.Config                     (CheckParents (NeverCheck),
@@ -240,7 +242,9 @@ stderrLogger logLevel = do
         T.hPutStrLn stderr $ "[" <> T.pack (show p) <> "] " <> m
 
 defaultMain :: Arguments -> IO ()
-defaultMain Arguments{..} = do
+defaultMain Arguments{..} = flip withHeapStats fun =<< argsLogger
+ where
+  fun = 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

@@ -345,7 +345,11 @@ 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
 
   build-depends:
     , aeson