{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ScopedTypeVariables #-}


module Cardano.Logging.Configuration
  ( ConfigReflection (..)
  , emptyConfigReflection
  , configureTracers
  , withNamespaceConfig
  , filterSeverityFromConfig
  , withDetailsFromConfig
  , withBackendsFromConfig
  , withLimitersFromConfig

  , maybeSilent
  , isSilentTracer
  , hasNoMetrics

  , getSeverity
  , getDetails
  , getBackends
  ) where

import           Cardano.Logging.DocuGenerator (addFiltered, addLimiter, addSilent)
import           Cardano.Logging.FrequencyLimiter (limitFrequency)
import           Cardano.Logging.Trace
import           Cardano.Logging.TraceDispatcherMessage
import           Cardano.Logging.Types

import           Control.Monad (unless)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Control.Monad.IO.Unlift (MonadUnliftIO)
import qualified Control.Tracer as T
import           Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef)
import           Data.List (maximumBy, nub)
import qualified Data.Map as Map
import           Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Set as Set
import           Data.Text (Text, intercalate, unpack)


-- | Call this function at initialisation, and later for reconfiguration.
-- Config reflection is used to optimise the tracers and has to collect
-- information about the tracers. Although it is possible to give more then
-- one tracer of the same time, it is not a common case to do this.
configureTracers :: forall a m.
     (MetaTrace a
  ,  MonadIO m)
  => ConfigReflection
  -> TraceConfig
  -> [Trace m a]
  -> m ()
configureTracers :: forall a (m :: * -> *).
(MetaTrace a, MonadIO m) =>
ConfigReflection -> TraceConfig -> [Trace m a] -> m ()
configureTracers ConfigReflection
cr TraceConfig
config [Trace m a]
tracers = do
    (Trace m a -> m ()) -> [Trace m a] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Trace m a
t -> do
            TraceControl -> Trace m a -> m ()
forall {m :: * -> *} {a}.
Monad m =>
TraceControl -> Trace m a -> m ()
configureTrace TraceControl
TCReset Trace m a
t
            TraceControl -> Trace m a -> m ()
forall {m :: * -> *} {a}.
Monad m =>
TraceControl -> Trace m a -> m ()
configureAllTrace (TraceConfig -> TraceControl
TCConfig TraceConfig
config) Trace m a
t
            TraceControl -> Trace m a -> m ()
forall {m :: * -> *} {a}.
Monad m =>
TraceControl -> Trace m a -> m ()
configureTrace (ConfigReflection -> TraceControl
TCOptimize ConfigReflection
cr) Trace m a
t)
          [Trace m a]
tracers
  where
    configureTrace :: TraceControl -> Trace m a -> m ()
configureTrace TraceControl
control (Trace Tracer m (LoggingContext, Either TraceControl a)
tr) =
      Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith Tracer m (LoggingContext, Either TraceControl a)
tr (LoggingContext
emptyLoggingContext, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left TraceControl
control)
    configureAllTrace :: TraceControl -> Trace m a -> m ()
configureAllTrace TraceControl
control (Trace Tracer m (LoggingContext, Either TraceControl a)
tr) =
      (Namespace a -> m ()) -> [Namespace a] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_  (\ Namespace a
ns ->
              Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith
                Tracer m (LoggingContext, Either TraceControl a)
tr
                (LoggingContext
emptyLoggingContext
                  { lcNSInner = nsInner ns}
                  , TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left TraceControl
control))
            ([Namespace a]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace a])

-- | Switch off any message of a particular tracer based on the configuration.
-- If the top tracer is silent and no subtracer is not silent, then switch it off
maybeSilent :: forall m a. (MonadIO m) =>
   ( TraceConfig -> Namespace a -> Bool)
  -> [Text]
  -> Bool
  -> Trace m a
  -> m (Trace m a)
maybeSilent :: forall (m :: * -> *) a.
MonadIO m =>
(TraceConfig -> Namespace a -> Bool)
-> [Text] -> Bool -> Trace m a -> m (Trace m a)
maybeSilent TraceConfig -> Namespace a -> Bool
selectorFunc [Text]
prefixNames Bool
isMetrics (Trace Tracer m (LoggingContext, Either TraceControl a)
tr) = do
    IORef (Maybe Bool)
ref  <- IO (IORef (Maybe Bool)) -> m (IORef (Maybe Bool))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe Bool -> IO (IORef (Maybe Bool))
forall a. a -> IO (IORef a)
newIORef Maybe Bool
forall a. Maybe a
Nothing)
    Trace m a
-> ((LoggingContext, Either TraceControl a)
    -> m (Maybe (LoggingContext, Either TraceControl a)))
-> m (Trace m a)
forall (m :: * -> *) b a.
Monad m =>
Trace m b
-> ((LoggingContext, Either TraceControl a)
    -> m (Maybe (LoggingContext, Either TraceControl b)))
-> m (Trace m a)
contramapMCond (Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace Tracer m (LoggingContext, Either TraceControl a)
tr) (IORef (Maybe Bool)
-> (LoggingContext, Either TraceControl a)
-> m (Maybe (LoggingContext, Either TraceControl a))
forall {m :: * -> *} {a} {b}.
MonadIO m =>
IORef (Maybe Bool)
-> (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
mapFunc IORef (Maybe Bool)
ref)
  where
    mapFunc :: IORef (Maybe Bool)
-> (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
mapFunc IORef (Maybe Bool)
ref =
      \case
        (a
lc, Right b
a) -> do
          Maybe Bool
silence <- IO (Maybe Bool) -> m (Maybe Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bool) -> m (Maybe Bool))
-> IO (Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Bool) -> IO (Maybe Bool)
forall a. IORef a -> IO a
readIORef IORef (Maybe Bool)
ref
          if Maybe Bool
silence Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
            then Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, Either TraceControl b)
forall a. Maybe a
Nothing
            else Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, Either TraceControl b)
 -> m (Maybe (a, Either TraceControl b)))
-> Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a b. (a -> b) -> a -> b
$ (a, Either TraceControl b) -> Maybe (a, Either TraceControl b)
forall a. a -> Maybe a
Just (a
lc, b -> Either TraceControl b
forall a b. b -> Either a b
Right b
a)
        (a
lc, Left (TCConfig TraceConfig
c)) -> do
          Maybe Bool
silence <- IO (Maybe Bool) -> m (Maybe Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bool) -> m (Maybe Bool))
-> IO (Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Bool) -> IO (Maybe Bool)
forall a. IORef a -> IO a
readIORef IORef (Maybe Bool)
ref
          case Maybe Bool
silence of
            Maybe Bool
Nothing -> do
              let val :: Bool
val = TraceConfig -> Namespace a -> Bool
selectorFunc TraceConfig
c ([Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
prefixNames [] :: Namespace a)
              IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Bool) -> Maybe Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Bool)
