{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}

module OpenTelemetry.Instrumentation.Conduit where

import Conduit
import Control.Exception (SomeException, throwIO)
import Data.Text (Text)
import GHC.Stack (HasCallStack)
import OpenTelemetry.Context.ThreadLocal
import OpenTelemetry.Trace.Core hiding (getTracer)


inSpan
  :: (MonadResource m, MonadUnliftIO m, HasCallStack)
  => Tracer
  -> Text
  -> SpanArguments
  -> (Span -> ConduitM i o m a)
  -> ConduitM i o m a
inSpan :: forall (m :: * -> *) i o a.
(MonadResource m, MonadUnliftIO m, HasCallStack) =>
Tracer
-> Text
-> SpanArguments
-> (Span -> ConduitM i o m a)
-> ConduitM i o m a
inSpan Tracer
t Text
n SpanArguments
args Span -> ConduitM i o m a
f = do
  Context
ctx <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadIO m => m Context
getContext
  forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
    (forall (m :: * -> *).
MonadIO m =>
Tracer -> Context -> Text -> SpanArguments -> m Span
createSpanWithoutCallStack Tracer
t Context
ctx Text
n forall a b. (a -> b) -> a -> b
$ HashMap Text Attribute -> SpanArguments -> SpanArguments
addAttributesToSpanArguments HasCallStack => HashMap Text Attribute
callerAttributes SpanArguments
args)
    (forall (m :: * -> *). MonadIO m => Span -> Maybe Timestamp -> m ()
`endSpan` forall a. Maybe a
Nothing)
    forall a b. (a -> b) -> a -> b
$ \Span
span_ -> do
      forall (m :: * -> *) e i o r.
(MonadUnliftIO m, Exception e) =>
ConduitT i o m r -> (e -> ConduitT i o m r) -> ConduitT i o m r
catchC (Span -> ConduitM i o m a
f Span
span_) forall a b. (a -> b) -> a -> b
$ \SomeException
e -> do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
          forall (m :: * -> *) e.
(MonadIO m, Exception e) =>
Span -> HashMap Text Attribute -> Maybe Timestamp -> e -> m ()
recordException Span
span_ [(Text
"exception.escaped", forall a. ToAttribute a => a -> Attribute
toAttribute Bool
True)] forall a. Maybe a
Nothing (SomeException
e :: SomeException)
          forall e a. Exception e => e -> IO a
throwIO SomeException
e