eventlog-live 0.3.0.0 → 0.4.0.0

raw patch · 10 files changed

+336/−66 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• eventlog-live.cabal +5/−1
• src/GHC/Eventlog/Live/Data/Attribute.hs +31/−1
• src/GHC/Eventlog/Live/Data/Group.hs +82/−0
• src/GHC/Eventlog/Live/Data/Metric.hs +21/−3
• src/GHC/Eventlog/Live/Logger.hs +5/−1
• src/GHC/Eventlog/Live/Machine/Analysis/Capability.hs +3/−2
• src/GHC/Eventlog/Live/Machine/Analysis/Heap.hs +140/−48
• src/GHC/Eventlog/Live/Machine/Core.hs +25/−9
• src/GHC/Eventlog/Live/Options.hs +13/−1

@@ -1,3 +1,14 @@+### 0.4.0.0++- Add parser for `--stats` flag (`statsParser`).+- Add support for aggregation:+  - Add `aggregateByTick`.+  - Add `GHC.Eventlog.Live.Machine.Group` module for aggregation.+- **BREAKING**: Change `processHeapProfSampleData` to yield all the metrics+  from a single garbage collection pass at once as `HeapProfSampleData`.+- **BREAKING**: Replace `[Attr]` with opaque `Attrs` type.+- **BREAKING**: Log info to stderr with `--verbosity==debug`.+ ### 0.3.0.0  - **BREAKING**: Move capability usage analysis machines to their own module.

@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            eventlog-live-version:         0.3.0.0+version:         0.4.0.0 synopsis:        Live processing of eventlog data. description:   This package supports live processing of eventlog data.@@ -64,11 +64,13 @@     DataKinds     DeriveFoldable     DeriveFunctor+    DeriveGeneric     DeriveTraversable     DerivingStrategies     DuplicateRecordFields     FlexibleContexts     FlexibleInstances+    FunctionalDependencies     GADTs     GeneralizedNewtypeDeriving     ImportQualifiedPost@@ -83,6 +85,7 @@     RankNTypes     RecordWildCards     ScopedTypeVariables+    StandaloneDeriving     TupleSections     TypeApplications     TypeFamilies@@ -92,6 +95,7 @@   hs-source-dirs:  src   exposed-modules:     GHC.Eventlog.Live.Data.Attribute+    GHC.Eventlog.Live.Data.Group     GHC.Eventlog.Live.Data.Metric     GHC.Eventlog.Live.Data.Span     GHC.Eventlog.Live.Logger