ref (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
val)
            Just Bool
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, Either TraceControl b)
 -> m (Maybe (a, Either TraceControl b)))
-> Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a b. (a -> b) -> a -> b
$ (a, Either TraceControl b) -> Maybe (a, Either TraceControl b)
forall a. a -> Maybe a
Just (a
lc, TraceControl -> Either TraceControl b
forall a b. a -> Either a b
Left (TraceConfig -> TraceControl
TCConfig TraceConfig
c))
        (a
lc, Left TraceControl
TCReset) -> do
          IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Bool) -> Maybe Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Bool)
ref Maybe Bool
forall a. Maybe a
Nothing
          Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, Either TraceControl b)
 -> m (Maybe (a, Either TraceControl b)))
-> Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a b. (a -> b) -> a -> b
$ (a, Either TraceControl b) -> Maybe (a, Either TraceControl b)
forall a. a -> Maybe a
Just (a
lc, TraceControl -> Either TraceControl b
forall a b. a -> Either a b
Left TraceControl
TCReset)
        (a
lc, Left (TCOptimize ConfigReflection
cr)) -> do
          Maybe Bool
silence <- IO (Maybe Bool) -> m (Maybe Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bool) -> m (Maybe Bool))
-> IO (Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Bool) -> IO (Maybe Bool)
forall a. IORef a -> IO a
readIORef IORef (Maybe Bool)
ref
          case Maybe Bool
silence of
            Just Bool
True -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ if Bool
isMetrics
                                    then IORef (Set [Text]) -> (Set [Text] -> Set [Text]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (ConfigReflection -> IORef (Set [Text])
crNoMetrics ConfigReflection
cr) ([Text] -> Set [Text] -> Set [Text]
forall a. Ord a => a -> Set a -> Set a
Set.insert [Text]
prefixNames)
                                    else IORef (Set [Text]) -> (Set [Text] -> Set [Text]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (ConfigReflection -> IORef (Set [Text])
crSilent ConfigReflection
cr) ([Text] -> Set [Text] -> Set [Text]
forall a. Ord a => a -> Set a -> Set a
Set.insert [Text]
prefixNames)
            Maybe Bool
_         -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Set [Text]) -> (Set [Text] -> Set [Text]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (ConfigReflection -> IORef (Set [Text])
crAllTracers ConfigReflection
cr) ([Text] -> Set [Text] -> Set [Text]
forall a. Ord a => a -> Set a -> Set a
Set.insert [Text]
prefixNames)
          Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, Either TraceControl b)
 -> m (Maybe (a, Either TraceControl b)))
-> Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a b. (a -> b) -> a -> b
$ (a, Either TraceControl b) -> Maybe (a, Either TraceControl b)
forall a. a -> Maybe a
Just (a
lc,  TraceControl -> Either TraceControl b
forall a b. a -> Either a b
Left (ConfigReflection -> TraceControl
TCOptimize ConfigReflection
cr))
        (a
lc, Left c :: TraceControl
c@TCDocument {}) -> do
          Maybe Bool
silence <- IO (Maybe Bool) -> m (Maybe Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bool) -> m (Maybe Bool))
-> IO (Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Bool) -> IO (Maybe Bool)
forall a. IORef a -> IO a
readIORef IORef (Maybe Bool)
ref
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isMetrics
            (TraceControl -> Maybe Bool -> m ()
forall (m :: * -> *).
MonadIO m =>
TraceControl -> Maybe Bool -> m ()
addSilent TraceControl
c Maybe Bool
silence)
          Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, Either TraceControl b)
 -> m (Maybe (a, Either TraceControl b)))
-> Maybe (a, Either TraceControl b)
-> m (Maybe (a, Either TraceControl b))
forall a b. (a -> b) -> a -> b
$ (a, Either TraceControl b) -> Maybe (a, Either TraceControl b)
forall a. a -> Maybe a
Just (a
lc,  TraceControl -> Either TraceControl b
forall a b. a -> Either a b
Left TraceControl
c)


-- When all messages are filtered out, it is silent
isSilentTracer :: forall a. MetaTrace a => TraceConfig -> Namespace a -> Bool
isSilentTracer :: forall a. MetaTrace a => TraceConfig -> Namespace a -> Bool
isSilentTracer TraceConfig
tc (Namespace [Text]
prefixNS [Text]
_) =
    let allNS :: [Namespace a]
allNS = [Namespace a]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace a]
    in (Namespace a -> Bool) -> [Namespace a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ (Namespace [Text]
_ [Text]
innerNS) ->
              Namespace a -> Bool
isFiltered ([Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
prefixNS [Text]
innerNS :: Namespace a))
           [Namespace a]
allNS
  where
    isFiltered :: Namespace a -> Bool
    isFiltered :: Namespace a -> Bool
isFiltered Namespace a
ns =
      let msgSeverity :: Maybe SeverityS
msgSeverity    = Namespace a -> Maybe a -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor Namespace a
ns Maybe a
forall a. Maybe a
Nothing
          severityFilter :: SeverityF
severityFilter = TraceConfig -> Namespace a -> SeverityF
forall a. TraceConfig -> Namespace a -> SeverityF
getSeverity TraceConfig
tc Namespace a
ns
      in case SeverityF
severityFilter of
            SeverityF Maybe SeverityS
Nothing -> Bool
True -- silent config
            SeverityF (Just SeverityS
sevF) ->
              case Maybe SeverityS
msgSeverity of
                Just SeverityS
msev -> SeverityS
sevF SeverityS -> SeverityS -> Bool
forall a. Ord a => a -> a -> Bool
> SeverityS
msev
                Maybe SeverityS
Nothing   -> Bool
False -- Impossible case

-- When all messages are filtered out, it is silent
hasNoMetrics :: forall a. MetaTrace a => TraceConfig -> Namespace a -> Bool
hasNoMetrics :: forall a. MetaTrace a => TraceConfig -> Namespace a -> Bool
hasNoMetrics TraceConfig
_tc Namespace a
_ns =
    let allNS :: [Namespace a]
allNS = [Namespace a]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace a]
    in (Namespace a -> Bool) -> [Namespace a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([(Text, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Text, Text)] -> Bool)
-> (Namespace a -> [(Text, Text)]) -> Namespace a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Namespace a -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor) [Namespace a]
allNS

-- | Take a selector function called 'extract'.
-- Take a function from trace to trace with this config dependent value.
-- In this way construct a trace transformer with a config value
withNamespaceConfig :: forall m a b c. (MonadIO m, Ord b) =>
     String
  -> (TraceConfig -> Namespace a -> m b)
  -> (Maybe b -> Trace m c -> m (Trace m a))
  -> Trace m c
  -> m (Trace m a)
