Expose runtime metrics via EKG (#2267)

* Collect metrics and expose an EKG server

* register gc metrics locally

* getDatabaseKeys

* fixups

* Abstract monitoring and put EKG behind a Cabal flag

* Add CI for the new flag

* fix double ifdef

* link to GHC docs for eventlogs

* log when stopping the EKG server

* Allow CPP in modules

* Add doc comments

* Apply suggestions from code review

Co-authored-by: Michael Peyton Jones <[email protected]>

* Compat. with ghc 9.2

* use an ekg-json snapshot that preserves compat. with ghc 8.x

* confine CPP to the EKG module

Co-authored-by: Michael Peyton Jones <[email protected]>

Author: pepeiborra

.github/workflows/flags.yml

@@ -65,7 +65,7 @@ jobs:
         run: cabal v2-build hls-graph --flags="embed-files stm-stats"
 
       - name: Build `ghcide` with flags
-        run: cabal v2-build ghcide --flags="ghc-patched-unboxed-bytecode test-exe executable bench-exe"
+        run: cabal v2-build ghcide --flags="ghc-patched-unboxed-bytecode test-exe executable bench-exe ekg"
 
       # we have to clean up warnings for 9.0 and 9.2 before enable -WAll
       - if: matrix.ghc != '9.0.2' && matrix.ghc != '9.2.2'

cabal.project

@@ -53,6 +53,15 @@ constraints:
   ghc-lib-parser-ex -auto,
   stylish-haskell +ghc-lib
 
+-- This is benign and won't affect our ability to release to Hackage,
+-- because we only depend on `ekg-json` when a non-default flag
+-- is turned on.
+source-repository-package
+  type:git
+  location: https://github.com/pepeiborra/ekg-json
+  tag: 7a0af7a8fd38045fd15fb13445bdcc7085325460
+  -- https://github.com/tibbe/ekg-json/pull/12
+
 allow-newer:
   -- ghc-9.2
   ----------
@@ -70,3 +79,13 @@ allow-newer:
   -- for shake-bench
   Chart:lens,
   Chart-diagrams:lens,
+
+  -- for ekg
+  ekg-core:base,
+  ekg-core:ghc-prim,
+  ekg-wai:base,
+  ekg-wai:time,
+
+  -- for shake-bench
+  Chart-diagrams:diagrams-core,
+  SVGFonts:diagrams-core

docs/contributing/contributing.md

@@ -225,6 +225,35 @@ If you don't want to use [nix](https://nixos.org/guides/install-nix.html), you c
 
 See the [tutorial](./plugin-tutorial.md) on writing a plugin in HLS.
 
+## Measuring, benchmarking and tracing
+
+### Metrics
+
+When ghcide is built with the `ekg` flag, HLS opens a metrics server on port 8999 exposing GC and ghcide metrics. The ghcide metrics currently exposed are:
+
+- `ghcide.values_count`- count of build results in the store
+- `ghcide.database_count` - count of build keys in the store (these two would be the same in the absence of GC)
+- `ghcide.build_count` - build count. A key is GC'ed if it is dirty and older than 100 builds
+- `ghcide.dirty_keys_count` - non transitive count of dirty build keys
+- `ghcide.indexing_pending_count` - count of items in the indexing queue
+- `ghcide.exports_map_count` - count of identifiers in the exports map.
+
+### Benchmarks
+
+If you are touching performance sensitive code, take the time to run a differential
+benchmark between HEAD and master using the benchHist script. This assumes that
+"master" points to the upstream master.
+
+Run the benchmarks with `cabal bench ghcide`.
+
+It should take around 25 minutes and the results will be stored in the `ghcide/bench-results` folder. To interpret the results, see the comments in the `ghcide/bench/hist/Main.hs` module.
+
+More details in [bench/README](../../ghcide/bench/README.md)
+
+### Tracing
+
+HLS records opentelemetry [eventlog traces](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/runtime_control.html#rts-eventlog) via [opentelemetry](https://hackage.haskell.org/package/opentelemetry). To generate the traces, build with `-eventlog` and run with `+RTS -l`. To visualize the traces, install [Tracy](https://github.com/wolfpld/tracy) and use [eventlog-to-tracy](https://hackage.haskell.org/package/opentelemetry-extra) to open the generated eventlog.
+
 ## Adding support for a new editor
 
 Adding support for new editors is fairly easy if the editor already has good support for generic LSP-based extensions.

ghcide/.hlint.yaml

@@ -122,7 +122,6 @@
     - Development.IDE.Plugin.Completions
     - Development.IDE.Plugin.Completions.Logic
     - Development.IDE.Types.Location
-    - Main
 
 - flags:
   - default: false

ghcide/exe/Arguments.hs

@@ -19,6 +19,7 @@ data Arguments = Arguments
     ,argsVerbose                    :: Bool
     ,argsCommand                    :: Command
     ,argsConservativeChangeTracking :: Bool
+    ,argsMonitoringPort             :: Int
     }
 
 getArguments :: IdePlugins IdeState -> IO Arguments
@@ -40,6 +41,7 @@ arguments plugins = Arguments
       <*> switch (short 'd' <> long "verbose" <> help "Include internal events in logging output")
       <*> (commandP plugins <|> lspCommand <|> checkCommand)
       <*> switch (long "conservative-change-tracking" <> help "disable reactive change tracking (for testing/debugging)")
+      <*> option auto (long "monitoring-port" <> metavar "PORT" <> value 8999 <> showDefault <> help "Port to use for EKG monitoring (if the binary is built with EKG)")
       where
           checkCommand = Check <$> many (argument str (metavar "FILES/DIRS..."))
           lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP client")

ghcide/exe/Main.hs

@@ -19,12 +19,13 @@ import           Development.IDE.Core.Rules        (mainRule)
 import qualified Development.IDE.Core.Rules        as Rules
 import           Development.IDE.Core.Tracing      (withTelemetryLogger)
 import qualified Development.IDE.Main              as IDEMain
+import qualified Development.IDE.Monitoring.OpenTelemetry as OpenTelemetry
+import qualified Development.IDE.Monitoring.EKG    as EKG
 import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
 import           Development.IDE.Types.Logger      (Logger (Logger),
                                                     LoggingColumn (DataColumn, PriorityColumn),
                                                     Pretty (pretty),
                                                     Priority (Debug, Info, Error),
-                                                    Recorder (Recorder),
                                                     WithPriority (WithPriority, priority),
                                                     cfilter, cmapWithPrio,
                                                     makeDefaultStderrRecorder, layoutPretty, renderStrict, defaultLayoutOptions)
@@ -142,4 +143,5 @@ main = withTelemetryLogger $ \telemetryLogger -> do
                 , optCheckProject = pure $ checkProject config
                 , optRunSubset = not argsConservativeChangeTracking
                 }
