{-# LANGUAGE DeriveGeneric #-}
module Ouroboros.Consensus.Storage.LedgerDB.Types (
    PushGoal (..)
  , PushStart (..)
  , Pushing (..)
  , UpdateLedgerDbTraceEvent (..)
  ) where


import           GHC.Generics (Generic)
import           Ouroboros.Consensus.Block.RealPoint (RealPoint)

{-------------------------------------------------------------------------------
  Trace events
-------------------------------------------------------------------------------}
newtype PushStart blk = PushStart { PushStart blk -> RealPoint blk
unPushStart :: RealPoint blk }
  deriving (Int -> PushStart blk -> ShowS
[PushStart blk] -> ShowS
PushStart blk -> String
(Int -> PushStart blk -> ShowS)
-> (PushStart blk -> String)
-> ([PushStart blk] -> ShowS)
-> Show (PushStart blk)
forall blk. StandardHash blk => Int -> PushStart blk -> ShowS
forall blk. StandardHash blk => [PushStart blk] -> ShowS
forall blk. StandardHash blk => PushStart blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PushStart blk] -> ShowS
$cshowList :: forall blk. StandardHash blk => [PushStart blk] -> ShowS
show :: PushStart blk -> String
$cshow :: forall blk. StandardHash blk => PushStart blk -> String
showsPrec :: Int -> PushStart blk -> ShowS
$cshowsPrec :: forall blk. StandardHash blk => Int -> PushStart blk -> ShowS
Show, PushStart blk -> PushStart blk -> Bool
(PushStart blk -> PushStart blk -> Bool)
-> (PushStart blk -> PushStart blk -> Bool) -> Eq (PushStart blk)
forall blk.
StandardHash blk =>
PushStart blk -> PushStart blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PushStart blk -> PushStart blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
PushStart blk -> PushStart blk -> Bool
== :: PushStart blk -> PushStart blk -> Bool
$c== :: forall blk.
StandardHash blk =>
PushStart blk -> PushStart blk -> Bool
Eq)

newtype PushGoal blk = PushGoal { PushGoal blk -> RealPoint blk
unPushGoal :: RealPoint blk }
  deriving (Int -> PushGoal blk -> ShowS
[PushGoal blk] -> ShowS
PushGoal blk -> String
(Int -> PushGoal blk -> ShowS)
-> (PushGoal blk -> String)
-> ([PushGoal blk] -> ShowS)
-> Show (PushGoal blk)
forall blk. StandardHash blk => Int -> PushGoal blk -> ShowS
forall blk. StandardHash blk => [PushGoal blk] -> ShowS
forall blk. StandardHash blk => PushGoal blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PushGoal blk] -> ShowS
$cshowList :: forall blk. StandardHash blk => [PushGoal blk] -> ShowS
show :: PushGoal blk -> String
$cshow :: forall blk. StandardHash blk => PushGoal blk -> String
showsPrec :: Int -> PushGoal blk -> ShowS
$cshowsPrec :: forall blk. StandardHash blk => Int -> PushGoal blk -> ShowS
Show, PushGoal blk -> PushGoal blk -> Bool
(PushGoal blk -> PushGoal blk -> Bool)
-> (PushGoal blk -> PushGoal blk -> Bool) -> Eq (PushGoal blk)
forall blk.
StandardHash blk =>
PushGoal blk -> PushGoal blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PushGoal blk -> PushGoal blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
PushGoal blk -> PushGoal blk -> Bool
== :: PushGoal blk -> PushGoal blk -> Bool
$c== :: forall blk.
StandardHash blk =>
PushGoal blk -> PushGoal blk -> Bool
Eq)

newtype Pushing blk = Pushing { Pushing blk -> RealPoint blk
unPushing :: RealPoint blk }
  deriving (Int -> Pushing blk -> ShowS
[Pushing blk] -> ShowS
Pushing blk -> String
(Int -> Pushing blk -> ShowS)
-> (Pushing blk -> String)
-> ([Pushing blk] -> ShowS)
-> Show (Pushing blk)
forall blk. StandardHash blk => Int -> Pushing blk -> ShowS
forall blk. StandardHash blk => [Pushing blk] -> ShowS
forall blk. StandardHash blk => Pushing blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pushing blk] -> ShowS
$cshowList :: forall blk. StandardHash blk => [Pushing blk] -> ShowS
show :: Pushing blk -> String
$cshow :: forall blk. StandardHash blk => Pushing blk -> String
showsPrec :: Int -> Pushing blk -> ShowS
$cshowsPrec :: forall blk. StandardHash blk => Int -> Pushing blk -> ShowS
Show, Pushing blk -> Pushing blk -> Bool
(Pushing blk -> Pushing blk -> Bool)
-> (Pushing blk -> Pushing blk -> Bool) -> Eq (Pushing blk)
forall blk. StandardHash blk => Pushing blk -> Pushing blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pushing blk -> Pushing blk -> Bool
$c/= :: forall blk. StandardHash blk => Pushing blk -> Pushing blk -> Bool
== :: Pushing blk -> Pushing blk -> Bool
$c== :: forall blk. StandardHash blk => Pushing blk -> Pushing blk -> Bool
Eq)