withNamespaceConfig :: forall (m :: * -> *) a b c.
(MonadIO m, Ord b) =>
String
-> (TraceConfig -> Namespace a -> m b)
-> (Maybe b -> Trace m c -> m (Trace m a))
-> Trace m c
-> m (Trace m a)
withNamespaceConfig String
name TraceConfig -> Namespace a -> m b
extract Maybe b -> Trace m c -> m (Trace m a)
withConfig Trace m c
tr = do
    IORef (Either (Map [Text] b, Maybe b) b)
ref  <- IO (IORef (Either (Map [Text] b, Maybe b) b))
-> m (IORef (Either (Map [Text] b, Maybe b) b))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Either (Map [Text] b, Maybe b) b
-> IO (IORef (Either (Map [Text] b, Maybe b) b))
forall a. a -> IO (IORef a)
newIORef ((Map [Text] b, Maybe b) -> Either (Map [Text] b, Maybe b) b
forall a b. a -> Either a b
Left (Map [Text] b
forall k a. Map k a
Map.empty, Maybe b
forall a. Maybe a
Nothing)))
    Trace m a -> m (Trace m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Trace m a -> m (Trace m a)) -> Trace m a -> m (Trace m a)
forall a b. (a -> b) -> a -> b
$ ((LoggingContext, Either TraceControl a) -> m ()) -> Trace m a
forall (m :: * -> *) a.
Monad m =>
((LoggingContext, Either TraceControl a) -> m ()) -> Trace m a
contramapM' (IORef (Either (Map [Text] b, Maybe b) b)
-> (LoggingContext, Either TraceControl a) -> m ()
mapFunc IORef (Either (Map [Text] b, Maybe b) b)
ref)
  where
    mapFunc :: IORef (Either (Map [Text] b, Maybe b) b)
-> (LoggingContext, Either TraceControl a) -> m ()
mapFunc IORef (Either (Map [Text] b, Maybe b) b)
ref =
      \case
        (LoggingContext
lc, Right a
a) -> do
          Either (Map [Text] b, Maybe b) b
eitherConf <- IO (Either (Map [Text] b, Maybe b) b)
-> m (Either (Map [Text] b, Maybe b) b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (Map [Text] b, Maybe b) b)
 -> m (Either (Map [Text] b, Maybe b) b))
-> IO (Either (Map [Text] b, Maybe b) b)
-> m (Either (Map [Text] b, Maybe b) b)
forall a b. (a -> b) -> a -> b
$ IORef (Either (Map [Text] b, Maybe b) b)
-> IO (Either (Map [Text] b, Maybe b) b)
forall a. IORef a -> IO a
readIORef IORef (Either (Map [Text] b, Maybe b) b)
ref
          case Either (Map [Text] b, Maybe b) b
eitherConf of
            Right b
val -> do
              Trace m a
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig (b -> Maybe b
forall a. a -> Maybe a
Just b
val) Trace m c
tr
              Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith (Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
forall (m :: * -> *) a.
Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
unpackTrace Trace m a
tt) (LoggingContext
lc, a -> Either TraceControl a
forall a b. b -> Either a b
Right a
a)
            Left (Map [Text] b
cmap, Just b
v) ->
              case [Text] -> Map [Text] b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (LoggingContext -> [Text]
lcNSPrefix LoggingContext
lc [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ LoggingContext -> [Text]
lcNSInner LoggingContext
lc) Map [Text] b
cmap of
                    Just b
val -> do
                      Trace m a
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig (b -> Maybe b
forall a. a -> Maybe a
Just b
val) Trace m c
tr
                      Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith (Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
forall (m :: * -> *) a.
Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
unpackTrace Trace m a
tt) (LoggingContext
lc, a -> Either TraceControl a
forall a b. b -> Either a b
Right a
a)
                    Maybe b
Nothing  -> do
                      Trace m a
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig (b -> Maybe b
forall a. a -> Maybe a
Just b
v) Trace m c
tr
                      Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith (Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
forall (m :: * -> *) a.
Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
unpackTrace Trace m a
tt) (LoggingContext
lc, a -> Either TraceControl a
forall a b. b -> Either a b
Right a
a)
            -- This can happen during reconfiguration, so we don't throw an error any more
            Left (Map [Text] b
_cmap, Maybe b
Nothing) -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (LoggingContext
lc, Left TraceControl
TCReset) -> do
          IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Either (Map [Text] b, Maybe b) b)
-> Either (Map [Text] b, Maybe b) b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Either (Map [Text] b, Maybe b) b)
ref ((Map [Text] b, Maybe b) -> Either (Map [Text] b, Maybe b) b
forall a b. a -> Either a b
Left (Map [Text] b
forall k a. Map k a
Map.empty, Maybe b
forall a. Maybe a
Nothing))
          Trace m a
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig Maybe b
forall a. Maybe a
Nothing Trace m c
tr
          Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith (Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
forall (m :: * -> *) a.
Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
unpackTrace Trace m a
tt) (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left TraceControl
TCReset)
        (LoggingContext
lc, Left (TCConfig TraceConfig
c)) -> do
          let nst :: [Text]
nst = LoggingContext -> [Text]
lcNSPrefix LoggingContext
lc [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ LoggingContext -> [Text]
lcNSInner LoggingContext
lc
          !b
val <- TraceConfig -> Namespace a -> m b
extract TraceConfig
c ([Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace (LoggingContext -> [Text]
lcNSPrefix LoggingContext
lc) (LoggingContext -> [Text]
lcNSInner LoggingContext
lc))
          Either (Map [Text] b, Maybe b) b
eitherConf <- IO (Either (Map [Text] b, Maybe b) b)
-> m (Either (Map [Text] b, Maybe b) b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (Map [Text] b, Maybe b) b)
 -> m (Either (Map [Text] b, Maybe b) b))
-> IO (Either (Map [Text] b, Maybe b) b)
-> m (Either (Map [Text] b, Maybe b) b)
forall a b. (a -> b) -> a -> b
$ IORef (Either (Map [Text] b, Maybe b) b)
-> IO (Either (Map [Text] b, Maybe b) b)
forall a. IORef a -> IO a
readIORef IORef (Either (Map [Text] b, Maybe b) b)
ref
          case Either (Map [Text] b, Maybe b) b
eitherConf of
            Left (Map [Text] b
cmap, Maybe b
Nothing) ->
              case [Text] -> Map [Text] b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Text]
nst Map [Text] b
cmap of
                Maybe b
Nothing -> do
                  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                      (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Either (Map [Text] b, Maybe b) b)
-> Either (Map [Text] b, Maybe b) b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Either (Map [Text] b, Maybe b) b)
ref ((Map [Text] b, Maybe b) -> Either (Map [Text] b, Maybe b) b
forall a b. a -> Either a b
Left ([Text] -> b -> Map [Text] b -> Map [Text] b
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Text]
nst b
val Map [Text] b
cmap, Maybe b
forall a. Maybe a
Nothing))
                  Trace m a
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig (b -> Maybe b
forall a. a -> Maybe a
Just b
val) Trace m c
tr
                  Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith (Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
forall (m :: * -> *) a.
Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
unpackTrace Trace m a
tt) (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left (TraceConfig -> TraceControl
TCConfig TraceConfig
c))
                Just b
