eventlog-live-otelcol 0.6.0.0 → 0.6.1.0
raw patch · 8 files changed
+355/−315 lines, 8 files
Files
- CHANGELOG.md +4/−0
- eventlog-live-otelcol.cabal +65/−59
- src/GHC/Eventlog/Live/Otelcol.hs +1/−1
- src/GHC/Eventlog/Live/Otelcol/Control.hs +1/−1
- src/GHC/Eventlog/Live/Otelcol/Processor/Common/Profiles.hs +0/−207
- src/GHC/Eventlog/Live/Otelcol/Processor/Common/ProfilesDictionary.hs +161/−0
- src/GHC/Eventlog/Live/Otelcol/Processor/Common/SymbolTable.hs +76/−0
- src/GHC/Eventlog/Live/Otelcol/Processor/Profiles.hs +47/−47
CHANGELOG.md view
@@ -1,3 +1,7 @@+### 0.6.1.0++- Support eventlog over TCP/IP.+ ### 0.6.0.0 - **BREAKING**: Drop `enabled` from configuration files.
eventlog-live-otelcol.cabal view
@@ -1,80 +1,85 @@ cabal-version: 3.0 name: eventlog-live-otelcol-version: 0.6.0.0+version: 0.6.1.0 synopsis: Stream eventlog data to the OpenTelemetry Collector. description: This executable supports live streaming of eventlog data into the OpenTelemetry Collector. - > Usage: eventlog-live-otelcol (--eventlog-stdin | --eventlog-file FILE | --eventlog-socket SOCKET)+ > Usage: eventlog-live-otelcol (--eventlog-stdin | --eventlog-file FILE |+ > --eventlog-socket SOCKET |+ > --eventlog-socket-host HOST+ > --eventlog-socket-port PORT) > [--eventlog-socket-timeout SECONDS] > [--eventlog-socket-exponent NUMBER] > [--eventlog-flush-interval SECONDS]- > [--eventlog-log-file FILE]- > [-h Tcmdyrbi]+ > [--eventlog-log-file FILE] [-h Tcmdyrbi] > [--service-name STRING] > [-v|--verbosity fatal|error|warning|info|debug|trace]- > [-s|--stats]- > [--config FILE]- > --otelcol-host HOST- > [--otelcol-port PORT]- > [--otelcol-authority HOST]- > [--otelcol-ssl]- > [--otelcol-certificate-store FILE]- > [--otelcol-ssl-key-log FILE | --otelcol-ssl-key-log-from-env]- > [--control]- > [--control-port PORT]- > [--control-cors-allow-origin ORIGIN]- > [--control-cors-max-age SECONDS]- > [--control-cors-require-origin]- > [--control-cors-ignore-failure]- > [--my-eventlog-socket-unix FILE]- > [--my-ghc-debug-socket | --my-ghc-debug-socket-unix FILE | --my-ghc-debug-socket-tcp ADDRESS]- > [--print-defaults]- > [--print-config-json-schema]+ > [-s|--stats] [--config FILE] --otelcol-host HOST+ > [--otelcol-port PORT] [--otelcol-authority HOST]+ > [--otelcol-ssl] [--otelcol-certificate-store FILE]+ > [--otelcol-ssl-key-log FILE |+ > --otelcol-ssl-key-log-from-env]+ > [--print-defaults] [--print-config-json-schema] > > Available options:- > --eventlog-stdin Read the eventlog from stdin.- > --eventlog-file FILE Read the eventlog from a file.- > --eventlog-socket SOCKET Read the eventlog from a Unix socket.- > --eventlog-socket-timeout SECONDS Eventlog socket connection retry timeout in seconds.- > --eventlog-socket-exponent NUMBER Eventlog socket connection retry timeout exponent.- > --eventlog-flush-interval SECONDS Eventlog flush interval in seconds.- > Should match the option passed to the application.- > --eventlog-log-file FILE Use file to log binary eventlog data.- > -h Tcmdyrbi Heap profile breakdown.- > Should match the option passed to the application.- > --service-name STRING The name of the profiled service.+ > --eventlog-stdin Read the eventlog from stdin.+ > --eventlog-file FILE Read the eventlog from a file.+ > --eventlog-socket SOCKET Read the eventlog from a Unix socket.+ > --eventlog-socket-host HOST Read the eventlog from a TCP/IP socket.+ > --eventlog-socket-port PORT Read the eventlog from a TCP/IP socket.+ > --eventlog-socket-timeout SECONDS Eventlog socket connection retry timeout in seconds.+ > --eventlog-socket-exponent NUMBER Eventlog socket connection retry timeout exponent.+ > --eventlog-flush-interval SECONDS Eventlog flush interval in seconds.+ > Should match the option passed to the application.+ > --eventlog-log-file FILE Use file to log binary eventlog data.+ > -h Tcmdyrbi Heap profile breakdown.+ > Should match the option passed to the application.+ > --service-name STRING The name of the profiled service. > -v,--verbosity fatal|error|warning|info|debug|trace- > The severity threshold for logging.- > -s,--stats Display runtime statistics.- > --config FILE The path to a detailed configuration file.- > --print-defaults Print default configuration options.- > --print-config-json-schema Print JSON Schema for configuration format.- > --help Show this help text.- > --version Show version information+ > The severity threshold for logging.+ > -s,--stats Display runtime statistics.+ > --config FILE The path to a detailed configuration file.+ > --print-defaults Print default configuration options.+ > --print-config-json-schema Print JSON Schema for configuration format.+ > --help Show this help text.+ > --version Show version information > > OpenTelemetry Collector Server Options- > --otelcol-host HOST Otelcol server hostname.- > --otelcol-port PORT Otelcol server TCP port.- > --otelcol-authority HOST Otelcol server authority.- > --otelcol-ssl Use SSL.- > --otelcol-certificate-store FILE Store for certificate validation.- > --otelcol-ssl-key-log FILE Use file to log SSL keys.- > --otelcol-ssl-key-log-from-env Use SSLKEYLOGFILE to log SSL keys.+ > --otelcol-host HOST Otelcol server hostname.+ > --otelcol-port PORT Otelcol server TCP port.+ > --otelcol-authority HOST Otelcol server authority.+ > --otelcol-ssl Use SSL.+ > --otelcol-certificate-store FILE Store for certificate validation.+ > --otelcol-ssl-key-log FILE Use file to log SSL keys.+ > --otelcol-ssl-key-log-from-env Use SSLKEYLOGFILE to log SSL keys. > > Control Server Options- > --control Start the control server.- > --control-port PORT The port number for the control server.- > --control-cors-allow-origin ORIGIN Set the allowed origins for the control server CORS policy.- > --control-cors-max-age SECONDS Set the maximum age of a cached CORS preflight request for the control server CORS policy.- > --control-cors-require-origin If enabled, the control server will not accept requests without an Origin header.- > --control-cors-ignore-failure If enabled, the control server will accept malformed CORS preflight requests.+ > --control Requires build with -f+control.+ > Start the control server.+ > --control-port Requires build with -f+control.+ > The port number for the control server.+ > --control-cors-allow-origin+ > Requires build with -f+control.+ > Set the allowed origins for the control server CORS policy.+ > --control-cors-max-age Requires build with -f+control.+ > Set the maximum age of a cached CORS preflight request for the control server CORS policy.+ > --control-cors-require-origin+ > Requires build with -f+control.+ > If enabled, the control server will not accept requests without an Origin header.+ > --control-cors-ignore-failure+ > Requires build with -f+control.+ > If enabled, the control server will accept malformed CORS preflight requests. > > Debug Options- > --my-eventlog-socket-unix FILE Open an eventlog socket for this program on the given Unix socket.- > --my-ghc-debug-socket Open the default ghc-debug socket for this program.- > --my-ghc-debug-socket-unix FILE Open a ghc-debug Unix domain socket with the given file path.- > --my-ghc-debug-socket-tcp ADDRESS Open a ghc-debug TCP/IP socket with the given address as 'host:port'.+ > --my-eventlog-socket-unix Requires build with -f+use-eventlog-socket.+ > Open an eventlog socket for this program on the given Unix socket.+ > --my-ghc-debug-socket Requires build with -f+use-ghc-debug-stub.+ > Open the default ghc-debug socket for this program.+ > --my-ghc-debug-socket-unix Requires build with -f+use-ghc-debug-stub.+ > Open a ghc-debug Unix domain socket with the given file path.+ > --my-ghc-debug-socket-tcp Requires build with -f+use-ghc-debug-stub.+ > Open a ghc-debug TCP/IP socket with the given address as 'host:port'. license: BSD-3-Clause license-file: LICENSE@@ -100,7 +105,7 @@ type: git location: https://github.com/well-typed/eventlog-live.git subdir: eventlog-live-otelcol- tag: eventlog-live-otelcol-0.6.0.0+ tag: eventlog-live-otelcol-0.6.1.0 -- This flag enables the control command server, which is an HTTP endpoint -- that gets started by eventlog-live-otelcol. If +control is set, then@@ -200,7 +205,8 @@ GHC.Eventlog.Live.Otelcol.Processor.Common.Core GHC.Eventlog.Live.Otelcol.Processor.Common.Logs GHC.Eventlog.Live.Otelcol.Processor.Common.Metrics- GHC.Eventlog.Live.Otelcol.Processor.Common.Profiles+ GHC.Eventlog.Live.Otelcol.Processor.Common.ProfilesDictionary+ GHC.Eventlog.Live.Otelcol.Processor.Common.SymbolTable GHC.Eventlog.Live.Otelcol.Processor.Common.Traces GHC.Eventlog.Live.Otelcol.Processor.Heap GHC.Eventlog.Live.Otelcol.Processor.Logs
src/GHC/Eventlog/Live/Otelcol.hs view
@@ -43,7 +43,7 @@ import GHC.Eventlog.Live.Otelcol.Processor.Common.Core import GHC.Eventlog.Live.Otelcol.Processor.Common.Logs (ToLogRecord (..), toExportLogsServiceRequest, toResourceLogs, toScopeLogs) import GHC.Eventlog.Live.Otelcol.Processor.Common.Metrics (toExportMetricsServiceRequest, toResourceMetrics, toScopeMetrics)-import GHC.Eventlog.Live.Otelcol.Processor.Common.Profiles (toExportProfileServiceRequest)+import GHC.Eventlog.Live.Otelcol.Processor.Common.ProfilesDictionary (toExportProfileServiceRequest) import GHC.Eventlog.Live.Otelcol.Processor.Common.Traces (toExportTracesServiceRequest, toResourceSpans, toScopeSpans) import GHC.Eventlog.Live.Otelcol.Processor.Heap (processHeapEvents) import GHC.Eventlog.Live.Otelcol.Processor.Logs (processLogEvents)
src/GHC/Eventlog/Live/Otelcol/Control.hs view
@@ -356,7 +356,7 @@ , errHeaders = [] } -- If the service telemetry is streamed from a socket, continue.- Just (EventlogSourceHandleSocketUnix s) -> action s+ Just (EventlogSourceHandleSocket s) -> action s -------------------------------------------------------------------------------- -- Control API
− src/GHC/Eventlog/Live/Otelcol/Processor/Common/Profiles.hs
@@ -1,207 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--{- |-Module : GHC.Eventlog.Live.Otelcol.Processor.Common.Profiles-Description : Abstraction over ProfilesDictionary for the OTLP protocol.-Stability : experimental-Portability : portable--}-module GHC.Eventlog.Live.Otelcol.Processor.Common.Profiles (- toExportProfileServiceRequest,-- -- * Dictionary for deduplication logic of common values- ProfileDictionary,- emptyProfileDictionary,-- -- * Turn a 'ProfileDictionary' into a 'OP.ProfilesDictionary'- toProfilesDictionary,-- -- * Retrieve the 'SymbolIndex' for various 'OP.ProfilesData' fields- SymbolIndex,- getLocation,- getFunction,- getString,- getMapping,- getLink,- getAttribute,- getStack,-)-where--import Control.Monad.Trans.State.Strict (StateT)-import Control.Monad.Trans.State.Strict qualified as State-import Data.Int (Int32)-import Data.Map.Strict (Map)-import Data.Map.Strict qualified as Map-import Data.ProtoLens (Message (..))-import Data.Text (Text)-import GHC.Eventlog.Live.Otelcol.Processor.Common.Core (messageWith)-import GHC.Generics (Generic)-import Lens.Family2 (Lens', (&), (.~), (^.))-import Lens.Family2.Unchecked (lens)-import Proto.Opentelemetry.Proto.Collector.Profiles.V1development.ProfilesService qualified as OPS-import Proto.Opentelemetry.Proto.Collector.Profiles.V1development.ProfilesService_Fields qualified as OPS-import Proto.Opentelemetry.Proto.Profiles.V1development.Profiles qualified as OP-import Proto.Opentelemetry.Proto.Profiles.V1development.Profiles_Fields qualified as OP--toExportProfileServiceRequest :: OP.ProfilesData -> OPS.ExportProfilesServiceRequest-toExportProfileServiceRequest profilesData =- messageWith- [ OPS.resourceProfiles .~ profilesData ^. OPS.resourceProfiles- , OPS.dictionary .~ profilesData ^. OPS.dictionary- ]--type SymbolIndex = Int32--data ProfileDictionary = ProfileDictionary- { locationTable :: CommonSymbolTable OP.Location- -- ^ Common 'OP.Location' table, first entry is the 'defMessage'.- -- This holds for OTLP 1.9.0.- , functionTable :: CommonSymbolTable OP.Function- -- ^ Common 'OP.Function' table, first entry is the 'defMessage'.- -- This holds for OTLP 1.9.0.- , stringTable :: CommonSymbolTable Text- -- ^ Common string table, the first entry must be "" per the protobuf- -- documentation.- --- -- @- -- // A common table for strings referenced by various messages.- -- // string_table[0] must always be "".- -- repeated string string_table = 5;- -- @- , mappingTable :: CommonSymbolTable OP.Mapping- -- ^ Common 'OP.Mapping' table, first entry is the 'defMessage'.- -- This holds for OTLP 1.9.0.- , linkTable :: CommonSymbolTable OP.Link- -- ^ Common 'OP.Link' table, first entry is the 'defMessage'.- -- This holds for OTLP 1.9.0.- , attributeTable :: CommonSymbolTable OP.KeyValueAndUnit- -- ^ Common 'OP.KeyValueAndUnit' table, first entry is the 'defMessage'.- -- This holds for OTLP 1.9.0.- , stackTable :: CommonSymbolTable OP.Stack- -- ^ Common 'OP.Stack' table, first entry is the 'defMessage'.- -- This holds for OTLP 1.9.0.- }- deriving (Show, Ord, Eq, Generic)--toProfilesDictionary :: ProfileDictionary -> OP.ProfilesDictionary-toProfilesDictionary st =- messageWith- [ OP.locationTable .~ locationTableList st- , OP.functionTable .~ functionTableList st- , OP.stringTable .~ stringTableList st- , OP.mappingTable .~ mappingTableList st- , OP.linkTable .~ linkTableList st- , OP.attributeTable .~ attributeTableList st- , OP.stackTable .~ stackTableList st- ]--emptyProfileDictionary :: ProfileDictionary-emptyProfileDictionary =- ProfileDictionary- { locationTable = commonSymbolTableFromList [defMessage]- , functionTable = commonSymbolTableFromList [defMessage]- , stringTable = commonSymbolTableFromList [""]- , mappingTable = commonSymbolTableFromList [defMessage]- , linkTable = commonSymbolTableFromList [defMessage]- , attributeTable = commonSymbolTableFromList [defMessage]- , stackTable = commonSymbolTableFromList [defMessage]- }--locationTableList :: ProfileDictionary -> [OP.Location]-locationTableList st = reverse st.locationTable.contents--functionTableList :: ProfileDictionary -> [OP.Function]-functionTableList st = reverse st.functionTable.contents--stringTableList :: ProfileDictionary -> [Text]-stringTableList st = reverse st.stringTable.contents--mappingTableList :: ProfileDictionary -> [OP.Mapping]-mappingTableList st = reverse st.mappingTable.contents--linkTableList :: ProfileDictionary -> [OP.Link]-linkTableList st = reverse st.linkTable.contents--attributeTableList :: ProfileDictionary -> [OP.KeyValueAndUnit]-attributeTableList st = reverse st.attributeTable.contents--stackTableList :: ProfileDictionary -> [OP.Stack]-stackTableList st = reverse st.stackTable.contents--getSymbolIndexFor :: (Ord a, Monad m) => Lens' ProfileDictionary (CommonSymbolTable a) -> a -> StateT ProfileDictionary m SymbolIndex-getSymbolIndexFor accessor a = do- tbl <- State.gets (^. accessor)- let (idx, tbl1) = insertCommonSymbolTable a tbl- State.modify' (\st -> st & accessor .~ tbl1)- pure idx--getLocation :: (Monad m) => OP.Location -> StateT ProfileDictionary m SymbolIndex-getLocation = getSymbolIndexFor (lens (.locationTable) (\s v -> s{locationTable = v}))--getFunction :: (Monad m) => OP.Function -> StateT ProfileDictionary m SymbolIndex-getFunction = getSymbolIndexFor (lens (.functionTable) (\s v -> s{functionTable = v}))--getString :: (Monad m) => Text -> StateT ProfileDictionary m SymbolIndex-getString = getSymbolIndexFor (lens (.stringTable) (\s v -> s{stringTable = v}))--getMapping :: (Monad m) => OP.Mapping -> StateT ProfileDictionary m SymbolIndex-getMapping = getSymbolIndexFor (lens (.mappingTable) (\s v -> s{mappingTable = v}))--getLink :: (Monad m) => OP.Link -> StateT ProfileDictionary m SymbolIndex-getLink = getSymbolIndexFor (lens (.linkTable) (\s v -> s{linkTable = v}))--getAttribute :: (Monad m) => OP.KeyValueAndUnit -> StateT ProfileDictionary m SymbolIndex-getAttribute = getSymbolIndexFor (lens (.attributeTable) (\s v -> s{attributeTable = v}))--getStack :: (Monad m) => OP.Stack -> StateT ProfileDictionary m SymbolIndex-getStack = getSymbolIndexFor (lens (.stackTable) (\s v -> s{stackTable = v}))------------------------------------------------------------------------------------ Common Symbol Table implementation--- TODO: share with `ghc-stack-profiler-core` table?--data CommonSymbolTable a- = CommonSymbolTable- { counter :: !SymbolIndex- , table :: Map a SymbolIndex- , contents :: ![a]- }- deriving (Show, Ord, Eq, Generic)--emptyCommonSymbolTable :: CommonSymbolTable a-emptyCommonSymbolTable =- CommonSymbolTable- { counter = 0- , table = Map.empty- , contents = []- }--commonSymbolTableFromList :: (Ord a) => [a] -> CommonSymbolTable a-commonSymbolTableFromList = foldr go emptyCommonSymbolTable- where- go val tbl0 =- let (_, tbl1) = insertCommonSymbolTable val tbl0- in tbl1--nextCounter :: CommonSymbolTable a -> (SymbolIndex, CommonSymbolTable a)-nextCounter tbl = (tbl.counter, tbl{counter = tbl.counter + 1})--insertCommonSymbolTable :: (Ord a) => a -> CommonSymbolTable a -> (SymbolIndex, CommonSymbolTable a)-insertCommonSymbolTable val tbl =- let updateEntry tbl0 Nothing =- let (sid, newTbl) = nextCounter tbl0- in ((sid, True, newTbl), Just sid)- updateEntry newTbl (Just old) =- ((old, False, newTbl), Just old)-- ((idx, newEntry, tbl1), newTable) = Map.alterF (updateEntry tbl) val tbl.table- in ( idx- , tbl1- { table = newTable- , contents =- if newEntry- then val : tbl1.contents- else tbl1.contents- }- )
+ src/GHC/Eventlog/Live/Otelcol/Processor/Common/ProfilesDictionary.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : GHC.Eventlog.Live.Otelcol.Processor.Common.Profiles+Description : Abstraction over ProfilesDictionary for the OTLP protocol.+Stability : experimental+Portability : portable+-}+module GHC.Eventlog.Live.Otelcol.Processor.Common.ProfilesDictionary (+ -- * Dictionary for deduplication logic of common values+ ProfilesDictionary,+ empty,++ -- * Retrieve the 'SymbolIndex' for various 'OP.ProfilesData' fields+ SymbolIndex,+ getLocation,+ getFunction,+ getString,+ getMapping,+ getLink,+ getAttribute,+ getStack,++ -- * Convert data to the formats used by @hs-opentelemetry-otlp@.+ toExportProfileServiceRequest,+ toProfilesDictionary,+)+where++import Control.Monad.Trans.State.Strict (StateT)+import Control.Monad.Trans.State.Strict qualified as State+import Data.ProtoLens (Message (..))+import Data.Text (Text)+import GHC.Eventlog.Live.Otelcol.Processor.Common.Core (messageWith)+import GHC.Eventlog.Live.Otelcol.Processor.Common.SymbolTable (SymbolIndex, SymbolTable)+import GHC.Eventlog.Live.Otelcol.Processor.Common.SymbolTable qualified as ST+import GHC.Generics (Generic)+import Lens.Family2 (Lens', (.~), (^.))+import Lens.Family2.Unchecked (lens)+import Proto.Opentelemetry.Proto.Collector.Profiles.V1development.ProfilesService qualified as OPS+import Proto.Opentelemetry.Proto.Collector.Profiles.V1development.ProfilesService_Fields qualified as OPS+import Proto.Opentelemetry.Proto.Profiles.V1development.Profiles qualified as OP+import Proto.Opentelemetry.Proto.Profiles.V1development.Profiles_Fields qualified as OP++toExportProfileServiceRequest :: OP.ProfilesData -> OPS.ExportProfilesServiceRequest+toExportProfileServiceRequest profilesData =+ messageWith+ [ OPS.resourceProfiles .~ profilesData ^. OPS.resourceProfiles+ , OPS.dictionary .~ profilesData ^. OPS.dictionary+ ]++data ProfilesDictionary = ProfilesDictionary+ { locationTable :: SymbolTable OP.Location+ {- ^ Common 'OP.Location' table, first entry is the 'defMessage'.+ This holds for OTLP 1.9.0.+ -}+ , functionTable :: SymbolTable OP.Function+ {- ^ Common 'OP.Function' table, first entry is the 'defMessage'.+ This holds for OTLP 1.9.0.+ -}+ , stringTable :: SymbolTable Text+ {- ^ Common string table, the first entry must be "" per the protobuf+ documentation.++ @+ // A common table for strings referenced by various messages.+ // string_table[0] must always be "".+ repeated string string_table = 5;+ @+ -}+ , mappingTable :: SymbolTable OP.Mapping+ {- ^ Common 'OP.Mapping' table, first entry is the 'defMessage'.+ This holds for OTLP 1.9.0.+ -}+ , linkTable :: SymbolTable OP.Link+ {- ^ Common 'OP.Link' table, first entry is the 'defMessage'.+ This holds for OTLP 1.9.0.+ -}+ , attributeTable :: SymbolTable OP.KeyValueAndUnit+ {- ^ Common 'OP.KeyValueAndUnit' table, first entry is the 'defMessage'.+ This holds for OTLP 1.9.0.+ -}+ , stackTable :: SymbolTable OP.Stack+ {- ^ Common 'OP.Stack' table, first entry is the 'defMessage'.+ This holds for OTLP 1.9.0.+ -}+ }+ deriving (Show, Ord, Eq, Generic)++toProfilesDictionary :: ProfilesDictionary -> OP.ProfilesDictionary+toProfilesDictionary st =+ messageWith+ [ OP.locationTable .~ locations st+ , OP.functionTable .~ functions st+ , OP.stringTable .~ strings st+ , OP.mappingTable .~ mappings st+ , OP.linkTable .~ links st+ , OP.attributeTable .~ attributes st+ , OP.stackTable .~ stacks st+ ]++empty :: ProfilesDictionary+empty =+ ProfilesDictionary+ { locationTable = ST.fromList [defMessage]+ , functionTable = ST.fromList [defMessage]+ , stringTable = ST.fromList [""]+ , mappingTable = ST.fromList [defMessage]+ , linkTable = ST.fromList [defMessage]+ , attributeTable = ST.fromList [defMessage]+ , stackTable = ST.fromList [defMessage]+ }++locations :: ProfilesDictionary -> [OP.Location]+locations pd = ST.toList pd.locationTable++functions :: ProfilesDictionary -> [OP.Function]+functions pd = ST.toList pd.functionTable++strings :: ProfilesDictionary -> [Text]+strings pd = ST.toList pd.stringTable++mappings :: ProfilesDictionary -> [OP.Mapping]+mappings pd = ST.toList pd.mappingTable++links :: ProfilesDictionary -> [OP.Link]+links pd = ST.toList pd.linkTable++attributes :: ProfilesDictionary -> [OP.KeyValueAndUnit]+attributes pd = ST.toList pd.attributeTable++stacks :: ProfilesDictionary -> [OP.Stack]+stacks pd = ST.toList pd.stackTable++getSymbolIndexFor :: (Ord a, Monad m) => Lens' ProfilesDictionary (SymbolTable a) -> a -> StateT ProfilesDictionary m SymbolIndex+getSymbolIndexFor accessor a = do+ st <- State.gets (^. accessor)+ let (si, pd') = ST.insert a st+ State.modify' (accessor .~ pd')+ pure si++getLocation :: (Monad m) => OP.Location -> StateT ProfilesDictionary m SymbolIndex+getLocation = getSymbolIndexFor (lens (.locationTable) (\pd st -> pd{locationTable = st}))++getFunction :: (Monad m) => OP.Function -> StateT ProfilesDictionary m SymbolIndex+getFunction = getSymbolIndexFor (lens (.functionTable) (\pd st -> pd{functionTable = st}))++getString :: (Monad m) => Text -> StateT ProfilesDictionary m SymbolIndex+getString = getSymbolIndexFor (lens (.stringTable) (\pd st -> pd{stringTable = st}))++getMapping :: (Monad m) => OP.Mapping -> StateT ProfilesDictionary m SymbolIndex+getMapping = getSymbolIndexFor (lens (.mappingTable) (\pd st -> pd{mappingTable = st}))++getLink :: (Monad m) => OP.Link -> StateT ProfilesDictionary m SymbolIndex+getLink = getSymbolIndexFor (lens (.linkTable) (\pd st -> pd{linkTable = st}))++getAttribute :: (Monad m) => OP.KeyValueAndUnit -> StateT ProfilesDictionary m SymbolIndex+getAttribute = getSymbolIndexFor (lens (.attributeTable) (\pd st -> pd{attributeTable = st}))++getStack :: (Monad m) => OP.Stack -> StateT ProfilesDictionary m SymbolIndex+getStack = getSymbolIndexFor (lens (.stackTable) (\pd st -> pd{stackTable = st}))
+ src/GHC/Eventlog/Live/Otelcol/Processor/Common/SymbolTable.hs view
@@ -0,0 +1,76 @@+{- |+Module : GHC.Eventlog.Live.Otelcol.Processor.Common.SymbolTable+Description : Abstract symbol table datatype.+Stability : experimental+Portability : portable+-}+module GHC.Eventlog.Live.Otelcol.Processor.Common.SymbolTable (+ SymbolIndex,+ SymbolTable,+ empty,+ elemIndex,+ toList,+ fromList,+ insert,+)+where++import Data.Int (Int32)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import GHC.Generics (Generic)++type SymbolIndex = Int32++data SymbolTable a+ = SymbolTable+ { nextSymbolIndex :: !SymbolIndex+ {- ^+ The next unused `SymbolIndex`.++ > st.nextSymbolIndex == length st.entriesReversed+ -}+ , entryToSymbolIndex :: !(Map a SymbolIndex)+ {- ^+ A map from entries to their `SymbolIndex`.++ > toList st !! (st.entryToSymbolIndex Map.! a) == a+ -}+ , entriesReversed :: ![a] -- reverse order of insertion into entryToSymbolIndex++ {- ^+ A list of entries in the `SymbolTable` in reverse order.+ -}+ }+ deriving (Show, Ord, Eq, Generic)++empty :: SymbolTable a+empty =+ SymbolTable+ { nextSymbolIndex = 0+ , entryToSymbolIndex = Map.empty+ , entriesReversed = []+ }++elemIndex :: (Ord a) => a -> SymbolTable a -> Maybe SymbolIndex+elemIndex a st = Map.lookup a st.entryToSymbolIndex++toList :: SymbolTable a -> [a]+toList st = reverse st.entriesReversed++fromList :: (Ord a) => [a] -> SymbolTable a+fromList = foldr (\val st -> snd (insert val st)) empty++insert :: (Ord a) => a -> SymbolTable a -> (SymbolIndex, SymbolTable a)+insert a st = (si, st'')+ where+ ((si, isNew, st'), entryToSymbolIndex') = Map.alterF (updateEntry st) a st.entryToSymbolIndex+ entriesReversed' = if isNew then a : st'.entriesReversed else st'.entriesReversed+ st'' = st'{entryToSymbolIndex = entryToSymbolIndex', entriesReversed = entriesReversed'}++updateEntry :: SymbolTable a -> Maybe SymbolIndex -> ((SymbolIndex, Bool, SymbolTable a), Maybe SymbolIndex)+updateEntry st Nothing = let (si, st') = freshSymbolIndex st in ((si, True, st'), Just si)+updateEntry st (Just si) = ((si, False, st), Just si)++freshSymbolIndex :: SymbolTable a -> (SymbolIndex, SymbolTable a)+freshSymbolIndex st = (st.nextSymbolIndex, st{nextSymbolIndex = st.nextSymbolIndex + 1})
src/GHC/Eventlog/Live/Otelcol/Processor/Profiles.hs view
@@ -28,8 +28,8 @@ import GHC.Eventlog.Live.Otelcol.Config qualified as C import GHC.Eventlog.Live.Otelcol.Config.Types (FullConfig (..)) import GHC.Eventlog.Live.Otelcol.Processor.Common.Core-import GHC.Eventlog.Live.Otelcol.Processor.Common.Profiles (ProfileDictionary, SymbolIndex)-import GHC.Eventlog.Live.Otelcol.Processor.Common.Profiles qualified as ProfDictionary+import GHC.Eventlog.Live.Otelcol.Processor.Common.ProfilesDictionary (ProfilesDictionary, SymbolIndex)+import GHC.Eventlog.Live.Otelcol.Processor.Common.ProfilesDictionary qualified as PD import GHC.RTS.Events (Event (..)) import GHC.Stack.Profiler.Core.SourceLocation qualified as Profiler import Lens.Family2 ((.~))@@ -102,13 +102,13 @@ , OP.resource .~ resource ] - profilesDictionary = ProfDictionary.toProfilesDictionary st+ profilesDictionary = PD.toProfilesDictionary st - (profile, st) = flip runState ProfDictionary.emptyProfileDictionary $ do- sampleNameStrId <- ProfDictionary.getString "__name__"- sampleTypeStrId <- ProfDictionary.getString "String"+ (profile, st) = flip runState PD.empty $ do+ sampleNameStrId <- PD.getString "__name__"+ sampleTypeStrId <- PD.getString "String" sampleAttrId <-- ProfDictionary.getAttribute $+ PD.getAttribute $ messageWith @OP.KeyValueAndUnit [ OP.keyStrindex .~ sampleNameStrId , OP.unitStrindex .~ sampleTypeStrId@@ -116,8 +116,8 @@ ] samples <- traverse (asSample sampleAttrId) callstacks- cpuId <- ProfDictionary.getString "stack"- unitId <- ProfDictionary.getString "samples"+ cpuId <- PD.getString "stack"+ unitId <- PD.getString "samples" let sampleType :: OP.ValueType sampleType = messageWith@@ -131,21 +131,21 @@ , OP.sampleType .~ sampleType ] -asSample :: SymbolIndex -> M.CallStackData -> State ProfileDictionary OP.Sample+asSample :: SymbolIndex -> M.CallStackData -> State ProfilesDictionary OP.Sample asSample six stackData = do locIndices <- traverse toIndex stackData.stack s <-- ProfDictionary.getStack $+ PD.getStack $ messageWith [ OP.locationIndices .~ locIndices ] - sampleThreadKeyStrId <- ProfDictionary.getString "thread"- sampleCapKeyStrId <- ProfDictionary.getString "capability"- sampleNumberUnitStrId <- ProfDictionary.getString "Number"+ sampleThreadKeyStrId <- PD.getString "thread"+ sampleCapKeyStrId <- PD.getString "capability"+ sampleNumberUnitStrId <- PD.getString "Number" threadAttrId <-- ProfDictionary.getAttribute $+ PD.getAttribute $ messageWith @OP.KeyValueAndUnit [ OP.keyStrindex .~ sampleThreadKeyStrId , OP.unitStrindex .~ sampleNumberUnitStrId@@ -153,7 +153,7 @@ ] capAttrId <-- ProfDictionary.getAttribute $+ PD.getAttribute $ messageWith @OP.KeyValueAndUnit [ OP.keyStrindex .~ sampleCapKeyStrId , OP.unitStrindex .~ sampleNumberUnitStrId@@ -171,19 +171,19 @@ ] ] where- toIndex :: M.StackItemData -> State ProfileDictionary SymbolIndex+ toIndex :: M.StackItemData -> State ProfilesDictionary SymbolIndex toIndex = \case- M.IpeData infoTable -> getLocationIndexForInfoTable infoTable+ M.IpeData infoProv -> getLocationIndexForInfoTable infoProv M.UserMessageData message -> getLocationIndexForText message M.SourceLocationData srcLoc -> getLocationIndexForSourceLocation srcLoc M.CostCentreData costCentre -> getLocationIndexForCostCentre costCentre -getLocationIndexForSourceLocation :: Profiler.SourceLocation -> State ProfileDictionary SymbolIndex+getLocationIndexForSourceLocation :: Profiler.SourceLocation -> State ProfilesDictionary SymbolIndex getLocationIndexForSourceLocation srcLoc = do- functionNameId <- ProfDictionary.getString $ Profiler.functionName srcLoc- fileNameId <- ProfDictionary.getString $ Profiler.fileName srcLoc+ functionNameId <- PD.getString $ Profiler.functionName srcLoc+ fileNameId <- PD.getString $ Profiler.fileName srcLoc funcIdx <-- ProfDictionary.getFunction $+ PD.getFunction $ messageWith [ OP.nameStrindex .~ functionNameId , OP.systemNameStrindex .~ 0 -- 0 means unset@@ -199,17 +199,17 @@ , OP.column .~ fromIntegral (Profiler.column srcLoc) ] - ProfDictionary.getLocation $+ PD.getLocation $ messageWith [ OP.lines .~ [line] , OP.mappingIndex .~ 0 -- 0 means unset ] -getLocationIndexForText :: Text -> State ProfileDictionary SymbolIndex+getLocationIndexForText :: Text -> State ProfilesDictionary SymbolIndex getLocationIndexForText msg = do- textId <- ProfDictionary.getString msg+ textId <- PD.getString msg funcIdx <-- ProfDictionary.getFunction $+ PD.getFunction $ messageWith [ OP.nameStrindex .~ textId , OP.systemNameStrindex .~ 0 -- 0 means unset@@ -225,28 +225,28 @@ , OP.column .~ 0 -- 0 means unset ] - ProfDictionary.getLocation $+ PD.getLocation $ messageWith [ OP.lines .~ [line] ] -getLocationIndexForInfoTable :: M.InfoTable -> State ProfileDictionary SymbolIndex-getLocationIndexForInfoTable infoTable = do- infoTableNameId <- ProfDictionary.getString infoTable.infoTableName+getLocationIndexForInfoTable :: M.InfoProv -> State ProfilesDictionary SymbolIndex+getLocationIndexForInfoTable infoProv = do+ ipNameId <- PD.getString infoProv.ipName let label =- if (infoTable.infoTableLabel) == ""- then infoTable.infoTableModule <> ":" <> infoTable.infoTableName- else infoTable.infoTableModule <> ":" <> infoTable.infoTableLabel- infoTableFuncNameId <- ProfDictionary.getString label- -- tyDesc <- getText infoTable.infoTableTyDesc+ if (infoProv.ipLabel) == ""+ then infoProv.ipModule <> ":" <> infoProv.ipName+ else infoProv.ipModule <> ":" <> infoProv.ipLabel+ infoProvFuncNameId <- PD.getString label+ -- tyDesc <- getText infoProv.infoProvTyDesc --- infoTableSrcLocId <- ProfDictionary.getString infoTable.infoTableSrcLoc+ ipSrcLocId <- PD.getString infoProv.ipSrcLoc funcIdx <-- ProfDictionary.getFunction $+ PD.getFunction $ messageWith- [ OP.nameStrindex .~ infoTableFuncNameId- , OP.systemNameStrindex .~ infoTableNameId- , OP.filenameStrindex .~ infoTableSrcLocId -- 0 means unset+ [ OP.nameStrindex .~ infoProvFuncNameId+ , OP.systemNameStrindex .~ ipNameId+ , OP.filenameStrindex .~ ipSrcLocId -- 0 means unset , OP.startLine .~ 0 -- 0 means unset ] @@ -258,21 +258,21 @@ , OP.column .~ 0 -- 0 means unset ] - ProfDictionary.getLocation $+ PD.getLocation $ messageWith [ OP.lines .~ [line] , OP.address .~ 0 -- 0 means unset ] -getLocationIndexForCostCentre :: M.CostCentre -> State ProfileDictionary SymbolIndex+getLocationIndexForCostCentre :: M.CostCentre -> State ProfilesDictionary SymbolIndex getLocationIndexForCostCentre costCentre = do let label = costCentre.costCentreModule <> ":" <> costCentre.costCentreLabel- costCentreFuncNameId <- ProfDictionary.getString label- -- tyDesc <- getText infoTable.infoTableTyDesc+ costCentreFuncNameId <- PD.getString label+ -- tyDesc <- getText infoProv.infoProvTyDesc --- costCentreSrcLocId <- ProfDictionary.getString costCentre.costCentreSrcLoc+ costCentreSrcLocId <- PD.getString costCentre.costCentreSrcLoc funcIdx <-- ProfDictionary.getFunction $+ PD.getFunction $ messageWith [ OP.nameStrindex .~ costCentreFuncNameId , OP.systemNameStrindex .~ costCentreFuncNameId@@ -288,7 +288,7 @@ , OP.column .~ 0 -- 0 means unset ] - ProfDictionary.getLocation $+ PD.getLocation $ messageWith [ OP.lines .~ [line] , OP.address .~ 0 -- 0 means unset