{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Logging.Tracer.Forward
  (
    forwardTracer
  ) where

import           Cardano.Logging.DocuGenerator
import           Cardano.Logging.Types

import           Control.Monad.IO.Class
import qualified Control.Tracer as T


---------------------------------------------------------------------------

-- | It is mandatory to construct only one forwardTracer tracer in any application!
-- Throwing away a forwardTracer tracer and using a new one will result in an exception
forwardTracer :: forall m. (MonadIO m)
  => (TraceObject -> IO ())
  -> Trace m FormattedMessage
forwardTracer :: forall (m :: * -> *).
MonadIO m =>
(TraceObject -> IO ()) -> Trace m FormattedMessage
forwardTracer TraceObject -> IO ()
write =
  Tracer m (LoggingContext, Either TraceControl FormattedMessage)
-> Trace m FormattedMessage
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace (Tracer m (LoggingContext, Either TraceControl FormattedMessage)
 -> Trace m FormattedMessage)
-> Tracer m (LoggingContext, Either TraceControl FormattedMessage)
-> Trace m FormattedMessage
forall a b. (a -> b) -> a -> b
$ TracerA m (LoggingContext, Either TraceControl FormattedMessage) ()
-> Tracer m (LoggingContext, Either TraceControl FormattedMessage)
forall (m :: * -> *) a. TracerA m a () -> Tracer m a
T.arrow (TracerA
   m (LoggingContext, Either TraceControl FormattedMessage) ()
 -> Tracer m (LoggingContext, Either TraceControl FormattedMessage))
-> TracerA
     m (LoggingContext, Either TraceControl FormattedMessage) ()
-> Tracer m (LoggingContext, Either TraceControl FormattedMessage)
forall a b. (a -> b) -> a -> b
$ ((LoggingContext, Either TraceControl FormattedMessage) -> m ())
-> TracerA
     m (LoggingContext, Either TraceControl FormattedMessage) ()
forall (m :: * -> *) a.
Applicative m =>
(a -> m ()) -> TracerA m a ()
T.emit (((LoggingContext, Either TraceControl FormattedMessage) -> m ())
 -> TracerA
      m (LoggingContext, Either TraceControl FormattedMessage) ())
-> ((LoggingContext, Either TraceControl FormattedMessage) -> m ())
-> TracerA
     m (LoggingContext, Either TraceControl FormattedMessage) ()
forall a b. (a -> b) -> a -> b
$ (LoggingContext -> Either TraceControl FormattedMessage -> m ())
-> (LoggingContext, Either TraceControl FormattedMessage) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LoggingContext -> Either TraceControl FormattedMessage -> m ()
output
 where
  output ::
       LoggingContext
    -> Either TraceControl FormattedMessage
    -> m ()
  output :: LoggingContext -> Either TraceControl FormattedMessage -> m ()
output LoggingContext {} (Right (FormattedForwarder TraceObject
lo)) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    TraceObject -> IO ()
write TraceObject
lo
  output LoggingContext {} (Left TraceControl
TCReset) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  output LoggingContext
lk (Left c :: TraceControl
c@TCDocument {}) =
    BackendConfig -> (LoggingContext, Either TraceControl Any) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
BackendConfig -> (LoggingContext, Either TraceControl a) -> m ()
docIt BackendConfig
Forwarder (LoggingContext
lk, TraceControl -> Either TraceControl Any
forall a b. a -> Either a b
Left TraceControl
c)
  output LoggingContext {} (Right FormattedMessage
_)  = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  output LoggingContext {} Either TraceControl FormattedMessage
_  = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()