diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index d90b3dff43..e4095e239d 100644 --- a/ghcide/ghcide.cabal +++ b/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, diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index a533767a95..541e7385b8 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/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 diff --git a/ghcide/src/Development/IDE/Main/HeapStats.hs b/ghcide/src/Development/IDE/Main/HeapStats.hs new file mode 100644 index 0000000000..de45fa6c38 --- /dev/null +++ b/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 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index a57e526c9d..5c3587e011 100644 --- a/haskell-language-server.cabal +++ b/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