v  -> do
                  if b
v b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
val
                    then do
                      Trace Tracer m (LoggingContext, Either TraceControl a)
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig (b -> Maybe b
forall a. a -> Maybe a
Just b
val) Trace m c
tr
                      Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith Tracer m (LoggingContext, Either TraceControl a)
tt (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left (TraceConfig -> TraceControl
TCConfig TraceConfig
c))
                    else String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Inconsistent trace configuration with context "
                                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
nst
            Right b
_val -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Trace not reset before reconfiguration (1)"
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
nst
            Left (Map [Text] b
_cmap, Just b
_v) -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Trace not reset before reconfiguration (2)"
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
nst
        (LoggingContext
lc, Left (TCOptimize ConfigReflection
cr)) -> do
          Either (Map [Text] b, Maybe b) b
eitherConf <- IO (Either (Map [Text] b, Maybe b) b)
-> m (Either (Map [Text] b, Maybe b) b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (Map [Text] b, Maybe b) b)
 -> m (Either (Map [Text] b, Maybe b) b))
-> IO (Either (Map [Text] b, Maybe b) b)
-> m (Either (Map [Text] b, Maybe b) b)
forall a b. (a -> b) -> a -> b
$ IORef (Either (Map [Text] b, Maybe b) b)
-> IO (Either (Map [Text] b, Maybe b) b)
forall a. IORef a -> IO a
readIORef IORef (Either (Map [Text] b, Maybe b) b)
ref
          let nst :: [Text]
nst = LoggingContext -> [Text]
lcNSPrefix LoggingContext
lc [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ LoggingContext -> [Text]
lcNSInner LoggingContext
lc
          case Either (Map [Text] b, Maybe b) b
eitherConf of
            Left (Map [Text] b
cmap, Maybe b
Nothing) ->
              case [b] -> [b]
forall a. Eq a => [a] -> [a]
nub (Map [Text] b -> [b]
forall k a. Map k a -> [a]
Map.elems Map [Text] b
cmap) of
                []     -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                [b
val]  -> do
                            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Either (Map [Text] b, Maybe b) b)
-> Either (Map [Text] b, Maybe b) b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Either (Map [Text] b, Maybe b) b)
ref (Either (Map [Text] b, Maybe b) b -> IO ())
-> Either (Map [Text] b, Maybe b) b -> IO ()
forall a b. (a -> b) -> a -> b
$ b -> Either (Map [Text] b, Maybe b) b
forall a b. b -> Either a b
Right b
val
                            Trace Tracer m (LoggingContext, Either TraceControl a)
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig (b -> Maybe b
forall a. a -> Maybe a
Just b
val) Trace m c
tr
                            Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith Tracer m (LoggingContext, Either TraceControl a)
tt (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left (ConfigReflection -> TraceControl
TCOptimize ConfigReflection
cr))
                [b]
_      -> let decidingDict :: Map b Int
decidingDict =
                                (Map b Int -> b -> Map b Int) -> Map b Int -> [b] -> Map b Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
                                  (\Map b Int
acc b
e -> (Int -> Int -> Int) -> b -> Int -> Map b Int -> Map b Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) b
e (Int
1 :: Int) Map b Int
acc)
                                  Map b Int
forall k a. Map k a
Map.empty
                                  (Map [Text] b -> [b]
forall k a. Map k a -> [a]
Map.elems Map [Text] b
cmap)
                              (b
mostCommon, Int
_) = ((b, Int) -> (b, Int) -> Ordering) -> [(b, Int)] -> (b, Int)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy
                                                  (\(b
_, Int
n') (b
_, Int
m') -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n' Int
m')
                                                  (Map b Int -> [(b, Int)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map b Int
decidingDict)
                              newmap :: Map [Text] b
newmap = (b -> Bool) -> Map [Text] b -> Map [Text] b
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
mostCommon) Map [Text] b
cmap
                          in do
                            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Either (Map [Text] b, Maybe b) b)
-> Either (Map [Text] b, Maybe b) b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Either (Map [Text] b, Maybe b) b)
ref ((Map [Text] b, Maybe b) -> Either (Map [Text] b, Maybe b) b
forall a b. a -> Either a b
Left (Map [Text] b
newmap, b -> Maybe b
forall a. a -> Maybe a
Just b
mostCommon))
                            Trace Tracer m (LoggingContext, Either TraceControl a)
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig Maybe b
forall a. Maybe a
Nothing Trace m c
tr
                            Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith Tracer m (LoggingContext, Either TraceControl a)
tt (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left (ConfigReflection -> TraceControl
TCOptimize ConfigReflection
cr))
            Right b
_val -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Trace not reset before reconfiguration (3)"
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
nst
            Left (Map [Text] b
_cmap, Just b
_v) ->
                          String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Trace not reset before reconfiguration (4)"
                                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
nst
        (LoggingContext
lc, Left dc :: TraceControl
dc@TCDocument {}) -> do
          Either (Map [Text] b, Maybe b) b
eitherConf <- IO (Either (Map [Text] b, Maybe b) b)
-> m (Either (Map [Text] b, Maybe b) b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (Map [Text] b, Maybe b) b)
 -> m (Either (Map [Text] b, Maybe b) b))
-> IO (Either (Map [Text] b, Maybe b) b)
-> m (Either (Map [Text] b, Maybe b) b)
forall a b. (a -> b) -> a -> b
$ IORef (Either (Map [Text] b, Maybe b) b)
-> IO (Either (Map [Text] b, Maybe b) b)
forall a. IORef a -> IO a
readIORef IORef (Either (Map [Text] b, Maybe b) b)
ref
          let nst :: [Text]
nst = LoggingContext -> [Text]
lcNSPrefix LoggingContext
lc [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ LoggingContext -> [Text]
lcNSInner LoggingContext
lc
          case Either (Map [Text] b, Maybe b) b
eitherConf of
            Right b
val -> do
              Trace m a
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig (b -> Maybe b
forall a. a -> Maybe a
Just b
val) Trace m c
tr
              Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith
                (Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
forall (m :: * -> *) a.
Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
unpackTrace Trace m a
tt) (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left TraceControl
dc)
            Left (Map [Text] b
cmap, Just b
v) ->
              case [Text] -> Map [Text] b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Text]
nst Map [Text] b
cmap of
                    Just b
val -> do
                      Trace m a
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig (b -> Maybe b
forall a. a -> Maybe a
Just b
val) Trace m c
tr
                      Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith (Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
forall (m :: * -> *) a.
Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
unpackTrace Trace m a
tt) (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left TraceControl
dc)
                    Maybe b
Nothing  -> do
                      Trace m a
