eventlog-live-otelcol 0.4.0.0 → 0.5.0.0
raw patch · 4 files changed
+204/−66 lines, 4 files
Files
- CHANGELOG.md +4/−0
- eventlog-live-otelcol.cabal +15/−2
- src/GHC/Debug/Stub/Compat.hs +181/−0
- src/GHC/Eventlog/Live/Otelcol.hs +4/−64
CHANGELOG.md view
@@ -1,3 +1,7 @@+### 0.5.0.0++- **BREAKING**: Put `ghc-debug-stub` support behind `use-ghc-debug-stub` feature flag.+ ### 0.4.0.0 - Fix space leak in `processHeapProfSampleData`.
eventlog-live-otelcol.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: eventlog-live-otelcol-version: 0.4.0.0+version: 0.5.0.0 synopsis: Stream eventlog data to the OpenTelemetry Collector. description: This executable supports live streaming of eventlog data into@@ -88,6 +88,15 @@ location: https://github.com/well-typed/eventlog-live.git subdir: eventlog-live-otelcol +-- 2025-11-10:+-- This flag should enable switching the use of ghc-debug-stub on+-- and off, since it may cause issues with certain versions of GHC.+-- See https://github.com/well-typed/eventlog-live/issues/88+flag use-ghc-debug-stub+ description: Use ghc-debug-stub+ default: False+ manual: True+ -- 2025-11-06: -- This flag should enable switching between template-haskell and -- template-haskell-lift, because the latter is not on nixpkgs.@@ -145,6 +154,7 @@ GHC.Eventlog.Live.Otelcol.Stats other-modules:+ GHC.Debug.Stub.Compat GHC.Eventlog.Live.Otelcol.Config.Default GHC.Eventlog.Live.Otelcol.Config.Default.Raw GHC.Eventlog.Live.Otelcol.Config.Types@@ -164,7 +174,6 @@ , eventlog-live >=0.4 && <0.5 , eventlog-socket >=0.1.0 && <0.2 , file-embed >=0.0.16 && <0.1- , ghc-debug-stub >=0.1 && <1.0 , ghc-events >=0.20 && <0.21 , grapesy >=1.0.0 && <1.2 , hashable >=1.4 && <1.6@@ -180,6 +189,10 @@ , unordered-containers >=0.2.20 && <0.3 , vector >=0.11 && <0.14 , yaml >=0.11 && <0.12++ if flag(use-ghc-debug-stub)+ build-depends: ghc-debug-stub >=0.1 && <1.0+ cpp-options: -DEVENTLOG_LIVE_OTELCOL_USE_GHC_DEBUG_STUB if flag(use-template-haskell-lift) build-depends: template-haskell-lift >=0.1 && <0.2
+ src/GHC/Debug/Stub/Compat.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE CPP #-}++{- |+Module : GHC.Debug.Stub.Compat+Description : The implementation of @eventlog-live-otelcol@.+Stability : experimental+Portability : portable+-}+module GHC.Debug.Stub.Compat (+ MyGhcDebugSocket (..),+ withMyGhcDebug,+ maybeMyGhcDebugSocketParser,+) where++import Control.Applicative (asum)+import Data.Text qualified as T (pack)+import GHC.Eventlog.Live.Logger (logError)+import GHC.Eventlog.Live.Verbosity (Verbosity)+import Options.Applicative qualified as O++#if defined(EVENTLOG_LIVE_OTELCOL_USE_GHC_DEBUG_STUB)+import GHC.Debug.Stub qualified as GHC.Debug (withGhcDebug, withGhcDebugTCP, withGhcDebugUnix)+import System.Exit (exitFailure)+import Text.Read (readEither)+#else+import Data.Maybe (isJust)+import System.Exit (exitFailure)+import Options.Applicative.Help.Pretty qualified as OP+#endif++--------------------------------------------------------------------------------+-- My GHC Debug++data MyGhcDebugSocket+ = MyGhcDebugSocketDefault+ | MyGhcDebugSocketUnix FilePath+ | MyGhcDebugSocketTcp String+ deriving (Show)++{- |+Internal helper.+Start @ghc-debug@ on the given `MyGhcDebugSocket`.+-}+withMyGhcDebug :: Verbosity -> Maybe MyGhcDebugSocket -> IO a -> IO a+#if defined(EVENTLOG_LIVE_OTELCOL_USE_GHC_DEBUG_STUB)+withMyGhcDebug verbosity maybeMyGhcDebugSocket action =+ case maybeMyGhcDebugSocket of+ Nothing -> action+ Just MyGhcDebugSocketDefault ->+ GHC.Debug.withGhcDebug action+ Just (MyGhcDebugSocketUnix myGhcDebugSocketUnix) ->+ GHC.Debug.withGhcDebugUnix myGhcDebugSocketUnix action+ Just (MyGhcDebugSocketTcp myGhcDebugSocketTcp) -> do+ let (host, port) = break (== ':') myGhcDebugSocketTcp+ case readEither port of+ Left _parseError -> do+ logError verbosity . T.pack $+ "Could not parse ghc-debug TCP address " <> myGhcDebugSocketTcp <> "."+ exitFailure+ Right portWord16 ->+ GHC.Debug.withGhcDebugTCP host portWord16 action+#else+withMyGhcDebug verbosity maybeMyGhcDebugSocket action+ | isJust maybeMyGhcDebugSocket = do+ logError verbosity $ T.pack myGhcDebugSocketUnsupportedErrorMessage+ exitFailure+ | otherwise = action+#endif++--------------------------------------------------------------------------------+-- My GHC Debug++maybeMyGhcDebugSocketParser :: O.Parser (Maybe MyGhcDebugSocket)+#if defined(EVENTLOG_LIVE_OTELCOL_USE_GHC_DEBUG_STUB)+maybeMyGhcDebugSocketParser =+ O.optional . asum $+ [ myGhcDebugSocketDefaultParser+ , myGhcDebugSocketUnixParser+ , myGhcDebugSocketTcpParser+ ]+ where+ myGhcDebugSocketDefaultParser =+ O.flag'+ MyGhcDebugSocketDefault+ ( O.long myGhcDebugSocketDefaultLong+ <> O.help myGhcDebugSocketDefaultHelp+ )+ myGhcDebugSocketUnixParser =+ MyGhcDebugSocketUnix+ <$> O.strOption+ ( O.long myGhcDebugSocketUnixLong+ <> O.metavar myGhcDebugSocketUnixMetavar+ <> O.help myGhcDebugSocketUnixHelp+ )+ myGhcDebugSocketTcpParser =+ MyGhcDebugSocketUnix+ <$> O.strOption+ ( O.long myGhcDebugSocketTcpLong+ <> O.metavar myGhcDebugSocketTcpMetavar+ <> O.help myGhcDebugSocketTcpHelp+ )+#else+maybeMyGhcDebugSocketParser =+ asum . fmap mkUnsupportedParser $+ [ myGhcDebugSocketDefaultMod+ , myGhcDebugSocketUnixMod+ , myGhcDebugSocketTcpMod+ ]+ where+ mkUnsupportedParser modOptionFields =+ Nothing <$ O.infoOption myGhcDebugSocketUnsupportedErrorMessage modOptionFields+ mkUnsupportedHelpDoc help =+ Just $ OP.vcat [OP.pretty $ "Unsupported. Requires build with -f+" <> myGhcDebugFeatureFlag <> ".", OP.pretty help]+ myGhcDebugSocketDefaultMod =+ O.long myGhcDebugSocketDefaultLong+ <> O.hidden+ <> O.helpDoc (mkUnsupportedHelpDoc myGhcDebugSocketDefaultHelp)+ myGhcDebugSocketUnixMod =+ O.long myGhcDebugSocketUnixLong+ <> O.metavar myGhcDebugSocketUnixMetavar+ <> O.hidden+ <> O.helpDoc (mkUnsupportedHelpDoc myGhcDebugSocketUnixHelp)+ myGhcDebugSocketTcpMod =+ O.long myGhcDebugSocketTcpLong+ <> O.metavar myGhcDebugSocketTcpMetavar+ <> O.hidden+ <> O.helpDoc (mkUnsupportedHelpDoc myGhcDebugSocketTcpHelp)+#endif++#if !defined(EVENTLOG_LIVE_OTELCOL_USE_GHC_DEBUG_STUB)+myGhcDebugFeatureFlag :: String+myGhcDebugFeatureFlag =+ "use-ghc-debug-stub"+#endif++#if !defined(EVENTLOG_LIVE_OTELCOL_USE_GHC_DEBUG_STUB)+myGhcDebugSocketUnsupportedErrorMessage :: String+myGhcDebugSocketUnsupportedErrorMessage =+ "Cannot open ghc-debug socket. This executable was built without -f+" <> myGhcDebugFeatureFlag <> "."+{-# INLINE myGhcDebugSocketUnsupportedErrorMessage #-}+#endif++myGhcDebugSocketDefaultLong :: String+myGhcDebugSocketDefaultLong =+ "enable-my-ghc-debug-socket"+{-# INLINE myGhcDebugSocketDefaultLong #-}++myGhcDebugSocketDefaultHelp :: String+myGhcDebugSocketDefaultHelp =+ "Enable ghc-debug for this program."+{-# INLINE myGhcDebugSocketDefaultHelp #-}++myGhcDebugSocketUnixLong :: String+myGhcDebugSocketUnixLong =+ "enable-my-ghc-debug-socket-unix"+{-# INLINE myGhcDebugSocketUnixLong #-}++myGhcDebugSocketUnixMetavar :: String+myGhcDebugSocketUnixMetavar =+ "SOCKET"+{-# INLINE myGhcDebugSocketUnixMetavar #-}++myGhcDebugSocketUnixHelp :: String+myGhcDebugSocketUnixHelp =+ "Enable ghc-debug for this program on the given Unix socket."+{-# INLINE myGhcDebugSocketUnixHelp #-}++myGhcDebugSocketTcpLong :: String+myGhcDebugSocketTcpLong =+ "enable-my-ghc-debug-socket-tcp"+{-# INLINE myGhcDebugSocketTcpLong #-}++myGhcDebugSocketTcpMetavar :: String+myGhcDebugSocketTcpMetavar =+ "ADDRESS"+{-# INLINE myGhcDebugSocketTcpMetavar #-}++myGhcDebugSocketTcpHelp :: String+myGhcDebugSocketTcpHelp =+ "Enable ghc-debug for this program on the given TCP socket specified as 'host:port'."+{-# INLINE myGhcDebugSocketTcpHelp #-}
src/GHC/Eventlog/Live/Otelcol.hs view
@@ -11,7 +11,7 @@ main, ) where -import Control.Applicative (Alternative (..), asum)+import Control.Applicative (asum) import Control.Monad.IO.Class (MonadIO (..)) import Data.ByteString (ByteString) import Data.Coerce (Coercible, coerce)@@ -35,12 +35,12 @@ import Data.Version (showVersion) import Data.Word (Word32, Word64) import Data.Yaml qualified as Y-import GHC.Debug.Stub qualified as GHC.Debug (withGhcDebug, withGhcDebugTCP, withGhcDebugUnix)+import GHC.Debug.Stub.Compat (MyGhcDebugSocket (..), maybeMyGhcDebugSocketParser, withMyGhcDebug) import GHC.Eventlog.Live.Data.Attribute import GHC.Eventlog.Live.Data.Group (Group, GroupBy, GroupedBy) import GHC.Eventlog.Live.Data.Group qualified as DG import GHC.Eventlog.Live.Data.Metric (Metric (..))-import GHC.Eventlog.Live.Logger (logDebug, logError)+import GHC.Eventlog.Live.Logger (logDebug) import GHC.Eventlog.Live.Machine.Analysis.Capability (CapabilityUsageSpan) import GHC.Eventlog.Live.Machine.Analysis.Capability qualified as M import GHC.Eventlog.Live.Machine.Analysis.Heap (MemReturnData (..))@@ -78,10 +78,8 @@ import Proto.Opentelemetry.Proto.Metrics.V1.Metrics_Fields qualified as OM import Proto.Opentelemetry.Proto.Trace.V1.Trace qualified as OT import Proto.Opentelemetry.Proto.Trace.V1.Trace_Fields qualified as OT-import System.Exit (exitFailure) import System.Random (StdGen, initStdGen) import System.Random.Compat (uniformByteString)-import Text.Read (readEither) {- | The main function for @eventlog-live-otelcol@.@@ -833,7 +831,7 @@ OC.parserOptionGroup "Debug Options" $ MyDebugOptions <$> O.optional myEventlogSocketParser- <*> O.optional myGhcDebugSocketParser+ <*> maybeMyGhcDebugSocketParser -------------------------------------------------------------------------------- -- My Eventlog Socket@@ -857,64 +855,6 @@ withMyEventlogSocket maybeMyEventlogSocket = for_ maybeMyEventlogSocket $ \(MyEventlogSocketUnix myEventlogSocket) -> Eventlog.Socket.startWait myEventlogSocket------------------------------------------------------------------------------------- My GHC Debug--data MyGhcDebugSocket- = MyGhcDebugSocketDefault- | MyGhcDebugSocketUnix FilePath- | MyGhcDebugSocketTcp String- deriving (Show)--myGhcDebugSocketParser :: O.Parser MyGhcDebugSocket-myGhcDebugSocketParser =- myGhcDebugSocketDefaultParser- <|> myGhcDebugSocketUnixParser- <|> myGhcDebugSocketTcpParser- where- myGhcDebugSocketDefaultParser =- O.flag'- MyGhcDebugSocketDefault- ( O.long "enable-my-ghc-debug-socket"- <> O.help "Enable ghc-debug for this program."- )- myGhcDebugSocketUnixParser =- MyGhcDebugSocketUnix- <$> O.strOption- ( O.long "enable-my-ghc-debug-socket-unix"- <> O.metavar "SOCKET"- <> O.help "Enable ghc-debug for this program on the given Unix socket."- )- myGhcDebugSocketTcpParser =- MyGhcDebugSocketUnix- <$> O.strOption- ( O.long "enable-my-ghc-debug-socket-tcp"- <> O.metavar "ADDRESS"- <> O.help "Enable ghc-debug for this program on the given TCP socket specified as 'host:port'."- )--{- |-Internal helper.-Start @ghc-debug@ on the given `MyGhcDebugSocket`.--}-withMyGhcDebug :: Verbosity -> Maybe MyGhcDebugSocket -> IO a -> IO a-withMyGhcDebug verbosity maybeMyGhcDebugSocket action =- case maybeMyGhcDebugSocket of- Nothing -> action- Just MyGhcDebugSocketDefault ->- GHC.Debug.withGhcDebug action- Just (MyGhcDebugSocketUnix myGhcDebugSocketUnix) ->- GHC.Debug.withGhcDebugUnix myGhcDebugSocketUnix action- Just (MyGhcDebugSocketTcp myGhcDebugSocketTcp) -> do- let (host, port) = break (== ':') myGhcDebugSocketTcp- case readEither port of- Left _parseError -> do- logError verbosity $- "Could not parse ghc-debug TCP address " <> T.pack myGhcDebugSocketTcp <> "."- exitFailure- Right portWord16 ->- GHC.Debug.withGhcDebugTCP host portWord16 action -------------------------------------------------------------------------------- -- Configuration