+        , IDEMain.argsMonitoring = OpenTelemetry.monitoring <> EKG.monitoring logger argsMonitoringPort
         }

ghcide/ghcide.cabal

@@ -30,6 +30,11 @@ flag ghc-patched-unboxed-bytecode
     default:     False
     manual:      True
 
+flag ekg
+    description: Enable EKG monitoring of the build graph and other metrics on port 8999
+    default:     False
+    manual:      True
+
 library
     default-language:   Haskell2010
     build-depends:
@@ -182,6 +187,7 @@ library
         Development.IDE.GHC.Util
         Development.IDE.Import.DependencyInformation
         Development.IDE.Import.FindImports
+        Development.IDE.Monitoring.EKG
         Development.IDE.LSP.HoverDefinition
         Development.IDE.LSP.LanguageServer
         Development.IDE.LSP.Outline
@@ -198,6 +204,8 @@ library
         Development.IDE.Types.KnownTargets
         Development.IDE.Types.Location
         Development.IDE.Types.Logger
+        Development.IDE.Types.Monitoring
+        Development.IDE.Monitoring.OpenTelemetry
         Development.IDE.Types.Options
         Development.IDE.Types.Shake
         Development.IDE.Plugin
@@ -236,6 +244,12 @@ library
       exposed-modules:
         Development.IDE.GHC.Compat.CPP
 