tt <- Maybe b -> Trace m c -> m (Trace m a)
withConfig (b -> Maybe b
forall a. a -> Maybe a
Just b
v) Trace m c
tr
                      Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith (Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
forall (m :: * -> *) a.
Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
unpackTrace Trace m a
tt) (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left TraceControl
dc)
            Left (Map [Text] b
_cmap, Maybe b
Nothing) -> String -> m ()
forall a. HasCallStack => String -> a
error (String
"Missing configuration(2) " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" ns " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show [Text]
nst)


-- | Filter a trace by severity and take the filter value from the config
filterSeverityFromConfig :: (MonadIO m) =>
     Trace m a
  -> m (Trace m a)
filterSeverityFromConfig :: forall (m :: * -> *) a. MonadIO m => Trace m a -> m (Trace m a)
filterSeverityFromConfig =
    String
-> (TraceConfig -> Namespace a -> m SeverityF)
-> (Maybe SeverityF -> Trace m a -> m (Trace m a))
-> Trace m a
-> m (Trace m a)
forall (m :: * -> *) a b c.
(MonadIO m, Ord b) =>
String
-> (TraceConfig -> Namespace a -> m b)
-> (Maybe b -> Trace m c -> m (Trace m a))
-> Trace m c
-> m (Trace m a)
withNamespaceConfig
      String
"severity"
      TraceConfig -> Namespace a -> m SeverityF
forall (m :: * -> *) a.
Applicative m =>
TraceConfig -> Namespace a -> m SeverityF
getSeverity'
      (\Maybe SeverityF
sev Trace m a
tr -> Trace m a
-> ((LoggingContext, Either TraceControl a)
    -> m (Maybe (LoggingContext, Either TraceControl a)))
-> m (Trace m a)
forall (m :: * -> *) b a.
Monad m =>
Trace m b
-> ((LoggingContext, Either TraceControl a)
    -> m (Maybe (LoggingContext, Either TraceControl b)))
-> m (Trace m a)
contramapMCond Trace m a
tr (Maybe SeverityF
-> (LoggingContext, Either TraceControl a)
-> m (Maybe (LoggingContext, Either TraceControl a))
forall {f :: * -> *} {b}.
MonadIO f =>
Maybe SeverityF
-> (LoggingContext, Either TraceControl b)
-> f (Maybe (LoggingContext, Either TraceControl b))
mapF Maybe SeverityF
sev))
  where
    mapF :: Maybe SeverityF
-> (LoggingContext, Either TraceControl b)
-> f (Maybe (LoggingContext, Either TraceControl b))
mapF Maybe SeverityF
confSev =
      \case
        (LoggingContext
lc, Right b
cont) -> do
          let visible :: Bool
visible = case LoggingContext -> Maybe SeverityS
lcSeverity LoggingContext
lc of
                            (Just SeverityS
s)  -> case Maybe SeverityF
confSev of
                                          Just (SeverityF (Just SeverityS
fs)) -> SeverityS
s SeverityS -> SeverityS -> Bool
forall a. Ord a => a -> a -> Bool
>= SeverityS
fs
                                          Just (SeverityF Maybe SeverityS
Nothing)   -> Bool
False
                                          Maybe SeverityF
Nothing -> Bool
True
                            Maybe SeverityS
Nothing -> Bool
True
          if Bool
visible
            then Maybe (LoggingContext, Either TraceControl b)
-> f (Maybe (LoggingContext, Either TraceControl b))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (LoggingContext, Either TraceControl b)
 -> f (Maybe (LoggingContext, Either TraceControl b)))
-> Maybe (LoggingContext, Either TraceControl b)
-> f (Maybe (LoggingContext, Either TraceControl b))
forall a b. (a -> b) -> a -> b
$ (LoggingContext, Either TraceControl b)
-> Maybe (LoggingContext, Either TraceControl b)
forall a. a -> Maybe a
Just (LoggingContext
lc, b -> Either TraceControl b
forall a b. b -> Either a b
Right b
cont)
            else Maybe (LoggingContext, Either TraceControl b)
-> f (Maybe (LoggingContext, Either TraceControl b))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LoggingContext, Either TraceControl b)
forall a. Maybe a
Nothing
        (LoggingContext
lc, Left c :: TraceControl
c@TCDocument {}) -> do
          TraceControl -> Maybe SeverityF -> f ()
forall (m :: * -> *).
MonadIO m =>
TraceControl -> Maybe SeverityF -> m ()
addFiltered TraceControl
c Maybe SeverityF
confSev
          Maybe (LoggingContext, Either TraceControl b)
-> f (Maybe (LoggingContext, Either TraceControl b))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((LoggingContext, Either TraceControl b)
-> Maybe (LoggingContext, Either TraceControl b)
forall a. a -> Maybe a
Just (LoggingContext
lc, TraceControl -> Either TraceControl b
forall a b. a -> Either a b
Left TraceControl
c))
        (LoggingContext
lc, Either TraceControl b
anx) ->  do
          Maybe (LoggingContext, Either TraceControl b)
-> f (Maybe (LoggingContext, Either TraceControl b))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((LoggingContext, Either TraceControl b)
-> Maybe (LoggingContext, Either TraceControl b)
forall a. a -> Maybe a
Just (LoggingContext
lc, Either TraceControl b
anx))


-- | Set detail level of a trace from the config
withDetailsFromConfig :: (MonadIO m) =>
     Trace m a
  -> m (Trace m a)
withDetailsFromConfig :: forall (m :: * -> *) a. MonadIO m => Trace m a -> m (Trace m a)
withDetailsFromConfig =
  String
-> (TraceConfig -> Namespace a -> m DetailLevel)
-> (Maybe DetailLevel -> Trace m a -> m (Trace m a))
-> Trace m a
-> m (Trace m a)
forall (m :: * -> *) a b c.
(MonadIO m, Ord b) =>
String
-> (TraceConfig -> Namespace a -> m b)
-> (Maybe b -> Trace m c -> m (Trace m a))
-> Trace m c
-> m (Trace m a)
withNamespaceConfig
    String
"details"
    TraceConfig -> Namespace a -> m DetailLevel
forall (m :: * -> *) a.
Applicative m =>
TraceConfig -> Namespace a -> m DetailLevel
getDetails'
    (\Maybe DetailLevel
mbDtl Trace m a
b -> case Maybe DetailLevel
mbDtl of
              Just DetailLevel
dtl -> Trace m a -> m (Trace m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Trace m a -> m (Trace m a)) -> Trace m a -> m (Trace m a)
forall a b. (a -> b) -> a -> b
$ DetailLevel -> Trace m a -> Trace m a
forall (m :: * -> *) a.
Monad m =>
DetailLevel -> Trace m a -> Trace m a
setDetails DetailLevel
dtl Trace m a
b
              Maybe DetailLevel
Nothing  -> Trace m a -> m (Trace m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Trace m a -> m (Trace m a)) -> Trace m a -> m (Trace m a)
forall a b. (a -> b) -> a -> b
$ DetailLevel -> Trace m a -> Trace m a
forall (m :: * -> *) a.
Monad m =>
DetailLevel -> Trace m a -> Trace m a
setDetails DetailLevel
DNormal Trace m a
b)

