{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module OpenTelemetry.Exporter.Handle.Span (
  makeHandleExporter,
  -- $
  stdoutExporter',
  stderrExporter',
  -- $
  defaultFormatter,
) where

import Data.IORef
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.IO as L
import OpenTelemetry.Exporter.Span
import OpenTelemetry.Trace.Core
import System.IO (Handle, hFlush, stderr, stdout)


makeHandleExporter :: Handle -> (ImmutableSpan -> IO L.Text) -> SpanExporter
makeHandleExporter :: Handle -> (ImmutableSpan -> IO Text) -> SpanExporter
makeHandleExporter Handle
h ImmutableSpan -> IO Text
f =
  SpanExporter
    { spanExporterExport :: HashMap InstrumentationLibrary (Vector ImmutableSpan)
-> IO ExportResult
spanExporterExport = \HashMap InstrumentationLibrary (Vector ImmutableSpan)
fs -> do
        (Vector ImmutableSpan -> IO ())
-> HashMap InstrumentationLibrary (Vector ImmutableSpan) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ImmutableSpan -> IO ()) -> Vector ImmutableSpan -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ImmutableSpan
s -> ImmutableSpan -> IO Text
f ImmutableSpan
s IO Text -> (Text -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> Text -> IO ()
L.hPutStrLn Handle
h IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
h)) HashMap InstrumentationLibrary (Vector ImmutableSpan)
fs
        ExportResult -> IO ExportResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExportResult
Success
    , spanExporterShutdown :: IO ()
spanExporterShutdown = Handle -> IO ()
hFlush Handle
h
    }


stdoutExporter' :: (ImmutableSpan -> IO L.Text) -> SpanExporter
stdoutExporter' :: (ImmutableSpan -> IO Text) -> SpanExporter
stdoutExporter' = Handle -> (ImmutableSpan -> IO Text) -> SpanExporter
makeHandleExporter Handle
stdout


stderrExporter' :: (ImmutableSpan -> IO L.Text) -> SpanExporter
stderrExporter' :: (ImmutableSpan -> IO Text) -> SpanExporter
stderrExporter' = Handle -> (ImmutableSpan -> IO Text) -> SpanExporter
makeHandleExporter Handle
stderr


defaultFormatter :: ImmutableSpan -> L.Text
defaultFormatter :: ImmutableSpan -> Text
defaultFormatter ImmutableSpan {Maybe Timestamp
Maybe Span
Text
Attributes
Timestamp
AppendOnlyBoundedCollection Event
AppendOnlyBoundedCollection Link
SpanContext
SpanStatus
SpanKind
Tracer
spanName :: Text
spanParent :: Maybe Span
spanContext :: SpanContext
spanKind :: SpanKind
spanStart :: Timestamp
spanEnd :: Maybe Timestamp
spanAttributes :: Attributes
spanLinks :: AppendOnlyBoundedCollection Link
spanEvents :: AppendOnlyBoundedCollection Event
spanStatus :: SpanStatus
spanTracer :: Tracer
spanName :: ImmutableSpan -> Text
spanParent :: ImmutableSpan -> Maybe Span
spanContext :: ImmutableSpan -> SpanContext
spanKind :: ImmutableSpan -> SpanKind
spanStart :: ImmutableSpan -> Timestamp
spanEnd :: ImmutableSpan -> Maybe Timestamp
spanAttributes :: ImmutableSpan -> Attributes
spanLinks :: ImmutableSpan -> AppendOnlyBoundedCollection Link
spanEvents :: ImmutableSpan -> AppendOnlyBoundedCollection Event
spanStatus :: ImmutableSpan -> SpanStatus
spanTracer :: ImmutableSpan -> Tracer
..} =
  Text -> [Text] -> Text
L.intercalate
    Text
" "
    [ String -> Text
L.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TraceId -> String
forall a. Show a => a -> String
show (TraceId -> String) -> TraceId -> String
forall a b. (a -> b) -> a -> b
$ SpanContext -> TraceId
traceId SpanContext
spanContext
    , String -> Text
L.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SpanId -> String
forall a. Show a => a -> String
show (SpanId -> String) -> SpanId -> String
forall a b. (a -> b) -> a -> b
$ SpanContext -> SpanId
spanId SpanContext
spanContext
    , String -> Text
L.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Timestamp -> String
forall a. Show a => a -> String
show Timestamp
spanStart
    , Text -> Text
L.fromStrict Text
spanName
    ]