+    if flag(ekg)
+        build-depends:
+            ekg-wai,
+            ekg-core,
+        cpp-options:   -DMONITORING_EKG
+
 flag test-exe
     description: Build the ghcide-test-preprocessor executable
     default: True
@@ -356,6 +370,11 @@ executable ghcide
 
     if !flag(executable)
         buildable: False
+    if flag(ekg)
+        build-depends:
+            ekg-wai,
+            ekg-core,
+        cpp-options:   -DMONITORING_EKG
 
 test-suite ghcide-tests
     type: exitcode-stdio-1.0

ghcide/src/Development/IDE/Core/Service.hs

@@ -18,30 +18,30 @@ module Development.IDE.Core.Service(
     Log(..),
     ) where
 
-import           Control.Applicative             ((<|>))
+import           Control.Applicative              ((<|>))
 import           Development.IDE.Core.Debouncer
-import           Development.IDE.Core.FileExists (fileExistsRules)
-import           Development.IDE.Core.OfInterest hiding (Log, LogShake)
+import           Development.IDE.Core.FileExists  (fileExistsRules)
+import           Development.IDE.Core.OfInterest  hiding (Log, LogShake)
 import           Development.IDE.Graph
-import           Development.IDE.Types.Logger    as Logger (Logger,
-                                                            Pretty (pretty),
-                                                            Priority (Debug),
-                                                            Recorder,
-                                                            WithPriority,
-                                                            cmapWithPrio)
-import           Development.IDE.Types.Options   (IdeOptions (..))
+import           Development.IDE.Types.Logger     as Logger (Logger,
+                                                             Pretty (pretty),
+                                                             Priority (Debug),
+                                                             Recorder,
+                                                             WithPriority,
+                                                             cmapWithPrio)
+import           Development.IDE.Types.Options    (IdeOptions (..))
 import           Ide.Plugin.Config
-import qualified Language.LSP.Server             as LSP
-import qualified Language.LSP.Types              as LSP
+import qualified Language.LSP.Server              as LSP
+import qualified Language.LSP.Types               as LSP
 
 import           Control.Monad
-import qualified Development.IDE.Core.FileExists as FileExists
-import qualified Development.IDE.Core.OfInterest as OfInterest
-import           Development.IDE.Core.Shake      hiding (Log)
-import qualified Development.IDE.Core.Shake      as Shake
-import           Development.IDE.Types.Shake     (WithHieDb)
-import           System.Environment              (lookupEnv)
-
+import qualified Development.IDE.Core.FileExists  as FileExists
+import qualified Development.IDE.Core.OfInterest  as OfInterest
+import           Development.IDE.Core.Shake       hiding (Log)
+import qualified Development.IDE.Core.Shake       as Shake
+import           Development.IDE.Types.Monitoring (Monitoring)
+import           Development.IDE.Types.Shake      (WithHieDb)
+import           System.Environment               (lookupEnv)
 
 data Log
   = LogShake Shake.Log
@@ -68,8 +68,9 @@ initialise :: Recorder (WithPriority Log)
            -> IdeOptions
            -> WithHieDb
            -> IndexQueue
+           -> Monitoring
            -> IO IdeState
-initialise recorder defaultConfig mainRule lspEnv logger debouncer options withHieDb hiedbChan = do
+initialise recorder defaultConfig mainRule lspEnv logger debouncer options withHieDb hiedbChan metrics = do
     shakeProfiling <- do
         let fromConf = optShakeProfiling options
         fromEnv <- lookupEnv "GHCIDE_BUILD_PROFILING"
