{-|
Module: OpenTracing.Reporting.Pure

Reporters with no external components.
-}

{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData      #-}

module OpenTracing.Reporting.Pure
    ( noReporter
    , memReporter
    , newMem
    , newBoundedMem
    , memPeek
    , memTake
    )
where

import Control.Monad.IO.Class
import Data.IORef
import Data.Word
import OpenTracing.Span

-- | A null reporter which ignores anything it's given.
noReporter :: MonadIO m => FinishedSpan -> m ()
noReporter :: FinishedSpan -> m ()
noReporter = m () -> FinishedSpan -> m ()
forall a b. a -> b -> a
const (m () -> FinishedSpan -> m ()) -> m () -> FinishedSpan -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | A reporter which stores the finished spans in memory where
-- they wait to be consumed.
memReporter :: MonadIO m => Mem -> FinishedSpan -> m ()
memReporter :: Mem -> FinishedSpan -> m ()
memReporter Mem
m = 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
. Mem -> FinishedSpan -> IO ()
memAppend Mem
m

-- | Mem reporter state.
data Mem = Mem
    { Mem -> Maybe Word32
siz :: Maybe Word32
    , Mem -> IORef [FinishedSpan]
vec :: IORef [FinishedSpan]
    }

-- | Construct a new `memReporter` environment that can store an unbounded
-- seequence of `FinishedSpan`s.
newMem :: IO Mem
newMem :: IO Mem
newMem = Maybe Word32 -> IORef [FinishedSpan] -> Mem
Mem Maybe Word32
forall a. Maybe a
Nothing (IORef [FinishedSpan] -> Mem)
-> IO (IORef [FinishedSpan]) -> IO Mem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FinishedSpan] -> IO (IORef [FinishedSpan])
forall a. a -> IO (IORef a)
newIORef []

-- | Construct a new `memReporter` environment that stores a bounded
-- sequence of `FinishedSpan`s
newBoundedMem :: Word32 -> IO Mem
newBoundedMem :: Word32 -> IO Mem
newBoundedMem Word32
s = Maybe Word32 -> IORef [FinishedSpan] -> Mem
Mem (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
s) (IORef [FinishedSpan] -> Mem)
-> IO (IORef [FinishedSpan]) -> IO Mem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FinishedSpan] -> IO (IORef [FinishedSpan])
forall a. a -> IO (IORef a)
newIORef []

memAppend :: Mem -> FinishedSpan -> IO ()
memAppend :: Mem -> FinishedSpan -> IO ()
memAppend Mem{Maybe Word32
IORef [FinishedSpan]
vec :: IORef [FinishedSpan]
siz :: Maybe Word32
vec :: Mem -> IORef [FinishedSpan]
siz :: Mem -> Maybe Word32
..} FinishedSpan
x = IORef [FinishedSpan]
-> ([FinishedSpan] -> ([FinishedSpan], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [FinishedSpan]
vec (([FinishedSpan] -> ([FinishedSpan], ())) -> IO ())
-> ([FinishedSpan] -> ([FinishedSpan], ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[FinishedSpan]
xs ->
    let xs' :: [FinishedSpan]
xs' = case Maybe Word32
siz of
                  Maybe Word32
Nothing -> FinishedSpan
x FinishedSpan -> [FinishedSpan] -> [FinishedSpan]
forall a. a -> [a] -> [a]
: [FinishedSpan]
xs
                  Just  Word32
0 -> []
                  Just  Word32
1 -> [FinishedSpan
x]
                  Just  Word32
s -> FinishedSpan
x FinishedSpan -> [FinishedSpan] -> [FinishedSpan]
forall a. a -> [a] -> [a]
: Int -> [FinishedSpan] -> [FinishedSpan]
forall a. Int -> [a] -> [a]
take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [FinishedSpan]
xs
     in ([FinishedSpan]
xs', ())

-- | View the `FinishedSpans` in a `memReporter` without removing them.
memPeek :: Mem -> IO [FinishedSpan]
memPeek :: Mem -> IO [FinishedSpan]
memPeek Mem{IORef [FinishedSpan]
vec :: IORef [FinishedSpan]
vec :: Mem -> IORef [FinishedSpan]
vec} = IORef [FinishedSpan] -> IO [FinishedSpan]
forall a. IORef a -> IO a
readIORef IORef [FinishedSpan]
vec

-- | View and remove the `FinishedSpans` in a `memReporter`.
memTake :: Mem -> IO [FinishedSpan]
memTake :: Mem -> IO [FinishedSpan]
memTake Mem{IORef [FinishedSpan]
vec :: IORef [FinishedSpan]
vec :: Mem -> IORef [FinishedSpan]
vec} = IORef [FinishedSpan]
-> ([FinishedSpan] -> ([FinishedSpan], [FinishedSpan]))
-> IO [FinishedSpan]
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [FinishedSpan]
vec (([FinishedSpan] -> ([FinishedSpan], [FinishedSpan]))
 -> IO [FinishedSpan])
-> ([FinishedSpan] -> ([FinishedSpan], [FinishedSpan]))
-> IO [FinishedSpan]
forall a b. (a -> b) -> a -> b
$ (,) []