Collect metrics and expose an EKG server

pepeiborra · pepeiborra · commit 088db2a62787 · 2022-05-06T07:26:34.000+01:00
diff --git a/cabal.project b/cabal.project
@@ -53,6 +53,12 @@ constraints:
   ghc-lib-parser-ex -auto,
   stylish-haskell +ghc-lib
 
+ source-repository-package
+  type:git
+  location: https://github.com/vshabanov/ekg-json
+  tag: 00ebe7211c981686e65730b7144fbf5350462608
+  -- https://github.com/tibbe/ekg-json/pull/12
+
 allow-newer:
   -- ghc-9.2
   ----------
@@ -70,3 +76,11 @@ allow-newer:
   -- for shake-bench
   Chart:lens,
   Chart-diagrams:lens,
+
+  -- for ekg
+  ekg-core:base,
+  ekg-wai:base,
+
+  -- for shake-bench
+  Chart-diagrams:diagrams-core,
+  SVGFonts:diagrams-core
diff --git a/docs/contributing/contributing.md b/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
+
+HLS opens a metrics server on port 8000 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 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.
diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
@@ -48,6 +48,8 @@ library
         dependent-map,
         dependent-sum,
         dlist,
+        ekg-wai,
+        ekg-core,
         exceptions,
         extra >= 1.7.4,
         enummapset,
diff --git a/ghcide/src/Development/IDE/Core/Service.hs b/ghcide/src/Development/IDE/Core/Service.hs
@@ -38,10 +38,11 @@ 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           Development.IDE.Core.Shake
 import qualified Development.IDE.Core.Shake      as Shake
 import           Development.IDE.Types.Shake     (WithHieDb)
 import           System.Environment              (lookupEnv)
-
+import           System.Metrics
 
 data Log
   = LogShake Shake.Log
@@ -68,8 +69,9 @@ initialise :: Recorder (WithPriority Log)
            -> IdeOptions
            -> WithHieDb
            -> IndexQueue
+           -> Maybe Store
            -> 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 +88,7 @@ initialise recorder defaultConfig mainRule lspEnv logger debouncer options withH
         withHieDb
         hiedbChan
         (optShakeOptions options)
+        metrics
           $ do
             addIdeGlobal $ GlobalIdeOptions options
             ofInterestRules (cmapWithPrio LogOfInterest recorder)
diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -136,6 +136,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 +153,23 @@ 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           Control.Exception.Extra                hiding (bracket_)
+import           Data.Aeson                             (toJSON)
+import qualified Data.ByteString.Char8                  as BS8
+import           Data.Coerce                            (coerce)
+import           Data.Default
+import           Data.Foldable                          (for_, toList)
+import           Data.HashSet                           (HashSet)
+import qualified Data.HashSet                           as HSet
+import           Data.IORef.Extra                       (atomicModifyIORef'_,
+                                                         atomicModifyIORef_)
+import           Data.String                            (fromString)
+import           Data.Text                              (pack)
+import           Debug.Trace.Flags                      (userTracingEnabled)
+import qualified Development.IDE.Types.Exports          as ExportsMap
 import           HieDb.Types
 import           Ide.Plugin.Config
 import qualified Ide.PluginUtils                        as HLS
@@ -167,6 +185,7 @@ import           OpenTelemetry.Eventlog
 import qualified StmContainers.Map                      as STM
 import           System.FilePath                        hiding (makeRelative)
 import           System.IO.Unsafe (unsafePerformIO)
+import           System.Metrics                         (Store, registerCounter, registerGauge)
 import           System.Time.Extra
 
 data Log
@@ -388,7 +407,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
@@ -557,10 +576,11 @@ shakeOpen :: Recorder (WithPriority Log)
           -> WithHieDb
           -> IndexQueue
           -> ShakeOptions
+          -> Maybe Store
           -> 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 metrics rules = mdo
     let log :: Logger.Priority -> Log -> IO ()
         log = logWith recorder
 
@@ -613,11 +633,28 @@ shakeOpen recorder lspEnv defaultConfig logger debouncer
     IdeOptions
         { optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled
         , optProgressStyle
+        , optCheckParents
         } <- getIdeOptionsIO shakeExtras
 
     void $ startTelemetry shakeDb shakeExtras
     startProfilingTelemetry otProfilingEnabled logger $ state shakeExtras
 