@@ -86,6 +87,7 @@ initialise recorder defaultConfig mainRule lspEnv logger debouncer options withH
         withHieDb
         hiedbChan
         (optShakeOptions options)
+        metrics
           $ do
             addIdeGlobal $ GlobalIdeOptions options
             ofInterestRules (cmapWithPrio LogOfInterest recorder)

ghcide/src/Development/IDE/Core/Shake.hs

@@ -118,7 +118,6 @@ import           Data.Typeable
 import           Data.Unique
 import           Data.Vector                            (Vector)
 import qualified Data.Vector                            as Vector
-import           Debug.Trace.Flags                      (userTracingEnabled)
 import           Development.IDE.Core.Debouncer
 import           Development.IDE.Core.FileUtils         (getModTime)
 import           Development.IDE.Core.PositionMapping
@@ -136,6 +135,7 @@ import           Development.IDE.Graph                  hiding (ShakeValue)
 import qualified Development.IDE.Graph                  as Shake
 import           Development.IDE.Graph.Database         (ShakeDatabase,
                                                          shakeGetBuildStep,
+                                                         shakeGetDatabaseKeys,
                                                          shakeNewDatabase,
                                                          shakeProfileDatabase,
                                                          shakeRunDatabaseForKeys)
@@ -152,6 +152,8 @@ import           Development.IDE.Types.Options
 import           Development.IDE.Types.Shake
 import qualified Focus
 import           GHC.Fingerprint
+import           Language.LSP.Types.Capabilities
+import           OpenTelemetry.Eventlog
 import           HieDb.Types
 import           Ide.Plugin.Config
 import qualified Ide.PluginUtils                        as HLS
@@ -160,14 +162,13 @@ import           Language.LSP.Diagnostics
 import qualified Language.LSP.Server                    as LSP
 import           Language.LSP.Types
 import qualified Language.LSP.Types                     as LSP
-import           Language.LSP.Types.Capabilities
 import           Language.LSP.VFS
 import qualified "list-t" ListT
-import           OpenTelemetry.Eventlog
 import qualified StmContainers.Map                      as STM
 import           System.FilePath                        hiding (makeRelative)
 import           System.IO.Unsafe (unsafePerformIO)
 import           System.Time.Extra
+import Development.IDE.Types.Monitoring (Monitoring(..))
 
 data Log
   = LogCreateHieDbExportsMapStart
@@ -388,7 +389,7 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do
           | otherwise = do
           pmap <- readTVarIO persistentKeys
           mv <- runMaybeT $ do
-            liftIO $ Logger.logDebug (logger s) $ T.pack $ "LOOKUP UP PERSISTENT FOR: " ++ show k
+            liftIO $ Logger.logDebug (logger s) $ T.pack $ "LOOKUP PERSISTENT FOR: " ++ show k
             f <- MaybeT $ pure $ HMap.lookup (Key k) pmap
             (dv,del,ver) <- MaybeT $ runIdeAction "lastValueIO" s $ f file
             MaybeT $ pure $ (,del,ver) <$> fromDynamic dv
@@ -462,6 +463,7 @@ data IdeState = IdeState
     ,shakeSession         :: MVar ShakeSession
     ,shakeExtras          :: ShakeExtras
     ,shakeDatabaseProfile :: ShakeDatabase -> IO (Maybe FilePath)
+    ,stopMonitoring       :: IO ()
     }
 
 
@@ -557,10 +559,13 @@ shakeOpen :: Recorder (WithPriority Log)
           -> WithHieDb
           -> IndexQueue
           -> ShakeOptions
+          -> Monitoring
           -> Rules ()
           -> IO IdeState
 shakeOpen recorder lspEnv defaultConfig logger debouncer
