{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module TestContainers.Trace
  ( -- * TestContainer traces
    Trace (..),

    -- * Tracer
    Tracer,
    newTracer,
    withTrace,
  )
where

import Control.Exception (IOException)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text (Text)
import System.Exit (ExitCode)

-- | Type representing various events during testcontainer execution.
data Trace
  = -- | The low-level invocation of @docker@ command
    --
    -- @
    --   TraceDockerInvocation args stdin exitcode
    -- @
    TraceDockerInvocation [Text] Text ExitCode -- docker [args] [stdin]
  | -- | Preparations to follow the logs for a certain container
    TraceDockerFollowLogs [Text] -- docker [args]
  | -- | Line written to STDOUT by a Docker process.
    TraceDockerStdout Text
  | -- | Line written to STDERR by a Docker process.
    TraceDockerStderr Text
  | -- | Waiting for a container to become ready. Attached with the
    -- timeout to wait (in seconds).
    TraceWaitUntilReady (Maybe Int)
  | -- | Opening socket
    TraceOpenSocket Text Int (Maybe IOException)
  | -- | Call HTTP endpoint
    TraceHttpCall Text Int (Either String Int)
  deriving stock (Trace -> Trace -> Bool
(Trace -> Trace -> Bool) -> (Trace -> Trace -> Bool) -> Eq Trace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Trace -> Trace -> Bool
== :: Trace -> Trace -> Bool
$c/= :: Trace -> Trace -> Bool
/= :: Trace -> Trace -> Bool
Eq, Int -> Trace -> ShowS
[Trace] -> ShowS
Trace -> String
(Int -> Trace -> ShowS)
-> (Trace -> String) -> ([Trace] -> ShowS) -> Show Trace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Trace -> ShowS
showsPrec :: Int -> Trace -> ShowS
$cshow :: Trace -> String
show :: Trace -> String
$cshowList :: [Trace] -> ShowS
showList :: [Trace] -> ShowS
Show)

-- | Traces execution within testcontainers library.
newtype Tracer = Tracer {Tracer -> Trace -> IO ()
unTracer :: Trace -> IO ()}
  deriving newtype (NonEmpty Tracer -> Tracer
Tracer -> Tracer -> Tracer
(Tracer -> Tracer -> Tracer)
-> (NonEmpty Tracer -> Tracer)
-> (forall b. Integral b => b -> Tracer -> Tracer)
-> Semigroup Tracer
forall b. Integral b => b -> Tracer -> Tracer
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Tracer -> Tracer -> Tracer
<> :: Tracer -> Tracer -> Tracer
$csconcat :: NonEmpty Tracer -> Tracer
sconcat :: NonEmpty Tracer -> Tracer
$cstimes :: forall b. Integral b => b -> Tracer -> Tracer
stimes :: forall b. Integral b => b -> Tracer -> Tracer
Semigroup, Semigroup Tracer
Tracer
Semigroup Tracer =>
Tracer
-> (Tracer -> Tracer -> Tracer)
-> ([Tracer] -> Tracer)
-> Monoid Tracer
[Tracer] -> Tracer
Tracer -> Tracer -> Tracer
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Tracer
mempty :: Tracer
$cmappend :: Tracer -> Tracer -> Tracer
mappend :: Tracer -> Tracer -> Tracer
$cmconcat :: [Tracer] -> Tracer
mconcat :: [Tracer] -> Tracer
Monoid)

-- | Construct a new `Tracer` from a tracing function.
newTracer ::
  (Trace -> IO ()) ->
  Tracer
newTracer :: (Trace -> IO ()) -> Tracer
newTracer Trace -> IO ()
action =
  Tracer
    { unTracer :: Trace -> IO ()
unTracer = Trace -> IO ()
action
    }

withTrace :: (MonadIO m) => Tracer -> Trace -> m ()
withTrace :: forall (m :: * -> *). MonadIO m => Tracer -> Trace -> m ()
withTrace Tracer
tracer Trace
trace =
  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
$ Tracer -> Trace -> IO ()
unTracer Tracer
tracer Trace
trace
{-# INLINE withTrace #-}