Environment.hs

module Effectful.OpenTelemetry.Exporter.Environment where

import Control.Monad.Extra (mconcatMapM)
import Data.Char (toLower)
import Data.List (intercalate)
import Data.List.Extra (nubOrd, splitOn, trim)
import Effectful
import Effectful.Concurrent (Concurrent)
import Effectful.Environment (Environment, lookupEnv)
import Effectful.Error.Static (Error, throwError)
import Effectful.OpenTelemetry.Exporter.Console
import Effectful.OpenTelemetry.Exporter.OTLP
import Effectful.OpenTelemetry.Exporter.Type
import Effectful.OpenTelemetry.Protocol.Environment qualified as Environment
import Effectful.OpenTelemetry.Protocol.Export (Request (..))
import Effectful.OpenTelemetry.Protocol.Export qualified as Export
import Effectful.OpenTelemetry.Protocol.Resource (Resource)
import Effectful.OpenTelemetry.Protocol.Scope (Scope)
import Effectful.Retry (Retry)
import Effectful.Timeout (Timeout)
import Prettyprinter.Extra (PrettyAnn)
import Prettyprinter.Render.Terminal (AnsiStyle)
import Prelude

lookup
    :: forall a es es'
     . ( Export.Request a
       , PrettyAnn AnsiStyle a
       , Environment :> es
       , Error Environment.ConfigError :> es
       , IOE :> es'
       , Environment :> es'
       , Retry :> es'
       , Timeout :> es'
       , Concurrent :> es'
       )
    => Resource -> Scope -> Eff es (Exporter es' a)
lookup resource scope =
    lookupEnv (intercalate "_" ["OTEL", transportSignalEnvName @a, "EXPORTER"]) >>= \case
        Nothing -> pure otlp'
        Just (trim -> "") -> pure otlp'
        Just raw ->
            mconcatMapM \case
                "none" -> mempty
                "otlp" -> pure otlp'
                "console" -> pure stdout
                other -> throwError $ Environment.UnknownExporter other
                . nubOrd
                . filter (not . null)
                . map (map toLower . trim)
                . splitOn ","
                $ raw
  where
    otlp' = otlp resource scope