Abstract monitoring and put EKG behind a Cabal flag

haskell · Apr 30, 2022 · 86f045c · 86f045c
1 parent f39347a
commit 86f045c
Show file tree

Hide file tree

Showing 10 changed files with 200 additions and 98 deletions.
diff --git a/docs/contributing/contributing.md b/docs/contributing/contributing.md
@@ -229,7 +229,7 @@ See the [tutorial](./plugin-tutorial.md) on writing a plugin in HLS.
 
 ### Metrics
 
-HLS opens a metrics server on port 8000 exposing GC and ghcide metrics. The ghcide metrics currently exposed are:
+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)

diff --git a/ghcide/exe/Arguments.hs b/ghcide/exe/Arguments.hs
@@ -1,6 +1,7 @@
 -- Copyright (c) 2019 The DAML Authors. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
 
+{-# LANGUAGE CPP #-}
 module Arguments(Arguments(..), getArguments) where
 
 import           Development.IDE      (IdeState)
@@ -19,6 +20,9 @@ data Arguments = Arguments
     ,argsVerbose                    :: Bool
     ,argsCommand                    :: Command
     ,argsConservativeChangeTracking :: Bool
+#ifdef MONITORING_EKG
+    ,argsMonitoringPort             :: Int
+#endif
     }
 
 getArguments :: IdePlugins IdeState -> IO Arguments
@@ -40,6 +44,9 @@ 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)")
+#ifdef MONITORING_EKG
+      <*> option auto (long "monitoring-port" <> metavar "PORT" <> value 8999 <> showDefault <> help "Port to use for monitoring")
+#endif
       where
           checkCommand = Check <$> many (argument str (metavar "FILES/DIRS..."))
           lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP client")
diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs
@@ -1,6 +1,7 @@
 -- Copyright (c) 2019 The DAML Authors. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
 {-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above
+{-# LANGUAGE CPP             #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Main(main) where
@@ -24,7 +25,6 @@ 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)
@@ -43,6 +43,11 @@ import           System.Exit                       (exitSuccess)
 import           System.IO                         (hPutStrLn, stderr)
 import           System.Info                       (compilerVersion)
 
+#ifdef MONITORING_EKG
+import qualified Development.IDE.Monitoring.OpenTelemetry as OpenTelemetry
+import qualified Development.IDE.Monitoring.EKG as EKG
+#endif
+
 data Log
   = LogIDEMain IDEMain.Log
   | LogRules Rules.Log
@@ -142,4 +147,10 @@ main = withTelemetryLogger $ \telemetryLogger -> do
                 , optCheckProject = pure $ checkProject config
                 , optRunSubset = not argsConservativeChangeTracking
                 }
+#ifdef MONITORING_EKG
+        , IDEMain.argsMonitoring = OpenTelemetry.monitoring <> EKG.monitoring logger argsMonitoringPort
+#ifdef MONITORING_EKG
+#endif
+#endif
+
         }
diff --git a/ghcide/ghcide.cabal b/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:
@@ -48,8 +53,6 @@ library
         dependent-map,
         dependent-sum,
         dlist,
-        ekg-wai,
-        ekg-core,
         exceptions,
         extra >= 1.7.4,
         enummapset,
@@ -197,6 +200,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
@@ -235,6 +240,14 @@ library
       exposed-modules:
         Development.IDE.GHC.Compat.CPP
 
+    if flag(ekg)
+        build-depends:
+            ekg-wai,
+            ekg-core,
+        cpp-options:   -DMONITORING_EKG
+        exposed-modules:
+            Development.IDE.Monitoring.EKG
+
 flag test-exe
     description: Build the ghcide-test-preprocessor executable
     default: True
@@ -355,6 +368,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

diff --git a/ghcide/src/Development/IDE/Core/Service.hs b/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           System.Metrics
+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,7 +68,7 @@ initialise :: Recorder (WithPriority Log)
            -> IdeOptions
            -> WithHieDb
            -> IndexQueue
-           -> Maybe Store
+           -> Monitoring
            -> IO IdeState
 initialise recorder defaultConfig mainRule lspEnv logger debouncer options withHieDb hiedbChan metrics = do
     shakeProfiling <- do

diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/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
@@ -168,8 +167,8 @@ import qualified "list-t" ListT
 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
+import Development.IDE.Types.Monitoring (Monitoring(..))
 
 data Log
   = LogCreateHieDbExportsMapStart
@@ -464,6 +463,7 @@ data IdeState = IdeState
     ,shakeSession         :: MVar ShakeSession
     ,shakeExtras          :: ShakeExtras
     ,shakeDatabaseProfile :: ShakeDatabase -> IO (Maybe FilePath)
+    ,stopMonitoring       :: IO ()
     }
 
 
@@ -559,11 +559,13 @@ shakeOpen :: Recorder (WithPriority Log)
           -> WithHieDb
           -> IndexQueue
           -> ShakeOptions
-          -> Maybe Store
+          -> Monitoring
           -> Rules ()
           -> IO IdeState
 shakeOpen recorder lspEnv defaultConfig logger debouncer
-  shakeProfileDir (IdeReportProgress reportProgress) ideTesting@(IdeTesting testing) withHieDb indexQueue opts metrics rules = mdo
+  shakeProfileDir (IdeReportProgress reportProgress)
+  ideTesting@(IdeTesting testing)
+  withHieDb indexQueue opts monitoring rules = mdo
     let log :: Logger.Priority -> Log -> IO ()
         log = logWith recorder
 
@@ -611,52 +613,37 @@ 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
 
     checkParents <- optCheckParents
-    for_ metrics $ \store -> do
-        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 "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
+    -- 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
 
-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 =<< getStateKeys extras
-        readTVarIO dirtyKeys >>= observe countDirty . countRelevantKeys checkParents . HSet.toList
-        shakeGetBuildStep db >>= observe countBuilds
+    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
 
-  | otherwise = async (pure ())
-    where
-        regularly :: Seconds -> IO () -> IO (Async ())
-        regularly delay act = async $ forever (act >> sleep delay)
 
 getStateKeys :: ShakeExtras -> IO [Key]
 getStateKeys = (fmap.fmap) fst . atomically . ListT.toList . STM.listT . state
@@ -679,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