@@ -5,6 +5,8 @@ Portability : portable -} module GHC.Eventlog.Live.Data.Attribute (+  Attrs,+  toList,   Attr,   AttrKey,   AttrValue (..),@@ -12,12 +14,38 @@   (~=), ) where +import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as M+import Data.Hashable (Hashable) import Data.Int (Int16, Int32, Int64, Int8) import Data.Text (Text) import Data.Text qualified as T import Data.Word (Word16, Word32, Word64, Word8)+import GHC.Generics (Generic)+import GHC.IsList (IsList (..))  {- |+A set of attributes is a t`HashMap`+-}+newtype Attrs = Attrs {attrMap :: HashMap AttrKey AttrValue}+  deriving (Eq, Generic, Show)++instance Hashable Attrs++instance Semigroup Attrs where+  (<>) :: Attrs -> Attrs -> Attrs+  x <> y = Attrs{attrMap = x.attrMap <> y.attrMap}++instance IsList Attrs where+  type Item Attrs = Attr++  fromList :: [Item Attrs] -> Attrs+  fromList = Attrs . M.fromList++  toList :: Attrs -> [Item Attrs]+  toList = M.toList . (.attrMap)++{- | An attribute is a key-value pair where the key is any string and the value is some numeric type, string, or null. Attributes should be constructed using the `(~=)` operator, which automatically converts Haskell types to t`AttrValue`.@@ -58,7 +86,9 @@   | AttrDouble !Double   | AttrText !Text   | AttrNull-  deriving (Show)+  deriving (Eq, Generic, Show)++instance Hashable AttrValue  {- | Utility class to help construct values of the t`AttrValue` type.

@@ -0,0 +1,82 @@+{- |+Module      : GHC.Eventlog.Live.Data.Group+Description : Core machines for processing data in batches.+Stability   : experimental+Portability : portable+-}+module GHC.Eventlog.Live.Data.Group (+  -- * GroupBy+  GroupBy (..),+  Group (..),+  GroupedBy,+  singleton,+  elems,+  groups,+) where++import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as M+import Data.Hashable (Hashable (..))+import Data.Kind (Type)+import Data.Semigroup (First (..), Last (..), Max (..), Min (..), Product (..), Sum (..))++{- |+This class defines the key to group by when aggregating.+-}+class (Hashable (Key a)) => GroupBy a where+  type Key a :: Type+  toKey :: a -> Key a++deriving newtype instance (GroupBy a) => GroupBy (First a)+deriving newtype instance (GroupBy a) => GroupBy (Last a)+deriving newtype instance (GroupBy a) => GroupBy (Max a)+deriving newtype instance (GroupBy a) => GroupBy (Min a)+deriving newtype instance (GroupBy a) => GroupBy (Product a)+deriving newtype instance (GroupBy a) => GroupBy (Sum a)++{- |+This type defines a set of groups, grouped by the key given by `GroupBy`.+-}+data GroupedBy a = (GroupBy a) => GroupedBy+  { groups :: HashMap (Key a) (Group a)+  }++{- |+Internal helper.+This type defines a group representative and the group size.+-}+data Group a = Group+  { representative :: !a+  , size :: !Word+  }+  deriving (Show, Functor, Foldable, Traversable)++{- |+Construct the singleton `GroupedBy`.+-}+singleton :: (GroupBy a) => a -> GroupedBy a+singleton a = GroupedBy{groups = M.singleton (toKey a) Group{representative = a, size = 1}}++{- |+Get all group representatives from a `GroupedBy`.+-}+elems :: GroupedBy a -> [a]+elems = fmap (.representative) . groups++{- |+Get all group representatives and sizes from a `GroupedBy`.+-}+groups :: GroupedBy a -> [Group a]+groups = M.elems . (.groups)++instance (Semigroup a) => Semigroup (Group a) where+  (<>) :: Group a -> Group a -> Group a+  x <> y =+    Group+      { representative = x.representative <> y.representative+      , size = x.size + y.size+      }++instance (Semigroup a, GroupBy a) => Semigroup (GroupedBy a) where+  (<>) :: GroupedBy a -> GroupedBy a -> GroupedBy a+  x <> y = GroupedBy{groups = M.unionWith (<>) x.groups y.groups}

@@ -8,7 +8,9 @@   Metric (..), ) where -import GHC.Eventlog.Live.Data.Attribute (Attr)+import Control.Exception (assert)+import GHC.Eventlog.Live.Data.Attribute (Attrs)+import GHC.Eventlog.Live.Data.Group (GroupBy (..)) import GHC.RTS.Events (Timestamp)  {- |@@ -24,7 +26,23 @@   , maybeStartTimeUnixNano :: !(Maybe Timestamp)   -- ^ The earliest time at which any measurement could have been taken.   --   Usually, this represents the start time of a process.-  , attr :: [Attr]-  -- ^ A list of attributes.+  , attrs :: Attrs+  -- ^ A set of attributes.   }   deriving (Functor, Show)++instance GroupBy (Metric a) where+  type Key (Metric a) = Attrs+  toKey :: Metric a -> Attrs+  toKey = (.attrs)++instance (Semigroup a) => Semigroup (Metric a) where+  (<>) :: Metric a -> Metric a -> Metric a+  x <> y =+    assert (x.attrs == y.attrs) $+      Metric+        { value = x.value <> y.value+        , maybeTimeUnixNano = x.maybeTimeUnixNano `max` y.maybeTimeUnixNano+        , maybeStartTimeUnixNano = x.maybeStartTimeUnixNano `min` y.maybeStartTimeUnixNano+        , attrs = x.attrs+        }

@@ -104,7 +104,11 @@ Log info messages to `IO.stderr`. -} logInfo :: (HasCallStack, MonadIO m) => Verbosity -> Text -> m ()-logInfo = logMessage IO.stdout callStack verbosityInfo+logInfo verbosityThreshold = logMessage handle callStack verbosityInfo verbosityThreshold+ where+  handle+    | verbosityThreshold <= verbosityDebug = IO.stderr+    | otherwise = IO.stdout  {- | Log debug messages to `IO.stderr`.

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} @@ -92,7 +93,7 @@                 { value = j.value.startTimeUnixNano - i.endTimeUnixNano                 , maybeTimeUnixNano = Just i.endTimeUnixNano                 , maybeStartTimeUnixNano = j.maybeStartTimeUnixNano-                , attr = ["cap" ~= cap, "category" ~= ("Idle" :: Text)]+                , attrs = ["cap" ~= cap, "category" ~= ("Idle" :: Text)]                 }         -- Yield a duration metric for the current span.         let user = capabilityUser j.value@@ -101,7 +102,7 @@             { value = duration j.value             , maybeTimeUnixNano = Just j.value.startTimeUnixNano             , maybeStartTimeUnixNano = j.maybeStartTimeUnixNano-            , attr = ["cap" ~= cap, "category" ~= showCapabilityUserCategory user, "user" ~= user]+            , attrs = ["cap" ~= cap, "category" ~= showCapabilityUserCategory user, "user" ~= user]             }         go (Just j.value) 

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} @@ -15,6 +16,8 @@   processHeapLiveData,   MemReturnData (..),   processMemReturnData,+  HeapProfSampleData,+  heapProfSamples,   processHeapProfSampleData,    -- ** Heap Profile Breakdown@@ -22,19 +25,21 @@   heapProfBreakdownShow, ) where -import Control.Monad (unless)+import Control.Monad (unless, when) import Control.Monad.IO.Class (MonadIO (..)) import Data.Either (isLeft)+import Data.Foldable (for_) import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict qualified as M import Data.Hashable (Hashable (..)) import Data.List qualified as L import Data.Machine (Process, ProcessT, await, construct, repeatedly, yield)-import Data.Maybe (listToMaybe, mapMaybe)+import Data.Maybe (isJust, listToMaybe, mapMaybe) import Data.Text (Text) import Data.Text qualified as T import Data.Word (Word32, Word64)-import GHC.Eventlog.Live.Data.Attribute (Attr, (~=))+import GHC.Eventlog.Live.Data.Attribute (Attrs, (~=))+import GHC.Eventlog.Live.Data.Group (GroupBy (..)) import GHC.Eventlog.Live.Data.Metric (Metric (..)) import GHC.Eventlog.Live.Logger (logWarning) import GHC.Eventlog.Live.Machine.WithStartTime (WithStartTime (..), tryGetTimeUnixNano)@@ -164,7 +169,50 @@ -- HeapProfSample  {- |+The type of all heap profile samples from a single garbage collection pass.+-}+newtype HeapProfSampleData = HeapProfSampleData+  { heapProfSampleMap :: HashMap Text (Metric Word64)+  }+  deriving (Show)+  deriving newtype (Semigroup, Monoid)++instance GroupBy HeapProfSampleData where+  type Key HeapProfSampleData = ()++  toKey :: HeapProfSampleData -> ()+  toKey = const ()++{- |+Get the elements of a heap profile sample collection.+-}+heapProfSamples :: HeapProfSampleData -> [Metric Word64]+heapProfSamples = M.elems . (.heapProfSampleMap)++{- | Internal helper.+Insert a heap profiling sample into the collection.+-}+insertHeapProfSampleString ::+  forall m.+  (MonadIO m) =>+  Verbosity ->+  Text ->+  Metric Word64 ->+  HeapProfSampleData ->+  m HeapProfSampleData+insertHeapProfSampleString verbosityThreshold heapProfLabel heapProfSample heapProfSamples = do+  let insert :: Maybe (Metric Word64) -> m (Maybe (Metric Word64))+      insert heapProfSample' = do+        when (isJust heapProfSample') $+          logWarning verbosityThreshold $+            "Duplicate HeapProfSampleString for " <> heapProfLabel <> " within the same garbage collection pass."+        pure (Just heapProfSample)+  heapProfSampleMap' <- M.alterF insert heapProfLabel heapProfSamples.heapProfSampleMap+  pure HeapProfSampleData{heapProfSampleMap = heapProfSampleMap'}++{- |+Internal helper. The type of info table pointers. -} newtype InfoTablePtr = InfoTablePtr Word64@@ -184,13 +232,13 @@ The type of an info table entry, as produced by the `E.InfoTableProv` event. -} data InfoTable = InfoTable-  { infoTablePtr :: InfoTablePtr-  , infoTableName :: Text-  , infoTableClosureDesc :: Int-  , infoTableTyDesc :: Text-  , infoTableLabel :: Text-  , infoTableModule :: Text-  , infoTableSrcLoc :: Text+  { infoTablePtr :: !InfoTablePtr+  , infoTableName :: !Text+  , infoTableClosureDesc :: !Int+  , infoTableTyDesc :: !Text+  , infoTableLabel :: !Text+  , infoTableModule :: !Text+  , infoTableSrcLoc :: !Text   }   deriving (Show) @@ -199,9 +247,10 @@ The type of the state kept by `processHeapProfSampleData`. -} data HeapProfSampleState = HeapProfSampleState-  { eitherShouldWarnOrHeapProfBreakdown :: Either Bool HeapProfBreakdown-  , infoTableMap :: HashMap InfoTablePtr InfoTable-  , heapProfSampleEraStack :: [Word64]+  { eitherShouldWarnOrHeapProfBreakdown :: !(Either Bool HeapProfBreakdown)+  , infoTableMap :: !(HashMap InfoTablePtr InfoTable)+  , heapProfSampleEraStack :: ![Word64]+  , maybeHeapProfSampleData :: !(Maybe HeapProfSampleData)   }   deriving (Show) @@ -238,7 +287,7 @@   (MonadIO m) =>   Verbosity ->   Maybe HeapProfBreakdown ->-  ProcessT m (WithStartTime Event) (Metric Word64)+  ProcessT m (WithStartTime Event) HeapProfSampleData processHeapProfSampleData verbosityThreshold maybeHeapProfBreakdown =   construct $     go@@ -246,9 +295,10 @@         { eitherShouldWarnOrHeapProfBreakdown = maybe (Left True) Right maybeHeapProfBreakdown         , infoTableMap = mempty         , heapProfSampleEraStack = mempty+        , maybeHeapProfSampleData = mempty         }  where-  -- go :: HeapProfSampleState -> PlanT (Is (WithStartTime Event)) (Metric Word64) m Void+  -- go :: HeapProfSampleState -> PlanT (Is (WithStartTime Event)) HeapProfSampleData m Void   go st@HeapProfSampleState{..} = do     await >>= \i -> case i.value.evSpec of       -- Announces the heap profile breakdown, amongst other things.@@ -279,25 +329,47 @@                     }             go st{infoTableMap = M.insert infoTablePtr infoTable infoTableMap}       -- Announces the beginning of a heap profile sample.-      E.HeapProfSampleBegin{..} ->-        go st{heapProfSampleEraStack = heapProfSampleEra : heapProfSampleEraStack}+      E.HeapProfSampleBegin{..} -> do+        -- Check that maybeHeapProfSampleData is Nothing.+        for_ st.maybeHeapProfSampleData $ \heapProfSampleData -> do+          logWarning+            verbosityThreshold+            "Unexpected event HeapProfSampleBegin while previous garbage collection pass was left open.\n\+            \This may indicate that the eventlog is not properly ordered or that its semantics have changed."+          -- Yield the previous sample data anyway.+          yield heapProfSampleData+        -- Start a new garbage collection pass.+        go+          st+            { heapProfSampleEraStack = heapProfSampleEra : heapProfSampleEraStack+            , maybeHeapProfSampleData = Just mempty+            }       -- Announces the end of a heap profile sample.-      E.HeapProfSampleEnd{..} ->-        case L.uncons heapProfSampleEraStack of-          Nothing -> do-            logWarning verbosityThreshold . T.pack $-              printf-                "Eventlog closed era %d, but there is no current era."-                heapProfSampleEra-            go st-          Just (currentEra, heapProfSampleEraStack') -> do-            unless (currentEra == heapProfSampleEra) $+      E.HeapProfSampleEnd{..} -> do+        -- Yield the previous heap profile sample data+        for_ st.maybeHeapProfSampleData yield+        -- Pop the heapProfSampleEraStack+        heapProfSampleEraStack' <-+          case L.uncons heapProfSampleEraStack of+            Nothing -> do               logWarning verbosityThreshold . T.pack $                 printf-                  "Eventlog closed era %d, but the current era is era %d."+                  "Eventlog closed era %d, but there is no current era."                   heapProfSampleEra-                  currentEra-            go st{heapProfSampleEraStack = heapProfSampleEraStack'}+              pure heapProfSampleEraStack+            Just (currentEra, heapProfSampleEraStack') -> do+              unless (currentEra == heapProfSampleEra) $+                logWarning verbosityThreshold . T.pack $+                  printf+                    "Eventlog closed era %d, but the current era is era %d."+                    heapProfSampleEra+                    currentEra+              pure heapProfSampleEraStack'+        go+          st+            { heapProfSampleEraStack = heapProfSampleEraStack'+            , maybeHeapProfSampleData = Nothing+            }       -- Announces a heap profile sample.       E.HeapProfSampleString{..}         -- If there is no heap profile breakdown, issue a warning, then disable warnings.@@ -323,21 +395,41 @@                       !infoTablePtr <- readMaybe (T.unpack heapProfLabel)                       M.lookup infoTablePtr infoTableMap                   | otherwise = Nothing-            yield $-              metric i heapProfResidency $-                [ "evCap" ~= i.value.evCap-                , "heapProfBreakdown" ~= heapProfBreakdownShow heapProfBreakdown-                , "heapProfId" ~= heapProfId-                , "heapProfLabel" ~= heapProfLabel-                , "heapProfSampleEra" ~= (fst <$> L.uncons heapProfSampleEraStack)-                , "infoTableName" ~= fmap (.infoTableName) maybeInfoTable-                , "infoTableClosureDesc" ~= fmap (.infoTableClosureDesc) maybeInfoTable-                , "infoTableTyDesc" ~= fmap (.infoTableTyDesc) maybeInfoTable-                , "infoTableLabel" ~= fmap (.infoTableLabel) maybeInfoTable-                , "infoTableModule" ~= fmap (.infoTableModule) maybeInfoTable-                , "infoTableSrcLoc" ~= fmap (.infoTableSrcLoc) maybeInfoTable-                ]-            go $ if isHeapProfBreakdownInfoTable heapProfBreakdown then st else st{infoTableMap = mempty}+            -- Get the HeapProfSampleData+            heapProfSampleData <-+              case st.maybeHeapProfSampleData of+                Nothing -> do+                  logWarning verbosityThreshold $+                    "Unexpected event HeapProfSampleString out of scope of HeapProfSampleBegin and HeapProfSampleEnd.\n\+                    \This may indicate that the eventlog is not properly ordered or that its semantics have changed."+                  pure mempty+                Just heapProfSampleData ->+                  pure heapProfSampleData+            -- Update the HeapProfSampleData+            let heapProfSample =+                  metric i heapProfResidency $+                    [ "evCap" ~= i.value.evCap+                    , "heapProfBreakdown" ~= heapProfBreakdownShow heapProfBreakdown+                    , "heapProfId" ~= heapProfId+                    , "heapProfLabel" ~= heapProfLabel+                    , "heapProfSampleEra" ~= (fst <$> L.uncons heapProfSampleEraStack)+                    , "infoTableName" ~= fmap (.infoTableName) maybeInfoTable+                    , "infoTableClosureDesc" ~= fmap (.infoTableClosureDesc) maybeInfoTable+                    , "infoTableTyDesc" ~= fmap (.infoTableTyDesc) maybeInfoTable+                    , "infoTableLabel" ~= fmap (.infoTableLabel) maybeInfoTable+                    , "infoTableModule" ~= fmap (.infoTableModule) maybeInfoTable+                    , "infoTableSrcLoc" ~= fmap (.infoTableSrcLoc) maybeInfoTable+                    ]+            heapProfSampleData' <-+              insertHeapProfSampleString verbosityThreshold heapProfLabel heapProfSample heapProfSampleData+            -- Continue with the updated HeapProfSampleState+            go+              st+                { -- If we're not profiling with -hi, discard the info table map+                  infoTableMap = if isHeapProfBreakdownInfoTable heapProfBreakdown then st.infoTableMap else mempty+                , -- Add the update HeapProfSampleData+                  maybeHeapProfSampleData = Just heapProfSampleData'+                }       _otherwise -> go st  {- |@@ -427,12 +519,12 @@ metric ::   WithStartTime Event ->   v ->-  [Attr] ->+  Attrs ->   Metric v-metric i v attr =+metric i v attrs =   Metric     { value = v     , maybeTimeUnixNano = tryGetTimeUnixNano i     , maybeStartTimeUnixNano = i.maybeStartTimeUnixNano-    , attr = attr+    , attrs = attrs     }

