{-# 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