-- | Routing and formatting of a trace from the config
withBackendsFromConfig :: (MonadIO m) =>
  (Maybe [BackendConfig] -> Trace m FormattedMessage -> m (Trace m a))
  -> m (Trace m a)
withBackendsFromConfig :: forall (m :: * -> *) a.
MonadIO m =>
(Maybe [BackendConfig]
 -> Trace m FormattedMessage -> m (Trace m a))
-> m (Trace m a)
withBackendsFromConfig Maybe [BackendConfig] -> Trace m FormattedMessage -> m (Trace m a)
rappendPrefixNameAndFormatter =
  String
-> (TraceConfig -> Namespace a -> m [BackendConfig])
-> (Maybe [BackendConfig]
    -> Trace m FormattedMessage -> m (Trace m a))
-> Trace m FormattedMessage
-> m (Trace m a)
forall (m :: * -> *) a b c.
(MonadIO m, Ord b) =>
String
-> (TraceConfig -> Namespace a -> m b)
-> (Maybe b -> Trace m c -> m (Trace m a))
-> Trace m c
-> m (Trace m a)
withNamespaceConfig
    String
"backends"
    TraceConfig -> Namespace a -> m [BackendConfig]
forall (m :: * -> *) a.
Applicative m =>
TraceConfig -> Namespace a -> m [BackendConfig]
getBackends'
    Maybe [BackendConfig] -> Trace m FormattedMessage -> m (Trace m a)
rappendPrefixNameAndFormatter
    (Tracer m (LoggingContext, Either TraceControl FormattedMessage)
-> Trace m FormattedMessage
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace Tracer m (LoggingContext, Either TraceControl FormattedMessage)
forall (m :: * -> *) a. Monad m => Tracer m a
T.nullTracer)

data Limiter m a = Limiter Text Double (Trace m a)

instance Eq (Limiter m a) where
  Limiter Text
t1 Double
_ Trace m a
_ == :: Limiter m a -> Limiter m a -> Bool
== Limiter Text
t2 Double
_ Trace m a
_ = Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2

instance Ord (Limiter m a) where
  Limiter Text
t1 Double
_ Trace m a
_ <= :: Limiter m a -> Limiter m a -> Bool
<= Limiter Text
t2 Double
_ Trace m a
_ = Text
t1 Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
<= Text
t2

instance Show (Limiter m a) where
  show :: Limiter m a -> String
show (Limiter Text
name Double
_ Trace m a
_) = String
"Limiter " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
name


-- | Routing and formatting of a trace from the config
withLimitersFromConfig :: forall a m . (MonadUnliftIO m)
  => Trace m TraceDispatcherMessage
  -> Trace m a
  -> m (Trace m a)
withLimitersFromConfig :: forall a (m :: * -> *).
MonadUnliftIO m =>
Trace m TraceDispatcherMessage -> Trace m a -> m (Trace m a)
withLimitersFromConfig Trace m TraceDispatcherMessage
tri Trace m a
tr = do
    IORef (Map Text (Limiter m a))
ref <- IO (IORef (Map Text (Limiter m a)))
-> m (IORef (Map Text (Limiter m a)))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Map Text (Limiter m a)))
 -> m (IORef (Map Text (Limiter m a))))
-> IO (IORef (Map Text (Limiter m a)))
-> m (IORef (Map Text (Limiter m a)))
forall a b. (a -> b) -> a -> b
$ Map Text (Limiter m a) -> IO (IORef (Map Text (Limiter m a)))
forall a. a -> IO (IORef a)
newIORef Map Text (Limiter m a)
forall k a. Map k a
Map.empty
    String
-> (TraceConfig -> Namespace a -> m (Maybe (Limiter m a)))
-> (Maybe (Maybe (Limiter m a)) -> Trace m a -> m (Trace m a))
-> Trace m a
-> m (Trace m a)
forall (m :: * -> *) a b c.
(MonadIO m, Ord b) =>
String
-> (TraceConfig -> Namespace a -> m b)
-> (Maybe b -> Trace m c -> m (Trace m a))
-> Trace m c
-> m (Trace m a)
withNamespaceConfig
      String
"limiters"
      (IORef (Map Text (Limiter m a))
-> TraceConfig -> Namespace a -> m (Maybe (Limiter m a))
getLimiter IORef (Map Text (Limiter m a))
ref)
      Maybe (Maybe (Limiter m a)) -> Trace m a -> m (Trace m a)
withLimiter
      Trace m a
tr
  where
    -- | May return a limiter, which is a stateful transformation from trace to trace
    getLimiter ::
         IORef (Map.Map Text (Limiter m a))
      -> TraceConfig
      -> Namespace a
      -> m (Maybe (Limiter m a))
    getLimiter :: IORef (Map Text (Limiter m a))
-> TraceConfig -> Namespace a -> m (Maybe (Limiter m a))
getLimiter IORef (Map Text (Limiter m a))
stateRef TraceConfig
config Namespace a
ns =
      case TraceConfig -> Namespace a -> Maybe (Text, Double)
forall a. TraceConfig -> Namespace a -> Maybe (Text, Double)
getLimiterSpec TraceConfig
config Namespace a
ns of
        Maybe (Text, Double)
Nothing -> Maybe (Limiter m a) -> m (Maybe (Limiter m a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Limiter m a)
forall a. Maybe a
Nothing
        Just (Text
name, Double
frequency) ->
          if Double
frequency Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
            then Maybe (Limiter m a) -> m (Maybe (Limiter m a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Limiter m a)
forall a. Maybe a
Nothing
            else do
              Map Text (Limiter m a)
state <- IO (Map Text (Limiter m a)) -> m (Map Text (Limiter m a))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map Text (Limiter m a)) -> m (Map Text (Limiter m a)))
-> IO (Map Text (Limiter m a)) -> m (Map Text (Limiter m a))
forall a b. (a -> b) -> a -> b
$ IORef (Map Text (Limiter m a)) -> IO (Map Text (Limiter m a))
forall a. IORef a -> IO a
readIORef IORef (Map Text (Limiter m a))
stateRef
              case Text -> Map Text (Limiter m a) -> Maybe (Limiter m a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Map Text (Limiter m a)
state of
                Just Limiter m a
limiter -> Maybe (Limiter m a) -> m (Maybe (Limiter m a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Limiter m a) -> m (Maybe (Limiter m a)))
-> Maybe (Limiter m a) -> m (Maybe (Limiter m a))
forall a b. (a -> b) -> a -> b
$ Limiter m a -> Maybe (Limiter m a)
forall a. a -> Maybe a
Just Limiter m a
limiter
                Maybe (Limiter m a)
Nothing -> do
                  Trace m a
limiterTrace <- Double
-> Text
-> Trace m TraceDispatcherMessage
-> Trace m a
-> m (Trace m a)
forall a (m :: * -> *).
MonadUnliftIO m =>
Double
-> Text
-> Trace m TraceDispatcherMessage
-> Trace m a
-> m (Trace m a)
limitFrequency Double
frequency Text
name Trace m TraceDispatcherMessage
tri Trace m a
tr
                  let limiter :: Limiter m a
limiter = Text -> Double -> Trace m a -> Limiter m a
forall (m :: * -> *) a. Text -> Double -> Trace m a -> Limiter m a
Limiter Text
name Double
frequency Trace m a
limiterTrace
                  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map Text (Limiter m a)) -> Map Text (Limiter m a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map Text (Limiter m a))