-  shakeProfileDir (IdeReportProgress reportProgress) ideTesting@(IdeTesting testing) withHieDb indexQueue opts rules = mdo
+  shakeProfileDir (IdeReportProgress reportProgress)
+  ideTesting@(IdeTesting testing)
+  withHieDb indexQueue opts monitoring rules = mdo
     let log :: Logger.Priority -> Log -> IO ()
         log = logWith recorder
 
@@ -608,36 +613,40 @@ shakeOpen recorder lspEnv defaultConfig logger debouncer
             rules
     shakeSession <- newEmptyMVar
     shakeDatabaseProfile <- shakeDatabaseProfileIO shakeProfileDir
-    let ideState = IdeState{..}
 
     IdeOptions
         { optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled
         , optProgressStyle
+        , optCheckParents
         } <- getIdeOptionsIO shakeExtras
 
-    void $ startTelemetry shakeDb shakeExtras
     startProfilingTelemetry otProfilingEnabled logger $ state shakeExtras
 
-    return ideState
-
-startTelemetry :: ShakeDatabase -> ShakeExtras -> IO (Async ())
-startTelemetry db extras@ShakeExtras{..}
-  | userTracingEnabled = do
-    countKeys <- mkValueObserver "cached keys count"
-    countDirty <- mkValueObserver "dirty keys count"
-    countBuilds <- mkValueObserver "builds count"
-    IdeOptions{optCheckParents} <- getIdeOptionsIO extras
     checkParents <- optCheckParents
-    regularly 1 $ do
-        observe countKeys . countRelevantKeys checkParents . map fst =<< (atomically . ListT.toList . STM.listT) state
-        readTVarIO dirtyKeys >>= observe countDirty . countRelevantKeys checkParents . HSet.toList
-        shakeGetBuildStep db >>= observe countBuilds
 
-  | otherwise = async (pure ())
-    where
-        regularly :: Seconds -> IO () -> IO (Async ())
-        regularly delay act = async $ forever (act >> sleep delay)
+    -- monitoring
+    let readValuesCounter = fromIntegral . countRelevantKeys checkParents <$> getStateKeys shakeExtras
+        readDirtyKeys = fromIntegral . countRelevantKeys checkParents . HSet.toList <$> readTVarIO(dirtyKeys shakeExtras)
+        readIndexPending = fromIntegral . HMap.size <$> readTVarIO (indexPending $ hiedbWriter shakeExtras)
+        readExportsMap = fromIntegral . HMap.size . getExportsMap <$> readTVarIO (exportsMap shakeExtras)
+        readDatabaseCount = fromIntegral . countRelevantKeys checkParents . map fst <$> shakeGetDatabaseKeys shakeDb
+        readDatabaseStep =  fromIntegral <$> shakeGetBuildStep shakeDb
+
+    registerGauge monitoring "ghcide.values_count" readValuesCounter
+    registerGauge monitoring "ghcide.dirty_keys_count" readDirtyKeys
+    registerGauge monitoring "ghcide.indexing_pending_count" readIndexPending
+    registerGauge monitoring "ghcide.exports_map_count" readExportsMap
+    registerGauge monitoring "ghcide.database_count" readDatabaseCount
+    registerCounter monitoring "ghcide.num_builds" readDatabaseStep
+
+    stopMonitoring <- start monitoring
+
+    let ideState = IdeState{..}
+    return ideState
+
 
+getStateKeys :: ShakeExtras -> IO [Key]
+getStateKeys = (fmap.fmap) fst . atomically . ListT.toList . STM.listT . state
 
 -- | Must be called in the 'Initialized' handler and only once
 shakeSessionInit :: Recorder (WithPriority Log) -> IdeState -> IO ()
@@ -657,6 +666,7 @@ shakeShut IdeState{..} = do
     for_ runner cancelShakeSession
     void $ shakeDatabaseProfile shakeDb
     progressStop $ progress shakeExtras
+    stopMonitoring
 
 
 -- | This is a variant of withMVar where the first argument is run unmasked and if it throws