@@ -13,9 +13,10 @@   batchToTick,   batchListToTick,   batchByTickList,-  liftTick,   dropTick,   onlyTick,+  aggregateByTick,+  liftTick,   liftBatch,    -- * Debug@@ -48,7 +49,7 @@ import Data.HashMap.Strict qualified as M import Data.Hashable (Hashable (..)) import Data.List qualified as L-import Data.Machine (Is (..), MachineT (..), Moore (..), PlanT, Process, ProcessT, Step (..), await, construct, encased, mapping, repeatedly, starve, stopped, yield, (~>))+import Data.Machine (Is (..), MachineT (..), Moore (..), PlanT, Process, ProcessT, Step (..), asParts, await, construct, encased, mapping, repeatedly, starve, stopped, yield, (~>)) import Data.Maybe (fromMaybe) import Data.Semigroup (Max (..)) import Data.Text (Text)@@ -85,12 +86,14 @@ Generalised version of `batchByTickList`. -} batchByTick ::-  forall m a.-  (Monad m, Monoid a) =>-  ProcessT m (Tick a) a+  forall a.+  (Monoid a) => Process (Tick a) a batchByTick = batchByTickWith mempty  where-  batchByTickWith :: a -> MachineT m (Is (Tick a)) a+  batchByTickWith ::+    forall m.+    (Monad m) =>+    a -> MachineT m (Is (Tick a)) a   batchByTickWith acc = MachineT $ pure $ Await onNext Refl onStop    where     onNext :: Tick a -> MachineT m (Is (Tick a)) a@@ -135,6 +138,19 @@       Tick -> yield ()       Item{} -> pure () +{- |+This machine aggregates a value by tick.++The difference between `batchByTick` and `aggregateByTick` is that+`batchByTick` yields a batch on every tick whereas+`aggregateByTick` only yields a batch if there were any values.+-}+aggregateByTick :: (Semigroup a) => Process (Tick a) a+aggregateByTick =+  mapping (fmap Just)+    ~> batchByTick+    ~> asParts+ ------------------------------------------------------------------------------- -- Machine combinators -------------------------------------------------------------------------------@@ -150,14 +166,14 @@   Text ->   (a -> Word) ->   ProcessT m a x-counterBy verbosity label count+counterBy verbosity label counter   | verbosityDebug >= verbosity = repeatedly go   | otherwise = stopped  where   go :: PlanT (Is a) x m ()   go =     await >>= \a ->-      logDebug verbosity ("saw " <> T.pack (show (count a)) <> " " <> label)+      logDebug verbosity (T.pack (show (counter a)) <> " " <> label)  {- | This machine counts the number of inputs it received,@@ -177,7 +193,7 @@   go count =     await >>= \case       Item _ -> go (count + 1)-      Tick -> logDebug verbosity ("saw " <> T.pack (show count) <> " " <> label) >> go 0+      Tick -> logDebug verbosity (T.pack (show count) <> " " <> label) >> go 0  ------------------------------------------------------------------------------- -- Machine combinators

@@ -13,6 +13,7 @@   eventlogLogFileParser,   batchIntervalParser,   verbosityParser,+  statsParser, ) where  import Control.Applicative (asum)@@ -24,7 +25,7 @@ import Text.Read (readEither)  ----------------------------------------------------------------------------------- Eventlog Socket+-- Eventlog Source  {- | The type of eventlog sockets.@@ -187,3 +188,14 @@       "info" -> Right verbosityInfo       "debug" -> Right verbosityDebug       _otherwise -> Left $ "Could not parse verbosity '" <> rawVerbosity <> "'."++--------------------------------------------------------------------------------+-- Statistics++statsParser :: O.Parser Bool+statsParser =+  O.flag False True $+    ( O.short 's'+        <> O.long "stats"+        <> O.help "Display runtime statistics."+    )