stateRef (Text
-> Limiter m a -> Map Text (Limiter m a) -> Map Text (Limiter m a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name Limiter m a
limiter Map Text (Limiter m a)
state)
                  Maybe (Limiter m a) -> m (Maybe (Limiter m a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Limiter m a) -> m (Maybe (Limiter m a)))
-> Maybe (Limiter m a) -> m (Maybe (Limiter m a))
forall a b. (a -> b) -> a -> b
$ Limiter m a -> Maybe (Limiter m a)
forall a. a -> Maybe a
Just Limiter m a
limiter

    withLimiter ::
         Maybe (Maybe (Limiter m a))
      -> Trace m a
      -> m (Trace m a)
    withLimiter :: Maybe (Maybe (Limiter m a)) -> Trace m a -> m (Trace m a)
withLimiter Maybe (Maybe (Limiter m a))
Nothing Trace m a
tr' = Trace m a -> m (Trace m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace m a
tr'
    withLimiter (Just Maybe (Limiter m a)
Nothing) Trace m a
tr' = Trace m a -> m (Trace m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace m a
tr'
    withLimiter (Just (Just (Limiter Text
n Double
d (Trace Tracer m (LoggingContext, Either TraceControl a)
trli)))) (Trace Tracer m (LoggingContext, Either TraceControl a)
tr') =
      Trace m a -> m (Trace m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Trace m a -> m (Trace m a)) -> Trace m a -> m (Trace m a)
forall a b. (a -> b) -> a -> b
$ ((LoggingContext, Either TraceControl a) -> m ()) -> Trace m a
forall (m :: * -> *) a.
Monad m =>
((LoggingContext, Either TraceControl a) -> m ()) -> Trace m a
contramapM' (Limiter m a
-> Trace m a -> (LoggingContext, Either TraceControl a) -> m ()
forall {m :: * -> *} {a} {a}.
MonadIO m =>
Limiter m a
-> Trace m a -> (LoggingContext, Either TraceControl a) -> m ()
mapFunc (Text -> Double -> Trace m a -> Limiter m a
forall (m :: * -> *) a. Text -> Double -> Trace m a -> Limiter m a
Limiter Text
n Double
d (Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace Tracer m (LoggingContext, Either TraceControl a)
trli)) (Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace Tracer m (LoggingContext, Either TraceControl a)
tr'))
    mapFunc :: Limiter m a
-> Trace m a -> (LoggingContext, Either TraceControl a) -> m ()
mapFunc (Limiter Text
n Double
d (Trace Tracer m (LoggingContext, Either TraceControl a)
trli)) (Trace Tracer m (LoggingContext, Either TraceControl a)
tr') =
        \case
          (LoggingContext
lc, Right a
v) ->
            Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith Tracer m (LoggingContext, Either TraceControl a)
trli (LoggingContext
lc, a -> Either TraceControl a
forall a b. b -> Either a b
Right a
v)
          (LoggingContext
lc, Left c :: TraceControl
c@TCDocument {}) -> do
            TraceControl -> (Text, Double) -> m ()
forall (m :: * -> *).
MonadIO m =>
TraceControl -> (Text, Double) -> m ()
addLimiter TraceControl
c (Text
n, Double
d)
            Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith Tracer m (LoggingContext, Either TraceControl a)
tr' (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left TraceControl
c)
          (LoggingContext
lc, Left TraceControl
c) ->
            Tracer m (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
T.traceWith Tracer m (LoggingContext, Either TraceControl a)
tr' (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left TraceControl
c)

--------------------------------------------------------

-- | If no severity can be found in the config, it is set to Warning
getSeverity :: TraceConfig -> Namespace a -> SeverityF
getSeverity :: forall a. TraceConfig -> Namespace a -> SeverityF
getSeverity TraceConfig
config Namespace a
ns =
    SeverityF -> Maybe SeverityF -> SeverityF
forall a. a -> Maybe a -> a
fromMaybe (Maybe SeverityS -> SeverityF
SeverityF (SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning))
              ((ConfigOption -> Maybe SeverityF)
-> TraceConfig -> [Text] -> Maybe SeverityF
forall a.
(ConfigOption -> Maybe a) -> TraceConfig -> [Text] -> Maybe a
getOption ConfigOption -> Maybe SeverityF
severitySelector TraceConfig
config (Namespace a -> [Text]
forall a. Namespace a -> [Text]
nsGetComplete Namespace a
ns))
  where
    severitySelector :: ConfigOption -> Maybe SeverityF
    severitySelector :: ConfigOption -> Maybe SeverityF
severitySelector (ConfSeverity SeverityF
s) = SeverityF -> Maybe SeverityF
forall a. a -> Maybe a
Just SeverityF
s
    severitySelector ConfigOption
_              = Maybe SeverityF
forall a. Maybe a
Nothing

getSeverity' :: Applicative m => TraceConfig -> Namespace a -> m SeverityF
getSeverity' :: forall (m :: * -> *) a.
Applicative m =>
TraceConfig -> Namespace a -> m SeverityF
getSeverity' TraceConfig
config Namespace a
ns = SeverityF -> m SeverityF
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SeverityF -> m SeverityF) -> SeverityF -> m SeverityF
forall a b. (a -> b) -> a -> b
$ TraceConfig -> Namespace a -> SeverityF
forall a. TraceConfig -> Namespace a -> SeverityF
getSeverity TraceConfig
config Namespace a
ns

-- | If no details can be found in the config, it is set to DNormal
getDetails :: TraceConfig -> Namespace a -> DetailLevel
getDetails :: forall a. TraceConfig -> Namespace a -> DetailLevel
getDetails TraceConfig
config Namespace a
ns =
    DetailLevel -> Maybe DetailLevel -> DetailLevel
forall a. a -> Maybe a -> a
fromMaybe DetailLevel
DNormal ((ConfigOption -> Maybe DetailLevel)
-> TraceConfig -> [Text] -> Maybe DetailLevel
forall a.
(ConfigOption -> Maybe a) -> TraceConfig -> [Text] -> Maybe a
getOption ConfigOption -> Maybe DetailLevel
detailSelector TraceConfig
config (Namespace a -> [Text]
forall a. Namespace a -> [Text]
nsGetComplete Namespace a
ns))
  where
    detailSelector :: ConfigOption -> Maybe DetailLevel
    detailSelector :: ConfigOption -> Maybe DetailLevel
detailSelector (ConfDetail DetailLevel
d) = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
d
    detailSelector ConfigOption
_            = Maybe DetailLevel
forall a. Maybe a
Nothing

getDetails' :: Applicative m => TraceConfig -> Namespace a -> m DetailLevel
getDetails' :: forall (m :: * -> *) a.
Applicative m =>
TraceConfig -> Namespace a -> m DetailLevel
getDetails' TraceConfig
config Namespace a
n = DetailLevel -> m DetailLevel
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DetailLevel -> m DetailLevel) -> DetailLevel -> m DetailLevel
forall a b. (a -> b) -> a -> b
$ TraceConfig -> Namespace a -> DetailLevel
forall a. TraceConfig -> Namespace a -> DetailLevel
getDetails TraceConfig
config Namespace a
n

-- | If no backends can be found in the config, it is set to
-- [EKGBackend, Forwarder, Stdout HumanFormatColoured]
getBackends :: TraceConfig -> Namespace a -> [BackendConfig]
getBackends :: forall a. TraceConfig -> Namespace a -> [BackendConfig]
getBackends TraceConfig
config Namespace a
ns =
    [BackendConfig] -> Maybe [BackendConfig] -> [BackendConfig]
forall a. a -> Maybe a -> a
fromMaybe [BackendConfig
EKGBackend, BackendConfig
Forwarder, FormatLogging -> BackendConfig
Stdout FormatLogging
HumanFormatColoured]
      ((ConfigOption -> Maybe [BackendConfig])
-> TraceConfig -> [Text] -> Maybe [BackendConfig]
forall a.
(ConfigOption -> Maybe a) -> TraceConfig -> [Text] -> Maybe a
getOption ConfigOption -> Maybe [BackendConfig]
backendSelector TraceConfig
config (Namespace a -> [Text]
forall a. Namespace a -> [Text]
nsGetComplete Namespace a
ns))
  where
    backendSelector :: ConfigOption -> Maybe [BackendConfig]
    backendSelector :: ConfigOption -> Maybe [BackendConfig]
backendSelector (ConfBackend [BackendConfig]
s) = [BackendConfig] -> Maybe [BackendConfig]
forall a. a -> Maybe a
Just [BackendConfig]
s
    backendSelector ConfigOption
_             = Maybe [BackendConfig]
forall a. Maybe a
Nothing

getBackends' :: Applicative m => TraceConfig -> Namespace a -> m [BackendConfig]
getBackends' :: forall (m :: * -> *) a.
Applicative m =>
TraceConfig -> Namespace a -> m [BackendConfig]
getBackends' TraceConfig
config Namespace a
ns = [BackendConfig] -> m [BackendConfig]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([BackendConfig] -> m [BackendConfig])
-> [BackendConfig] -> m [BackendConfig]
forall a b. (a -> b) -> a -> b
$ TraceConfig -> Namespace a -> [BackendConfig]
forall a. TraceConfig -> Namespace a -> [BackendConfig]
getBackends TraceConfig
config Namespace a
ns

-- | May return a limiter specification
getLimiterSpec :: TraceConfig -> Namespace a -> Maybe (Text, Double)
getLimiterSpec :: forall a. TraceConfig -> Namespace a -> Maybe (Text, Double)
getLimiterSpec TraceConfig
config Namespace a
ns = (ConfigOption -> Maybe (Text, Double))
-> TraceConfig -> [Text] -> Maybe (Text, Double)
forall a.
(ConfigOption -> Maybe a) -> TraceConfig -> [Text] -> Maybe a
getOption ConfigOption -> Maybe (Text, Double)
limiterSelector TraceConfig
config (Namespace a -> [Text]
forall a. Namespace a -> [Text]
nsGetComplete Namespace a
ns)
  where
    limiterSelector :: ConfigOption -> Maybe (Text, Double)
    limiterSelector :: ConfigOption -> Maybe (Text, Double)
limiterSelector (ConfLimiter Double
f) = (Text, Double) -> Maybe (Text, Double)
forall a. a -> Maybe a
Just (Text -> [Text] -> Text
intercalate Text
"." (Namespace a -> [Text]
forall a. Namespace a -> [Text]
nsPrefix Namespace a
ns [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Namespace a -> [Text]
forall a. Namespace a -> [Text]
nsInner Namespace a
ns), Double
f)
    limiterSelector ConfigOption
_               = Maybe (Text, Double)
forall a. Maybe a
Nothing

-- | Searches in the config to find an option
getOption :: (ConfigOption -> Maybe a) -> TraceConfig -> [Text] -> Maybe a
getOption :: forall a.
(ConfigOption -> Maybe a) -> TraceConfig -> [Text] -> Maybe a
getOption ConfigOption -> Maybe a
sel TraceConfig
config [] =
  case [Text] -> Map [Text] [ConfigOption] -> Maybe [ConfigOption]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [] (TraceConfig -> Map [Text] [ConfigOption]
tcOptions TraceConfig
config) of
    Maybe [ConfigOption]
Nothing -> Maybe a
forall a. Maybe a
Nothing
    Just [ConfigOption]
options -> case (ConfigOption -> Maybe a) -> [ConfigOption] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ConfigOption -> Maybe a
sel [ConfigOption]
options of
                      []        -> Maybe a
forall a. Maybe a
Nothing
                      (a
opt : [a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
opt
getOption ConfigOption -> Maybe a
sel TraceConfig
config [Text]
ns =
  case [Text] -> Map [Text] [ConfigOption] -> Maybe [ConfigOption]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Text]
ns (TraceConfig -> Map [Text] [ConfigOption]
tcOptions TraceConfig
config) of
    Maybe [ConfigOption]
Nothing -> (ConfigOption -> Maybe a) -> TraceConfig -> [Text] -> Maybe a
forall a.
(ConfigOption -> Maybe a) -> TraceConfig -> [Text] -> Maybe a
getOption ConfigOption -> Maybe a
sel TraceConfig
config ([Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
init [Text]
ns)
    Just [ConfigOption]
options -> case (ConfigOption -> Maybe a) -> [ConfigOption] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ConfigOption -> Maybe a
sel [ConfigOption]
options of
                      []        -> (ConfigOption -> Maybe a) -> TraceConfig -> [Text] -> Maybe a
forall a.
(ConfigOption -> Maybe a) -> TraceConfig -> [Text] -> Maybe a
getOption ConfigOption -> Maybe a
sel TraceConfig
config ([Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
init [Text]
ns)
                      (a
opt : [a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
opt