data UpdateLedgerDbTraceEvent blk =
    -- | Event fired when we are about to push a block to the LedgerDB
      StartedPushingBlockToTheLedgerDb
        !(PushStart blk)
        -- ^ Point from which we started pushing new blocks
        (PushGoal blk)
        -- ^ Point to which we are updating the ledger, the last event
        -- StartedPushingBlockToTheLedgerDb will have Pushing and PushGoal
        -- wrapping over the same RealPoint
        !(Pushing blk)
        -- ^ Point which block we are about to push
  deriving (Int -> UpdateLedgerDbTraceEvent blk -> ShowS
[UpdateLedgerDbTraceEvent blk] -> ShowS
UpdateLedgerDbTraceEvent blk -> String
(Int -> UpdateLedgerDbTraceEvent blk -> ShowS)
-> (UpdateLedgerDbTraceEvent blk -> String)
-> ([UpdateLedgerDbTraceEvent blk] -> ShowS)
-> Show (UpdateLedgerDbTraceEvent blk)
forall blk.
StandardHash blk =>
Int -> UpdateLedgerDbTraceEvent blk -> ShowS
forall blk.
StandardHash blk =>
[UpdateLedgerDbTraceEvent blk] -> ShowS
forall blk.
StandardHash blk =>
UpdateLedgerDbTraceEvent blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLedgerDbTraceEvent blk] -> ShowS
$cshowList :: forall blk.
StandardHash blk =>
[UpdateLedgerDbTraceEvent blk] -> ShowS
show :: UpdateLedgerDbTraceEvent blk -> String
$cshow :: forall blk.
StandardHash blk =>
UpdateLedgerDbTraceEvent blk -> String
showsPrec :: Int -> UpdateLedgerDbTraceEvent blk -> ShowS
$cshowsPrec :: forall blk.
StandardHash blk =>
Int -> UpdateLedgerDbTraceEvent blk -> ShowS
Show, UpdateLedgerDbTraceEvent blk
-> UpdateLedgerDbTraceEvent blk -> Bool
(UpdateLedgerDbTraceEvent blk
 -> UpdateLedgerDbTraceEvent blk -> Bool)
-> (UpdateLedgerDbTraceEvent blk
    -> UpdateLedgerDbTraceEvent blk -> Bool)
-> Eq (UpdateLedgerDbTraceEvent blk)
forall blk.
StandardHash blk =>
UpdateLedgerDbTraceEvent blk
-> UpdateLedgerDbTraceEvent blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLedgerDbTraceEvent blk
-> UpdateLedgerDbTraceEvent blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
UpdateLedgerDbTraceEvent blk
-> UpdateLedgerDbTraceEvent blk -> Bool
== :: UpdateLedgerDbTraceEvent blk
-> UpdateLedgerDbTraceEvent blk -> Bool
$c== :: forall blk.
StandardHash blk =>
UpdateLedgerDbTraceEvent blk
-> UpdateLedgerDbTraceEvent blk -> Bool
Eq, (forall x.
 UpdateLedgerDbTraceEvent blk
 -> Rep (UpdateLedgerDbTraceEvent blk) x)
-> (forall x.
    Rep (UpdateLedgerDbTraceEvent blk) x
    -> UpdateLedgerDbTraceEvent blk)
-> Generic (UpdateLedgerDbTraceEvent blk)
forall x.
Rep (UpdateLedgerDbTraceEvent blk) x
-> UpdateLedgerDbTraceEvent blk
forall x.
UpdateLedgerDbTraceEvent blk
-> Rep (UpdateLedgerDbTraceEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (UpdateLedgerDbTraceEvent blk) x
-> UpdateLedgerDbTraceEvent blk
forall blk x.
UpdateLedgerDbTraceEvent blk
-> Rep (UpdateLedgerDbTraceEvent blk) x
$cto :: forall blk x.
Rep (UpdateLedgerDbTraceEvent blk) x
-> UpdateLedgerDbTraceEvent blk
$cfrom :: forall blk x.
UpdateLedgerDbTraceEvent blk
-> Rep (UpdateLedgerDbTraceEvent blk) x
Generic)