diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index ec5fe8518..3a86bcd94 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -144,7 +144,6 @@ main = withTelemetryLogger $ \telemetryLogger -> do let defOptions = IDEMain.argsIdeOptions arguments config sessionLoader in defOptions { optShakeProfiling = argsShakeProfiling - , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling , optCheckParents = pure $ checkParents config , optCheckProject = pure $ checkProject config , optRunSubset = not argsConservativeChangeTracking diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 54f417055..109cb252c 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -95,7 +95,6 @@ library Diff ^>=0.4.0, vector, opentelemetry >=0.6.1, - heapsize ==0.3.*, unliftio >= 0.2.6, unliftio-core, ghc-boot-th, diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 0b31b83ac..9728fd041 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1,6 +1,7 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -10,7 +11,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE CPP #-} -- | A Shake implementation of the compiler service. -- @@ -162,7 +162,7 @@ import GHC.Stack (HasCallStack) import HieDb.Types import Ide.Plugin.Config import qualified Ide.PluginUtils as HLS -import Ide.Types (PluginId, IdePlugins) +import Ide.Types (IdePlugins, PluginId) import Language.LSP.Diagnostics import qualified Language.LSP.Server as LSP import Language.LSP.Types @@ -630,13 +630,10 @@ shakeOpen recorder lspEnv defaultConfig idePlugins logger debouncer shakeDatabaseProfile <- shakeDatabaseProfileIO shakeProfileDir IdeOptions - { optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled - , optProgressStyle + { optProgressStyle , optCheckParents } <- getIdeOptionsIO shakeExtras - startProfilingTelemetry otProfilingEnabled logger $ state shakeExtras - checkParents <- optCheckParents -- monitoring diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 60bdc9fec..5aaaada98 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -5,9 +5,6 @@ module Development.IDE.Core.Tracing ( otTracedHandler , otTracedAction - , startProfilingTelemetry - , measureMemory - , getInstrumentCached , otTracedProvider , otSetUri , otTracedGarbageCollection @@ -17,56 +14,28 @@ module Development.IDE.Core.Tracing ) where -import Control.Concurrent.Async (Async, async) -import Control.Concurrent.Extra (modifyVar_, newVar, readVar, - threadDelay) -import Control.Exception (evaluate) -import Control.Exception.Safe (SomeException, catch, - generalBracket) -import Control.Monad (forM_, forever, void, when, - (>=>)) +import Control.Exception.Safe (generalBracket) import Control.Monad.Catch (ExitCase (..), MonadMask) -import Control.Monad.Extra (whenJust) import Control.Monad.IO.Unlift -import Control.Monad.STM (atomically) -import Control.Seq (r0, seqList, seqTuple2, - using) import Data.ByteString (ByteString) import Data.ByteString.Char8 (pack) -import qualified Data.HashMap.Strict as HMap -import Data.IORef (modifyIORef', newIORef, - readIORef, writeIORef) import Data.String (IsString (fromString)) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) -import Data.Typeable (TypeRep, typeOf) import Data.Word (Word16) import Debug.Trace.Flags (userTracingEnabled) -import Development.IDE.Core.RuleTypes (GhcSession (GhcSession), - GhcSessionDeps (GhcSessionDeps), - GhcSessionIO (GhcSessionIO)) import Development.IDE.Graph (Action) import Development.IDE.Graph.Rule import Development.IDE.Types.Diagnostics (FileDiagnostic, showDiagnostics) import Development.IDE.Types.Location (Uri (..)) -import Development.IDE.Types.Logger (Logger (Logger), logDebug, - logInfo) -import Development.IDE.Types.Shake (ValueWithDiagnostics (..), - Values, fromKeyType) -import Foreign.Storable (Storable (sizeOf)) -import HeapSize (recursiveSize, runHeapsize) -import Ide.PluginUtils (installSigUsr1Handler) +import Development.IDE.Types.Logger (Logger (Logger)) import Ide.Types (PluginId (..)) import Language.LSP.Types (NormalizedFilePath, fromNormalizedFilePath) -import qualified "list-t" ListT -import Numeric.Natural (Natural) import OpenTelemetry.Eventlog (SpanInFlight (..), addEvent, - beginSpan, endSpan, - mkValueObserver, observe, - setTag, withSpan, withSpan_) -import qualified StmContainers.Map as STM + beginSpan, endSpan, setTag, + withSpan) #if MIN_VERSION_ghc(8,8,0) otTracedProvider :: MonadUnliftIO m => PluginId -> ByteString -> m a -> m a @@ -178,126 +147,3 @@ otTracedProvider (PluginId pluginName) provider act | otherwise = act -startProfilingTelemetry :: Bool -> Logger -> Values -> IO () -startProfilingTelemetry allTheTime logger state = do - instrumentFor <- getInstrumentCached - - installSigUsr1Handler $ do - logInfo logger "SIGUSR1 received: performing memory measurement" - performMeasurement logger state instrumentFor - - when allTheTime $ void $ regularly (1 * seconds) $ - performMeasurement logger state instrumentFor - where - seconds = 1000000 - - regularly :: Int -> IO () -> IO (Async ()) - regularly delay act = async $ forever (act >> threadDelay delay) - - -performMeasurement :: - Logger -> - Values -> - (Maybe String -> IO OurValueObserver) -> - IO () -performMeasurement logger values instrumentFor = do - contents <- atomically $ ListT.toList $ STM.listT values - let keys = typeOf GhcSession - : typeOf GhcSessionDeps - -- TODO restore - : [ kty - | (k,_) <- contents - , Just (kty,_) <- [fromKeyType k] - -- do GhcSessionIO last since it closes over stateRef itself - , kty /= typeOf GhcSession - , kty /= typeOf GhcSessionDeps - , kty /= typeOf GhcSessionIO - ] - ++ [typeOf GhcSessionIO] - groupedForSharing <- evaluate (keys `using` seqList r0) - measureMemory logger [groupedForSharing] instrumentFor values - `catch` \(e::SomeException) -> - logInfo logger ("MEMORY PROFILING ERROR: " <> fromString (show e)) - - -type OurValueObserver = Int -> IO () - -getInstrumentCached :: IO (Maybe String -> IO OurValueObserver) -getInstrumentCached = do - instrumentMap <- newVar HMap.empty - mapBytesInstrument <- mkValueObserver "value map size_bytes" - - let instrumentFor k = do - mb_inst <- HMap.lookup k <$> readVar instrumentMap - case mb_inst of - Nothing -> do - instrument <- mkValueObserver (fromString (show k ++ " size_bytes")) - modifyVar_ instrumentMap (return . HMap.insert k instrument) - return $ observe instrument - Just v -> return $ observe v - return $ maybe (return $ observe mapBytesInstrument) instrumentFor - -whenNothing :: IO () -> IO (Maybe a) -> IO () -whenNothing act mb = mb >>= f - where f Nothing = act - f Just{} = return () - -measureMemory - :: Logger - -> [[TypeRep]] -- ^ Grouping of keys for the sharing-aware analysis - -> (Maybe String -> IO OurValueObserver) - -> Values - -> IO () -measureMemory logger groups instrumentFor values = withSpan_ "Measure Memory" $ do - contents <- atomically $ ListT.toList $ STM.listT values - valuesSizeRef <- newIORef $ Just 0 - let !groupsOfGroupedValues = groupValues contents - logDebug logger "STARTING MEMORY PROFILING" - forM_ groupsOfGroupedValues $ \groupedValues -> do - keepGoing <- readIORef valuesSizeRef - whenJust keepGoing $ \_ -> - whenNothing (writeIORef valuesSizeRef Nothing) $ - repeatUntilJust 3 $ do - -- logDebug logger (fromString $ show $ map fst groupedValues) - runHeapsize 25000000 $ - forM_ groupedValues $ \(k,v) -> withSpan ("Measure " <> fromString k) $ \sp -> do - acc <- liftIO $ newIORef 0 - observe <- liftIO $ instrumentFor $ Just k - mapM_ (recursiveSize >=> \x -> liftIO (modifyIORef' acc (+ x))) v - size <- liftIO $ readIORef acc - let !byteSize = sizeOf (undefined :: Word) * size - setTag sp "size" (fromString (show byteSize ++ " bytes")) - () <- liftIO $ observe byteSize - liftIO $ modifyIORef' valuesSizeRef (fmap (+ byteSize)) - - mbValuesSize <- readIORef valuesSizeRef - case mbValuesSize of - Just valuesSize -> do - observe <- instrumentFor Nothing - observe valuesSize - logDebug logger "MEMORY PROFILING COMPLETED" - Nothing -> - logInfo logger "Memory profiling could not be completed: increase the size of your nursery (+RTS -Ax) and try again" - - where - -- groupValues :: Values -> [ [(String, [Value Dynamic])] ] - groupValues contents = - let !groupedValues = - [ [ (show ty, vv) - | ty <- groupKeys - , let vv = [ v | (fromKeyType -> Just (kty,_), ValueWithDiagnostics v _) <- contents - , kty == ty] - ] - | groupKeys <- groups - ] - -- force the spine of the nested lists - in groupedValues `using` seqList (seqList (seqTuple2 r0 (seqList r0))) - -repeatUntilJust :: Monad m => Natural -> m (Maybe a) -> m (Maybe a) -repeatUntilJust 0 _ = return Nothing -repeatUntilJust nattempts action = do - res <- action - case res of - Nothing -> repeatUntilJust (nattempts-1) action - Just{} -> return res - diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index d342b1bb5..d746c2539 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -64,7 +64,6 @@ import Development.IDE.Core.Shake (IdeState (shakeExtras shakeSessionInit, uses) import qualified Development.IDE.Core.Shake as Shake -import Development.IDE.Core.Tracing (measureMemory) import Development.IDE.Graph (action) import Development.IDE.LSP.LanguageServer (runLanguageServer, setupLSP) @@ -234,7 +233,6 @@ commandP plugins = data Arguments = Arguments { argsProjectRoot :: Maybe FilePath - , argsOTMemoryProfiling :: Bool , argCommand :: Command , argsLogger :: IO Logger , argsRules :: Rules () @@ -255,7 +253,6 @@ data Arguments = Arguments defaultArguments :: Recorder (WithPriority Log) -> Logger -> Arguments defaultArguments recorder logger = Arguments { argsProjectRoot = Nothing - , argsOTMemoryProfiling = False , argCommand = LSP , argsLogger = pure logger , argsRules = mainRule (cmapWithPrio LogRules recorder) def >> action kick @@ -439,21 +436,6 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re let nfiles xs = let n = length xs in if n == 1 then "1 file" else show n ++ " files" putStrLn $ "\nCompleted (" ++ nfiles worked ++ " worked, " ++ nfiles failed ++ " failed)" - when argsOTMemoryProfiling $ do - let values = state $ shakeExtras ide - let consoleObserver Nothing = return $ \size -> printf "Total: %.2fMB\n" (fromIntegral @Int @Double size / 1e6) - consoleObserver (Just k) = return $ \size -> printf " - %s: %.2fKB\n" (show k) (fromIntegral @Int @Double size / 1e3) - - stateContents <- atomically $ ListT.toList $ STM.listT values - printf "# Shake value store contents(%d):\n" (length stateContents) - let keys = - nub $ - typeOf GhcSession : - typeOf GhcSessionDeps : - [kty | (fromKeyType -> Just (kty,_), _) <- stateContents, kty /= typeOf GhcSessionIO] ++ - [typeOf GhcSessionIO] - measureMemory logger [keys] consoleObserver values - unless (null failed) (exitWith $ ExitFailure (length failed)) Db opts cmd -> do root <- maybe IO.getCurrentDirectory return argsProjectRoot diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs index d01d9f326..5b59bf0d3 100644 --- a/ghcide/src/Development/IDE/Types/Options.hs +++ b/ghcide/src/Development/IDE/Types/Options.hs @@ -43,9 +43,6 @@ data IdeOptions = IdeOptions -- ^ File extensions to search for code, defaults to Haskell sources (including @.hs@) , optShakeProfiling :: Maybe FilePath -- ^ Set to 'Just' to create a directory of profiling reports. - , optOTMemoryProfiling :: IdeOTMemoryProfiling - -- ^ Whether to record profiling information with OpenTelemetry. You must - -- also enable the -l RTS flag for this to have any effect , optTesting :: IdeTesting -- ^ Whether to enable additional lsp messages used by the test suite for checking invariants , optReportProgress :: IdeReportProgress @@ -123,7 +120,6 @@ defaultIdeOptions session = IdeOptions ,optPkgLocationOpts = defaultIdePkgLocationOptions ,optShakeOptions = shakeOptions ,optShakeProfiling = Nothing - ,optOTMemoryProfiling = IdeOTMemoryProfiling False ,optReportProgress = IdeReportProgress False ,optLanguageSyntax = "haskell" ,optNewColonConvention = False diff --git a/stack-lts16.yaml b/stack-lts16.yaml index e947f3244..40449ab4d 100644 --- a/stack-lts16.yaml +++ b/stack-lts16.yaml @@ -57,7 +57,6 @@ extra-deps: - ghc-source-gen-0.4.1.0 - ghc-trace-events-0.1.2.1 - haskell-src-exts-1.21.1 - - heapsize-0.3.0 - hlint-3.2.8 - HsYAML-aeson-0.2.0.0@rev:2 - hoogle-5.0.17.11 diff --git a/stack-lts19.yaml b/stack-lts19.yaml index 320cc5c6c..af599c211 100644 --- a/stack-lts19.yaml +++ b/stack-lts19.yaml @@ -45,7 +45,6 @@ extra-deps: - ghc-lib-9.2.4.20220729 - ghc-lib-parser-9.2.4.20220729 - ghc-lib-parser-ex-9.2.0.4 -- heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - hiedb-0.4.2.0 - hlint-3.4 - implicit-hie-0.1.2.7@sha256:82bbbb1a8c05f99c8af3c16ac53e80c8648d8bf047b25ed5ce45a135bd736907,3122 @@ -66,8 +65,6 @@ configure-options: - --disable-library-for-ghci haskell-language-server: - --disable-library-for-ghci - heapsize: - - --disable-library-for-ghci flags: haskell-language-server: diff --git a/stack.yaml b/stack.yaml index 33c545e3b..914b0a980 100644 --- a/stack.yaml +++ b/stack.yaml @@ -37,7 +37,6 @@ packages: extra-deps: - floskell-0.10.6@sha256:e77d194189e8540abe2ace2c7cb8efafc747ca35881a2fefcbd2d40a1292e036,3819 -- heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - hiedb-0.4.2.0 - implicit-hie-0.1.2.7@sha256:82bbbb1a8c05f99c8af3c16ac53e80c8648d8bf047b25ed5ce45a135bd736907,3122 - implicit-hie-cradle-0.5.0.0@sha256:4276f60f3a59bc22df03fd918f73bca9f777de9568f85e3a8be8bd7566234a59,2368