{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
-- | Stable public API for the Hermod tracing system.
--
-- This is the single-import front door for @hermod-tracing-api@. It
-- re-exports everything a package needs to:
--
-- * __Define trace types__: write 'LogFormatting' (human\/machine rendering,
--   metrics) and 'MetaTrace' (namespace, severity, documentation) instances
--   for your domain message types.
--
-- * __Dispatch messages__: call 'traceWith' to emit, 'contramapM'
--   to adapt types, 'foldTraceM' to accumulate state, 'routingTrace' to fan out.
--
-- * __Filter__: 'filterTrace', 'filterTraceMaybe'.
--
-- === For tracer authors
--
-- @
-- Trace                  -- the central carrier opaque type
-- LogFormatting(..)      -- typeclass: forMachine, forHuman, asMetrics
-- MetaTrace(..)          -- typeclass: namespaceFor, severityFor, documentFor, …
-- Metric(..)             -- metric payload (IntM, DoubleM, CounterM, LabelSetM)
-- Namespace(..)          -- hierarchical trace identifier
-- SeverityS(..)          -- message severity (Debug … Emergency)
-- SeverityF(..)          -- severity filter (Nothing = Silence)
-- Privacy(..)            -- Public | Confidential
-- DetailLevel(..)        -- DMinimal … DMaximum
-- Folding(..)            -- wrapper for fold-based stateful tracers
-- @
--
-- === Configuration and control (consumed by @hermod-tracing-core@)
--
-- 'TraceConfig', 'ConfigOption', 'BackendConfig',
-- 'ConfigReflection', 'DocCollector', 'ForwarderAddr',
-- 'ForwarderMode', 'TraceOptionForwarder', 'PrometheusSimpleRun'.
-- These appear in type signatures throughout the system; tracer authors
-- typically do not construct them directly.
module Hermod.Tracing.API (module Export, contramapM, contramapMCond, foldTraceM, foldCondTraceM, filterTrace) where

import           Hermod.Tracing.Types as Export hiding (Trace(..), TraceControl(..), LoggingContext(..), LogDoc(..))
import           Hermod.Tracing.Types as Export (Trace)
import           Hermod.Tracing.Trace.Combinators as Export (traceWith, routingTrace)
import           Hermod.Tracing.Trace as Export (filterTraceMaybe)

import           qualified Hermod.Tracing.Trace.Combinators as Internal (contramapM, contramapMCond , foldTraceM, foldCondTraceM)
import           qualified Hermod.Tracing.Trace as Internal (filterTrace)

import           Control.Monad.IO.Unlift

-- | Contramap a monadic function over a trace.
{-# INLINE contramapM #-}
contramapM :: Monad m
  => Trace m b
  -> (a -> m b)
  -> Trace m a
contramapM :: forall (m :: * -> *) b a.
Monad m =>
Trace m b -> (a -> m b) -> Trace m a
contramapM Trace m b
tr a -> m b
f = Trace m b
-> ((LoggingContext, Either TraceControl a)
    -> m (LoggingContext, Either TraceControl b))
-> Trace m a
forall (m :: * -> *) b a.
Monad m =>
Trace m b
-> ((LoggingContext, Either TraceControl a)
    -> m (LoggingContext, Either TraceControl b))
-> Trace m a
Internal.contramapM Trace m b
tr (LoggingContext, Either TraceControl a)
-> m (LoggingContext, Either TraceControl b)
forall {t} {a}. (t, Either a a) -> m (t, Either a b)
apply where
  apply :: (t, Either a a) -> m (t, Either a b)
apply (t
x, Left a
c) = (t, Either a b) -> m (t, Either a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
x, a -> Either a b
forall a b. a -> Either a b
Left a
c)
  apply (t
lc, Right a
x) = (t
lc, ) (Either a b -> (t, Either a b))
-> (b -> Either a b) -> b -> (t, Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right (b -> (t, Either a b)) -> m b -> m (t, Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
x

-- | Like 'contramapM' but can also filter out messages by returning 'Nothing'.
{-# INLINE contramapMCond #-}
contramapMCond :: Monad m
  => Trace m b
  -> (a -> m (Maybe b))
  -> Trace m a
contramapMCond :: forall (m :: * -> *) b a.
Monad m =>
Trace m b -> (a -> m (Maybe b)) -> Trace m a
contramapMCond Trace m b
tr a -> m (Maybe b)
f = Trace m b
-> ((LoggingContext, Either TraceControl a)
    -> m (Maybe (LoggingContext, Either TraceControl b)))
-> Trace m a
forall (m :: * -> *) b a.
Monad m =>
Trace m b
-> ((LoggingContext, Either TraceControl a)
    -> m (Maybe (LoggingContext, Either TraceControl b)))
-> Trace m a
Internal.contramapMCond Trace m b
tr (LoggingContext, Either TraceControl a)
-> m (Maybe (LoggingContext, Either TraceControl b))
forall {t} {a}. (t, Either a a) -> m (Maybe (t, Either a b))
apply where
  apply :: (t, Either a a) -> m (Maybe (t, Either a b))
apply (t
x, Left a
c) = Maybe (t, Either a b) -> m (Maybe (t, Either a b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((t, Either a b) -> Maybe (t, Either a b)
forall a. a -> Maybe a
Just (t
x, a -> Either a b
forall a b. a -> Either a b
Left a
c))
  apply (t
lc, Right a
x) = (b -> (t, Either a b)) -> Maybe b -> Maybe (t, Either a b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t
lc, ) (Either a b -> (t, Either a b))
-> (b -> Either a b) -> b -> (t, Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right) (Maybe b -> Maybe (t, Either a b))
-> m (Maybe b) -> m (Maybe (t, Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Maybe b)
f a
x

-- | Fold a monadic accumulator function over a trace.
--   Uses an 'MVar' to hold the state.
foldTraceM :: forall a acc m . (MonadUnliftIO m)
  => (acc -> a -> m acc)
  -> acc
  -> Trace m (Folding a acc)
  -> m (Trace m a)
foldTraceM :: forall a acc (m :: * -> *).
MonadUnliftIO m =>
(acc -> a -> m acc)
-> acc -> Trace m (Folding a acc) -> m (Trace m a)
foldTraceM acc -> a -> m acc
cata = (acc -> LoggingContext -> a -> m acc)
-> acc -> Trace m (Folding a acc) -> m (Trace m a)
forall a acc (m :: * -> *).
MonadUnliftIO m =>
(acc -> LoggingContext -> a -> m acc)
-> acc -> Trace m (Folding a acc) -> m (Trace m a)
Internal.foldTraceM ((a -> m acc) -> LoggingContext -> a -> m acc
forall a b. a -> b -> a
const ((a -> m acc) -> LoggingContext -> a -> m acc)
-> (acc -> a -> m acc) -> acc -> LoggingContext -> a -> m acc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. acc -> a -> m acc
cata)

-- | Like 'foldTraceM' but additionally filter the trace by a predicate.
foldCondTraceM :: forall a acc m . (MonadUnliftIO m)
  => (acc -> a -> m acc)
  -> acc
  -> (a -> Bool)
  -> Trace m (Folding a acc)
  -> m (Trace m a)
foldCondTraceM :: forall a acc (m :: * -> *).
MonadUnliftIO m =>
(acc -> a -> m acc)
-> acc -> (a -> Bool) -> Trace m (Folding a acc) -> m (Trace m a)
foldCondTraceM acc -> a -> m acc
cata = (acc -> LoggingContext -> a -> m acc)
-> acc -> (a -> Bool) -> Trace m (Folding a acc) -> m (Trace m a)
forall a acc (m :: * -> *).
MonadUnliftIO m =>
(acc -> LoggingContext -> a -> m acc)
-> acc -> (a -> Bool) -> Trace m (Folding a acc) -> m (Trace m a)
Internal.foldCondTraceM ((a -> m acc) -> LoggingContext -> a -> m acc
forall a b. a -> b -> a
const ((a -> m acc) -> LoggingContext -> a -> m acc)
-> (acc -> a -> m acc) -> acc -> LoggingContext -> a -> m acc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. acc -> a -> m acc
cata)

--- | Don't process further if the selector function returns 'False'.
filterTrace :: Monad m
  => (a -> Bool)
  -> Trace m a
  -> Trace m a
filterTrace :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Trace m a -> Trace m a
filterTrace a -> Bool
f = ((LoggingContext, a) -> Bool) -> Trace m a -> Trace m a
forall (m :: * -> *) a.
Monad m =>
((LoggingContext, a) -> Bool) -> Trace m a -> Trace m a
Internal.filterTrace (a -> Bool
f (a -> Bool)
-> ((LoggingContext, a) -> a) -> (LoggingContext, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LoggingContext, a) -> a
forall a b. (a, b) -> b
snd)