{-|
Module: OpenTracing.Reporting.Stdio

Logging reporters that emit spans to stdout, stderr and System.IO `Handles`.
-}
{-# LANGUAGE OverloadedStrings #-}

module OpenTracing.Reporting.Stdio
    ( stdoutReporter
    , stderrReporter
    , stdioReporter
    )
where

import Control.Lens               (view)
import Control.Monad.IO.Class
import Data.Aeson                 (toEncoding)
import Data.Aeson.Encoding
import Data.ByteString.Lazy.Char8 (hPutStrLn)
import Data.Foldable              (toList)
import Data.Semigroup             ((<>))
import GHC.Stack                  (prettyCallStack)
import OpenTracing.Log
import OpenTracing.Span
import System.IO                  (Handle, stderr, stdout)

-- | Implementation of `OpenTracing.Tracer.tracerReport` that logs `FinishedSpan`s to
-- stdout
stdoutReporter :: MonadIO m => FinishedSpan -> m ()
stdoutReporter :: FinishedSpan -> m ()
stdoutReporter = Handle -> FinishedSpan -> m ()
forall (m :: * -> *). MonadIO m => Handle -> FinishedSpan -> m ()
stdioReporter Handle
stdout

-- | Implementation of `OpenTracing.Tracer.tracerReport` that logs `FinishedSpan`s to
-- stderr
stderrReporter :: MonadIO m => FinishedSpan -> m ()
stderrReporter :: FinishedSpan -> m ()
stderrReporter = Handle -> FinishedSpan -> m ()
forall (m :: * -> *). MonadIO m => Handle -> FinishedSpan -> m ()
stdioReporter Handle
stderr

-- | Implementation of `OpenTracing.Tracer.tracerReport` that logs `FinishedSpan`s to
-- a `Handle`.
stdioReporter :: MonadIO m => Handle -> FinishedSpan -> m ()
stdioReporter :: Handle -> FinishedSpan -> m ()
stdioReporter Handle
h = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (FinishedSpan -> IO ()) -> FinishedSpan -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ByteString -> IO ()
hPutStrLn Handle
h (ByteString -> IO ())
-> (FinishedSpan -> ByteString) -> FinishedSpan -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding' Value -> ByteString
forall a. Encoding' a -> ByteString
encodingToLazyByteString (Encoding' Value -> ByteString)
-> (FinishedSpan -> Encoding' Value) -> FinishedSpan -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinishedSpan -> Encoding' Value
spanE


spanE :: FinishedSpan -> Encoding
spanE :: FinishedSpan -> Encoding' Value
spanE FinishedSpan
s = Series -> Encoding' Value
pairs (Series -> Encoding' Value) -> Series -> Encoding' Value
forall a b. (a -> b) -> a -> b
$
       Text -> Encoding' Value -> Series
pair Text
"operation"  (Text -> Encoding' Value
forall a. Text -> Encoding' a
text (Text -> Encoding' Value) -> Text -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Getting Text FinishedSpan Text -> FinishedSpan -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text FinishedSpan Text
forall a. HasSpanFields a => Lens' a Text
spanOperation FinishedSpan
s)
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding' Value -> Series
pair Text
"start"      (UTCTime -> Encoding' Value
forall a. UTCTime -> Encoding' a
utcTime (UTCTime -> Encoding' Value) -> UTCTime -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Getting UTCTime FinishedSpan UTCTime -> FinishedSpan -> UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UTCTime FinishedSpan UTCTime
forall a. HasSpanFields a => Lens' a UTCTime
spanStart FinishedSpan
s)
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding' Value -> Series
pair Text
"duration"   (Double -> Encoding' Value
double (Double -> Encoding' Value)
-> (NominalDiffTime -> Double)
-> NominalDiffTime
-> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> Encoding' Value)
-> NominalDiffTime -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Getting NominalDiffTime FinishedSpan NominalDiffTime
-> FinishedSpan -> NominalDiffTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NominalDiffTime FinishedSpan NominalDiffTime
Lens' FinishedSpan NominalDiffTime
spanDuration FinishedSpan
s)
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding' Value -> Series
pair Text
"context"    (SpanContext -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
toEncoding (SpanContext -> Encoding' Value) -> SpanContext -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Getting SpanContext FinishedSpan SpanContext
-> FinishedSpan -> SpanContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SpanContext FinishedSpan SpanContext
forall a. HasSpanFields a => Lens' a SpanContext
spanContext FinishedSpan
s)
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding' Value -> Series
pair Text
"references" ((Reference -> Encoding' Value) -> [Reference] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
list Reference -> Encoding' Value
refE ([Reference] -> Encoding' Value)
-> ([Reference] -> [Reference]) -> [Reference] -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Reference] -> [Reference]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Reference] -> Encoding' Value) -> [Reference] -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Getting [Reference] FinishedSpan [Reference]
-> FinishedSpan -> [Reference]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Reference] FinishedSpan [Reference]
forall s a. HasRefs s a => Lens' s a
spanRefs FinishedSpan
s)
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding' Value -> Series
pair Text
"tags"       (Tags -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
toEncoding (Tags -> Encoding' Value) -> Tags -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Getting Tags FinishedSpan Tags -> FinishedSpan -> Tags
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Tags FinishedSpan Tags
forall a. HasSpanFields a => Lens' a Tags
spanTags FinishedSpan
s)
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding' Value -> Series
pair Text
"logs"       ((LogRecord -> Encoding' Value) -> [LogRecord] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
list LogRecord -> Encoding' Value
logRecE ([LogRecord] -> Encoding' Value)
-> ([LogRecord] -> [LogRecord]) -> [LogRecord] -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LogRecord] -> [LogRecord]
forall a. [a] -> [a]
reverse ([LogRecord] -> Encoding' Value) -> [LogRecord] -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Getting [LogRecord] FinishedSpan [LogRecord]
-> FinishedSpan -> [LogRecord]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [LogRecord] FinishedSpan [LogRecord]
forall a. HasSpanFields a => Lens' a [LogRecord]
spanLogs FinishedSpan
s)

refE :: Reference -> Encoding
refE :: Reference -> Encoding' Value
refE (ChildOf     SpanContext
ctx) = Series -> Encoding' Value
pairs (Series -> Encoding' Value)
-> (SpanContext -> Series) -> SpanContext -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding' Value -> Series
pair Text
"child_of"     (Encoding' Value -> Series)
-> (SpanContext -> Encoding' Value) -> SpanContext -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanContext -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
toEncoding (SpanContext -> Encoding' Value) -> SpanContext -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ SpanContext
ctx
refE (FollowsFrom SpanContext
ctx) = Series -> Encoding' Value
pairs (Series -> Encoding' Value)
-> (SpanContext -> Series) -> SpanContext -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding' Value -> Series
pair Text
"follows_from" (Encoding' Value -> Series)
-> (SpanContext -> Encoding' Value) -> SpanContext -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanContext -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
toEncoding (SpanContext -> Encoding' Value) -> SpanContext -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ SpanContext
ctx

logRecE :: LogRecord -> Encoding
logRecE :: LogRecord -> Encoding' Value
logRecE LogRecord
r = Series -> Encoding' Value
pairs (Series -> Encoding' Value) -> Series -> Encoding' Value
forall a b. (a -> b) -> a -> b
$
       Text -> Encoding' Value -> Series
pair Text
"time"   (UTCTime -> Encoding' Value
forall a. UTCTime -> Encoding' a
utcTime (Getting UTCTime LogRecord UTCTime -> LogRecord -> UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UTCTime LogRecord UTCTime
Lens' LogRecord UTCTime
logTime LogRecord
r))
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding' Value -> Series
pair Text
"fields" ((LogField -> Encoding' Value) -> [LogField] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
list LogField -> Encoding' Value
logFieldE ([LogField] -> Encoding' Value)
-> (NonEmpty LogField -> [LogField])
-> NonEmpty LogField
-> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty LogField -> [LogField]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty LogField -> Encoding' Value)
-> NonEmpty LogField -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Getting (NonEmpty LogField) LogRecord (NonEmpty LogField)
-> LogRecord -> NonEmpty LogField
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (NonEmpty LogField) LogRecord (NonEmpty LogField)
Lens' LogRecord (NonEmpty LogField)
logFields LogRecord
r)

logFieldE :: LogField -> Encoding
logFieldE :: LogField -> Encoding' Value
logFieldE LogField
f = Series -> Encoding' Value
pairs (Series -> Encoding' Value)
-> (Encoding' Value -> Series)
-> Encoding' Value
-> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding' Value -> Series
pair (LogField -> Text
logFieldLabel LogField
f) (Encoding' Value -> Encoding' Value)
-> Encoding' Value -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ case LogField
f of
    Event      Text
x -> Text -> Encoding' Value
forall a. Text -> Encoding' a
text Text
x
    Message    Text
x -> Text -> Encoding' Value
forall a. Text -> Encoding' a
text Text
x
    Stack      CallStack
x -> String -> Encoding' Value
forall a. String -> Encoding' a
string (String -> Encoding' Value)
-> (CallStack -> String) -> CallStack -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> String
prettyCallStack (CallStack -> Encoding' Value) -> CallStack -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ CallStack
x
    ErrKind    Text
x -> Text -> Encoding' Value
forall a. Text -> Encoding' a
text Text
x
    ErrObj     e
x -> String -> Encoding' Value
forall a. String -> Encoding' a
string (String -> Encoding' Value)
-> (e -> String) -> e -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall a. Show a => a -> String
show (e -> Encoding' Value) -> e -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ e
x
    LogField Text
_ a
x -> String -> Encoding' Value
forall a. String -> Encoding' a
string (String -> Encoding' Value)
-> (a -> String) -> a -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> Encoding' Value) -> a -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ a
x