{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} module OpenTelemetry.Eventlog ( withSpan, withSpan_, setSpanId, setTraceId, setTag, addEvent, setParentSpanContext, SpanInFlight (..), ) where import Control.Monad.Catch import Control.Monad.IO.Class import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import OpenTelemetry.Eventlog_Internal (SpanInFlight (..)) import qualified OpenTelemetry.Eventlog_Internal as I import OpenTelemetry.SpanContext {-# INLINE withSpan #-} withSpan :: forall m a. (MonadIO m, MonadMask m) => BS.ByteString -> (SpanInFlight -> m a) -> m a withSpan :: forall (m :: * -> *) a. (MonadIO m, MonadMask m) => ByteString -> (SpanInFlight -> m a) -> m a withSpan ByteString operation SpanInFlight -> m a action = forall a b. (a, b) -> a fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a b c. MonadMask m => m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c) generalBracket (forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadIO m => ByteString -> m SpanInFlight beginSpan ByteString operation) ( \SpanInFlight sp ExitCase a exitcase -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ do case ExitCase a exitcase of ExitCaseSuccess a _ -> forall (f :: * -> *) a. Applicative f => a -> f a pure () ExitCaseException SomeException e -> do forall (m :: * -> *). MonadIO m => SpanInFlight -> ByteString -> ByteString -> m () setTag SpanInFlight sp ByteString "error" ByteString "true" forall (m :: * -> *). MonadIO m => SpanInFlight -> ByteString -> ByteString -> m () setTag SpanInFlight sp ByteString "error.message" (String -> ByteString BS8.pack forall a b. (a -> b) -> a -> b $ forall a. Int -> [a] -> [a] take Int I.maxMsgLen forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show SomeException e) ExitCase a ExitCaseAbort -> do forall (m :: * -> *). MonadIO m => SpanInFlight -> ByteString -> ByteString -> m () setTag SpanInFlight sp ByteString "error" ByteString "true" forall (m :: * -> *). MonadIO m => SpanInFlight -> ByteString -> ByteString -> m () setTag SpanInFlight sp ByteString "error.message" ByteString "abort" forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadIO m => SpanInFlight -> m () endSpan SpanInFlight sp ) SpanInFlight -> m a action {-# INLINE withSpan_ #-} withSpan_ :: (MonadIO m, MonadMask m) => BS.ByteString -> m a -> m a withSpan_ :: forall (m :: * -> *) a. (MonadIO m, MonadMask m) => ByteString -> m a -> m a withSpan_ ByteString operation m a action = forall (m :: * -> *) a. (MonadIO m, MonadMask m) => ByteString -> (SpanInFlight -> m a) -> m a withSpan ByteString operation (forall a b. a -> b -> a const m a action) {-# INLINE setSpanId #-} setSpanId :: MonadIO m => SpanInFlight -> SpanId -> m () setSpanId :: forall (m :: * -> *). MonadIO m => SpanInFlight -> SpanId -> m () setSpanId SpanInFlight sp SpanId sid = forall (m :: * -> *). MonadIO m => Builder -> m () I.traceBuilder forall a b. (a -> b) -> a -> b $ SpanInFlight -> SpanId -> Builder I.builder_setSpanId SpanInFlight sp SpanId sid {-# INLINE setTraceId #-} setTraceId :: MonadIO m => SpanInFlight -> TraceId -> m () setTraceId :: forall (m :: * -> *). MonadIO m => SpanInFlight -> TraceId -> m () setTraceId SpanInFlight sp TraceId tid = forall (m :: * -> *). MonadIO m => Builder -> m () I.traceBuilder forall a b. (a -> b) -> a -> b $ SpanInFlight -> TraceId -> Builder I.builder_setTraceId SpanInFlight sp TraceId tid {-# INLINE beginSpan #-} beginSpan :: MonadIO m => BS.ByteString -> m SpanInFlight beginSpan :: forall (m :: * -> *). MonadIO m => ByteString -> m SpanInFlight beginSpan ByteString operation = do SpanInFlight u <- forall (m :: * -> *). MonadIO m => m SpanInFlight I.nextLocalSpan forall (m :: * -> *). MonadIO m => Builder -> m () I.traceBuilder forall a b. (a -> b) -> a -> b $ SpanInFlight -> ByteString -> Builder I.builder_beginSpan SpanInFlight u ByteString operation forall (f :: * -> *) a. Applicative f => a -> f a pure SpanInFlight u {-# INLINE endSpan #-} endSpan :: MonadIO m => SpanInFlight -> m () endSpan :: forall (m :: * -> *). MonadIO m => SpanInFlight -> m () endSpan SpanInFlight sp = forall (m :: * -> *). MonadIO m => Builder -> m () I.traceBuilder forall a b. (a -> b) -> a -> b $ SpanInFlight -> Builder I.builder_endSpan SpanInFlight sp {-# INLINE setTag #-} setTag :: MonadIO m => SpanInFlight -> BS.ByteString -> BS.ByteString -> m () setTag :: forall (m :: * -> *). MonadIO m => SpanInFlight -> ByteString -> ByteString -> m () setTag SpanInFlight sp ByteString k ByteString v = forall (m :: * -> *). MonadIO m => Builder -> m () I.traceBuilder forall a b. (a -> b) -> a -> b $ SpanInFlight -> ByteString -> ByteString -> Builder I.builder_setTag SpanInFlight sp ByteString k ByteString v {-# INLINE addEvent #-} addEvent :: MonadIO m => SpanInFlight -> BS.ByteString -> BS.ByteString -> m () addEvent :: forall (m :: * -> *). MonadIO m => SpanInFlight -> ByteString -> ByteString -> m () addEvent SpanInFlight sp ByteString k ByteString v = forall (m :: * -> *). MonadIO m => Builder -> m () I.traceBuilder forall a b. (a -> b) -> a -> b $ SpanInFlight -> ByteString -> ByteString -> Builder I.builder_addEvent SpanInFlight sp ByteString k ByteString v {-# INLINE setParentSpanContext #-} setParentSpanContext :: MonadIO m => SpanInFlight -> SpanContext -> m () setParentSpanContext :: forall (m :: * -> *). MonadIO m => SpanInFlight -> SpanContext -> m () setParentSpanContext SpanInFlight sp SpanContext ctx = forall (m :: * -> *). MonadIO m => Builder -> m () I.traceBuilder forall a b. (a -> b) -> a -> b $ SpanInFlight -> SpanContext -> Builder I.builder_setParentSpanContext SpanInFlight sp SpanContext ctx