-- | Lenses for modifying a 'TracerProviderOptions'
module OpenTelemetry.Trace.Setup.Lens
  ( idGeneratorL
  , samplerL
  , resourcesL
  , attributeLimitsL
  , spanLimitsL
  , propagatorL
  , loggerL
  ) where

import Prelude

import Data.Text (Text)
import Lens.Micro (Lens', lens)
import Network.HTTP.Types.Header (RequestHeaders, ResponseHeaders)
import OpenTelemetry.Attributes (AttributeLimits)
import OpenTelemetry.Context (Context)
import OpenTelemetry.Logging.Core (Log)
import OpenTelemetry.Propagator (Propagator)
import OpenTelemetry.Resource (MaterializedResources)
import OpenTelemetry.Trace (TracerProviderOptions(..))
import OpenTelemetry.Trace.Core (SpanLimits)
import OpenTelemetry.Trace.Id.Generator (IdGenerator)
import OpenTelemetry.Trace.Sampler (Sampler)

idGeneratorL :: Lens' TracerProviderOptions IdGenerator
idGeneratorL :: Lens' TracerProviderOptions IdGenerator
idGeneratorL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TracerProviderOptions -> IdGenerator
tracerProviderOptionsIdGenerator
  forall a b. (a -> b) -> a -> b
$ \TracerProviderOptions
x IdGenerator
y -> TracerProviderOptions
x { tracerProviderOptionsIdGenerator :: IdGenerator
tracerProviderOptionsIdGenerator = IdGenerator
y }

samplerL :: Lens' TracerProviderOptions Sampler
samplerL :: Lens' TracerProviderOptions Sampler
samplerL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TracerProviderOptions -> Sampler
tracerProviderOptionsSampler
  forall a b. (a -> b) -> a -> b
$ \TracerProviderOptions
x Sampler
y -> TracerProviderOptions
x { tracerProviderOptionsSampler :: Sampler
tracerProviderOptionsSampler = Sampler
y }

resourcesL :: Lens' TracerProviderOptions MaterializedResources
resourcesL :: Lens' TracerProviderOptions MaterializedResources
resourcesL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TracerProviderOptions -> MaterializedResources
tracerProviderOptionsResources
  forall a b. (a -> b) -> a -> b
$ \TracerProviderOptions
x MaterializedResources
y -> TracerProviderOptions
x { tracerProviderOptionsResources :: MaterializedResources
tracerProviderOptionsResources = MaterializedResources
y }

attributeLimitsL :: Lens' TracerProviderOptions AttributeLimits
attributeLimitsL :: Lens' TracerProviderOptions AttributeLimits
attributeLimitsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TracerProviderOptions -> AttributeLimits
tracerProviderOptionsAttributeLimits
  forall a b. (a -> b) -> a -> b
$ \TracerProviderOptions
x AttributeLimits
y -> TracerProviderOptions
x { tracerProviderOptionsAttributeLimits :: AttributeLimits
tracerProviderOptionsAttributeLimits = AttributeLimits
y }

spanLimitsL :: Lens' TracerProviderOptions SpanLimits
spanLimitsL :: Lens' TracerProviderOptions SpanLimits
spanLimitsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TracerProviderOptions -> SpanLimits
tracerProviderOptionsSpanLimits
  forall a b. (a -> b) -> a -> b
$ \TracerProviderOptions
x SpanLimits
y -> TracerProviderOptions
x { tracerProviderOptionsSpanLimits :: SpanLimits
tracerProviderOptionsSpanLimits = SpanLimits
y }

propagatorL
  :: Lens'
       TracerProviderOptions
       (Propagator Context RequestHeaders ResponseHeaders)
propagatorL :: Lens'
  TracerProviderOptions
  (Propagator Context RequestHeaders RequestHeaders)
propagatorL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TracerProviderOptions
-> Propagator Context RequestHeaders RequestHeaders
tracerProviderOptionsPropagators
  forall a b. (a -> b) -> a -> b
$ \TracerProviderOptions
x Propagator Context RequestHeaders RequestHeaders
y -> TracerProviderOptions
x { tracerProviderOptionsPropagators :: Propagator Context RequestHeaders RequestHeaders
tracerProviderOptionsPropagators = Propagator Context RequestHeaders RequestHeaders
y }

loggerL :: Lens' TracerProviderOptions (Log Text -> IO ())
loggerL :: Lens' TracerProviderOptions (Log Text -> IO ())
loggerL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TracerProviderOptions -> Log Text -> IO ()
tracerProviderOptionsLogger
  forall a b. (a -> b) -> a -> b
$ \TracerProviderOptions
x Log Text -> IO ()
y -> TracerProviderOptions
x { tracerProviderOptionsLogger :: Log Text -> IO ()
tracerProviderOptionsLogger = Log Text -> IO ()
y }