{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trace -> Trace -> Bool
$c/= :: Trace -> Trace -> Bool
== :: Trace -> Trace -> Bool
$c== :: Trace -> Trace -> Bool
Eq, Int -> Trace -> ShowS
[Trace] -> ShowS
Trace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trace] -> ShowS
$cshowList :: [Trace] -> ShowS
show :: Trace -> String
$cshow :: Trace -> String
showsPrec :: Int -> Trace -> ShowS
$cshowsPrec :: Int -> 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
forall b. Integral b => b -> Tracer -> Tracer
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Tracer -> Tracer
$cstimes :: forall b. Integral b => b -> Tracer -> Tracer
sconcat :: NonEmpty Tracer -> Tracer
$csconcat :: NonEmpty Tracer -> Tracer
<> :: Tracer -> Tracer -> Tracer
$c<> :: Tracer -> Tracer -> Tracer
Semigroup, Semigroup Tracer
Tracer
[Tracer] -> Tracer
Tracer -> Tracer -> Tracer
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Tracer] -> Tracer
$cmconcat :: [Tracer] -> Tracer
mappend :: Tracer -> Tracer -> Tracer
$cmappend :: Tracer -> Tracer -> Tracer
mempty :: Tracer
$cmempty :: 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 =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Tracer -> Trace -> IO ()
unTracer Tracer
tracer Trace
trace
{-# INLINE withTrace #-}