+    checkParents <- optCheckParents
+    for_ metrics $ \store -> do
+        let readValuesCounter = fromIntegral . countRelevantKeys checkParents . HMap.keys <$> readVar (state shakeExtras)
+            readDirtyKeys = fromIntegral . countRelevantKeys checkParents . HSet.toList <$> readIORef (dirtyKeys shakeExtras)
+            readIndexPending = fromIntegral . HMap.size <$> readTVarIO (indexPending $ hiedbWriter shakeExtras)
+            readExportsMap = fromIntegral . HMap.size . getExportsMap <$> readVar (exportsMap shakeExtras)
+            readDatabaseCount = fromIntegral . countRelevantKeys checkParents . map fst <$> shakeGetDatabaseKeys shakeDb
+            readDatabaseStep =  fromIntegral <$> shakeGetBuildStep shakeDb
+
+        registerGauge "ghcide.values_count" readValuesCounter store
+        registerGauge "ghcide.dirty_keys_count" readDirtyKeys store
+        registerGauge "ghcide.indexing_pending_count" readIndexPending store
+        registerGauge "ghcide.exports_map_count" readExportsMap store
+        registerGauge "ghcide.database_count" readDatabaseCount store
+        registerCounter "ghcide.num_builds" readDatabaseStep store
+
     return ideState
 
 startTelemetry :: ShakeDatabase -> ShakeExtras -> IO (Async ())
diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs
@@ -29,6 +29,7 @@ import           Data.Maybe                            (catMaybes, isJust)
 import qualified Data.Text                             as T
 import           Data.Text.Lazy.Encoding               (decodeUtf8)
 import qualified Data.Text.Lazy.IO                     as LT
+import           Data.Traversable                      (for)
 import           Data.Typeable                         (typeOf)
 import           Development.IDE                       (Action, GhcVersion (..),
                                                         Priority (Debug, Error), Rules,
@@ -126,6 +127,9 @@ import           System.IO                             (BufferMode (LineBufferin
                                                         hSetEncoding, stderr,
                                                         stdin, stdout, utf8)
 import           System.Random                         (newStdGen)
+import qualified System.Metrics                        as Monitoring
+import           System.Remote.Monitoring.Wai
+import qualified System.Remote.Monitoring.Wai          as Monitoring
 import           System.Time.Extra                     (Seconds, offsetTime,
                                                         showDuration)
 import           Text.Printf                           (printf)
@@ -231,6 +235,7 @@ data Arguments = Arguments
     , argsHandleIn              :: IO Handle
     , argsHandleOut             :: IO Handle
     , argsThreads               :: Maybe Natural
+    , argsMonitoringPort        :: Maybe Natural
     }
 
 
@@ -268,6 +273,7 @@ defaultArguments recorder logger = Arguments
                 -- the language server tests without the redirection.
                 putStr " " >> hFlush stdout
                 return newStdout
+        , argsMonitoringPort = Just 8000
         }
 
 
@@ -355,6 +361,23 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
                 -- FIXME: Remove this after GHC 9 gets fully supported
                 when (ghcVersion == GHC90) $
                     log Warning LogOnlyPartialGhc9Support
+                server <- fmap join $ for argsMonitoringPort $ \p -> do
+                    store <- Monitoring.newStore
+                    let startServer = Monitoring.forkServerWith store "localhost" (fromIntegral p)
+                    -- this can fail if the port is busy, throwing an async exception back to us
+                    -- to handle that, wrap the server thread in an async
+                    mb_server <- async startServer >>= waitCatch
+                    case mb_server of
+                        Right s -> do
+                            logInfo logger $ T.pack $
+                                "Started monitoring server on port " <> show p
+                            return $ Just s
+                        Left e -> do
+                            logInfo logger $ T.pack $
+                                "Unable to bind monitoring server on port "
+                                <> show p <> ":" <> show e
+                            return Nothing
+
                 initialise
                     (cmapWithPrio LogService recorder)
                     argsDefaultHlsConfig
@@ -365,6 +388,9 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
                     options
                     withHieDb
                     hieChan
+                    (Monitoring.serverMetricStore <$> server)
+                    `onException`
+                        traverse_ (killThread . serverThreadId) server
             dumpSTMStats
         Check argFiles -> do
           dir <- maybe IO.getCurrentDirectory return argsProjectRoot
@@ -397,7 +423,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
                         , optCheckProject = pure False
                         , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins
                         }
-            ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig rules Nothing logger debouncer options hiedb hieChan
+            ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig rules Nothing logger debouncer options hiedb hieChan Nothing
             shakeSessionInit (cmapWithPrio LogShake recorder) ide
             registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing)
 
@@ -450,13 +476,8 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
                     , optCheckProject = pure False
                     , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins
                     }
-            ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig rules Nothing logger debouncer options hiedb hieChan
+            ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig rules Nothing logger debouncer options hiedb hieChan Nothing
             shakeSessionInit (cmapWithPrio LogShake recorder) ide
-            registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing)
-            c ide
-
-{-# ANN defaultMain ("HLint: ignore Use nubOrd" :: String) #-}
-
 
 expandFiles :: [FilePath] -> IO [FilePath]
 expandFiles = concatMapM $ \x -> do
