{-|
Module: OpenTracing.Reporting.Stdio

Logging reporters that emit spans to stdout, stderr and System.IO `Handles`.
-}
{-# LANGUAGE CPP               #-}
{-# 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
#if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.Key as Key
#endif
import Data.ByteString.Lazy.Char8 (hPutStrLn)
import Data.Foldable              (toList)
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 :: forall (m :: * -> *). MonadIO m => FinishedSpan -> m ()
stdoutReporter = 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 :: forall (m :: * -> *). MonadIO m => FinishedSpan -> m ()
stderrReporter = 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 :: forall (m :: * -> *). MonadIO m => Handle -> FinishedSpan -> m ()
stdioReporter Handle
h = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ByteString -> IO ()
hPutStrLn Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoding' a -> ByteString
encodingToLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinishedSpan -> Encoding
spanE


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

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

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

logFieldE :: LogField -> Encoding
logFieldE :: LogField -> Encoding
logFieldE LogField
f = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Encoding -> Series
pair Key
key forall a b. (a -> b) -> a -> b
$ case LogField
f of
    Event      Text
x -> forall a. Text -> Encoding' a
text Text
x
    Message    Text
x -> forall a. Text -> Encoding' a
text Text
x
    Stack      CallStack
x -> forall a. String -> Encoding' a
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> String
prettyCallStack forall a b. (a -> b) -> a -> b
$ CallStack
x
    ErrKind    Text
x -> forall a. Text -> Encoding' a
text Text
x
    ErrObj     e
x -> forall a. String -> Encoding' a
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ e
x
    LogField Text
_ a
x -> forall a. String -> Encoding' a
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ a
x
  where
#if MIN_VERSION_aeson(2, 0, 0)
    key :: Key
key = Text -> Key
Key.fromText forall a b. (a -> b) -> a -> b
$ LogField -> Text
logFieldLabel LogField
f
#else
    key = logFieldLabel f
#endif