{-# LANGUAGE UndecidableInstances #-}

-- | Aggregates all tracing messages in a single type.
--
-- This module provides a central point where top-level traced messages are
-- grouped. This is useful for traces consumers that will need to do something
-- specific depending on various tracing messages, eg. monitoring and metrics
-- collection.
module Hydra.Logging.Messages where

import Hydra.Prelude

import Hydra.API.APIServerLog (APIServerLog)
import Hydra.Chain.Direct.Handlers (DirectChainLog)
import Hydra.Node (HydraNodeLog)
import Hydra.Node.Network (NetworkLog)
import Hydra.Options (RunOptions)

data HydraLog tx
  = DirectChain {forall tx. HydraLog tx -> DirectChainLog
directChain :: DirectChainLog}
  | APIServer {forall tx. HydraLog tx -> APIServerLog
api :: APIServerLog}
  | Network {forall tx. HydraLog tx -> NetworkLog
network :: NetworkLog}
  | Node {forall tx. HydraLog tx -> HydraNodeLog tx
node :: HydraNodeLog tx}
  | NodeOptions {forall tx. HydraLog tx -> RunOptions
runOptions :: RunOptions}
  | EnteringMainloop
  deriving stock ((forall x. HydraLog tx -> Rep (HydraLog tx) x)
-> (forall x. Rep (HydraLog tx) x -> HydraLog tx)
-> Generic (HydraLog tx)
forall x. Rep (HydraLog tx) x -> HydraLog tx
forall x. HydraLog tx -> Rep (HydraLog tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (HydraLog tx) x -> HydraLog tx
forall tx x. HydraLog tx -> Rep (HydraLog tx) x
$cfrom :: forall tx x. HydraLog tx -> Rep (HydraLog tx) x
from :: forall x. HydraLog tx -> Rep (HydraLog tx) x
$cto :: forall tx x. Rep (HydraLog tx) x -> HydraLog tx
to :: forall x. Rep (HydraLog tx) x -> HydraLog tx
Generic)

deriving stock instance Eq (HydraNodeLog tx) => Eq (HydraLog tx)
deriving stock instance Show (HydraNodeLog tx) => Show (HydraLog tx)
deriving anyclass instance ToJSON (HydraNodeLog tx) => ToJSON (HydraLog tx)

instance Arbitrary (HydraNodeLog tx) => Arbitrary (HydraLog tx) where
  arbitrary :: Gen (HydraLog tx)
arbitrary = Gen (HydraLog tx)
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary
  shrink :: HydraLog tx -> [HydraLog tx]
shrink = HydraLog tx -> [HydraLog tx]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink