{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.Util.Orphans.ToExpr () where
import qualified Control.Monad.Class.MonadTime.SI as SI
import Data.TreeDiff
import GHC.Generics (Generic)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Storage.ChainDB (InvalidBlockReason)
import Ouroboros.Consensus.Storage.ChainDB.API (LoE (..))
import Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB
import Ouroboros.Consensus.Storage.ImmutableDB
import Ouroboros.Consensus.Util.STM (Fingerprint, WithFingerprint)
import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
import qualified Ouroboros.Network.AnchoredFragment as Fragment
import Ouroboros.Network.Block (MaxSlotNo)
import Ouroboros.Network.Mock.Chain
import Ouroboros.Network.Mock.ProducerState
import Ouroboros.Network.Point
import System.FS.API
import Test.Cardano.Slotting.TreeDiff ()
import Test.Util.ToExpr ()
instance ToExpr (HeaderHash blk) => ToExpr (Point blk)
instance ToExpr (HeaderHash blk) => ToExpr (RealPoint blk)
instance (ToExpr slot, ToExpr hash) => ToExpr (Block slot hash)
deriving instance ( ToExpr blk
, ToExpr (HeaderHash blk)
)
=> ToExpr (Fragment.Anchor blk)
instance (ToExpr blk, ToExpr (HeaderHash blk)) => ToExpr (AnchoredFragment blk) where
toExpr :: AnchoredFragment blk -> Expr
toExpr AnchoredFragment blk
f = (Anchor blk, [blk]) -> Expr
forall a. ToExpr a => a -> Expr
toExpr (AnchoredFragment blk -> Anchor blk
forall v a b. AnchoredSeq v a b -> a
Fragment.anchor AnchoredFragment blk
f, AnchoredFragment blk -> [blk]
forall v a b. AnchoredSeq v a b -> [b]
Fragment.toOldestFirst AnchoredFragment blk
f)
instance ( ToExpr (LedgerState blk)
, ToExpr (ChainDepState (BlockProtocol blk))
, ToExpr (TipInfo blk)
) => ToExpr (ExtLedgerState blk)
instance ( ToExpr (ChainDepState (BlockProtocol blk))
, ToExpr (TipInfo blk)
) => ToExpr (HeaderState blk)
instance ( ToExpr (TipInfo blk)
) => ToExpr (AnnTip blk)
instance ToExpr SecurityParam
instance ToExpr DiskSnapshot
instance ToExpr ChunkSize
instance ToExpr ChunkNo
instance ToExpr ChunkSlot
instance ToExpr RelativeSlot
instance (ToExpr a, ToExpr b, ToExpr c, ToExpr d, ToExpr e, ToExpr f, ToExpr g,
ToExpr h, ToExpr i, ToExpr j)
=> ToExpr (a, b, c, d, e, f, g, h, i, j) where
toExpr :: (a, b, c, d, e, f, g, h, i, j) -> Expr
toExpr (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = String -> [Expr] -> Expr
App String
"_×_×_×_×_×_×_×_×_x_"
[ a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
a, b -> Expr
forall a. ToExpr a => a -> Expr
toExpr b
b, c -> Expr
forall a. ToExpr a => a -> Expr
toExpr c
c, d -> Expr
forall a. ToExpr a => a -> Expr
toExpr d
d, e -> Expr
forall a. ToExpr a => a -> Expr
toExpr e
e, f -> Expr
forall a. ToExpr a => a -> Expr
toExpr f
f, g -> Expr
forall a. ToExpr a => a -> Expr
toExpr g
g
, h -> Expr
forall a. ToExpr a => a -> Expr
toExpr h
h, i -> Expr
forall a. ToExpr a => a -> Expr
toExpr i
i, j -> Expr
forall a. ToExpr a => a -> Expr
toExpr j
j
]
instance ToExpr ChunkInfo where
toExpr :: ChunkInfo -> Expr
toExpr = ChunkInfo -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr FsError where
toExpr :: FsError -> Expr
toExpr FsError
fsError = String -> [Expr] -> Expr
App (FsError -> String
forall a. Show a => a -> String
show FsError
fsError) []
deriving instance ToExpr a => ToExpr (LoE a)
instance ToExpr SI.Time where toExpr :: Time -> Expr
toExpr = Time -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
deriving anyclass instance ToExpr Fingerprint
deriving anyclass instance ToExpr FollowerNext
deriving anyclass instance ToExpr MaxSlotNo
deriving instance ToExpr (HeaderHash blk) => ToExpr (ChainHash blk)
deriving instance ToExpr (HeaderHash blk) => ToExpr (FollowerState blk)
deriving instance Generic FollowerNext
deriving instance Generic (Chain blk)
deriving instance Generic (ChainProducerState blk)
deriving instance Generic (FollowerState blk)
deriving instance ToExpr blk => ToExpr (Chain blk)
deriving instance ( ToExpr blk
, ToExpr (HeaderHash blk)
)
=> ToExpr (ChainProducerState blk)
deriving instance ToExpr a => ToExpr (WithFingerprint a)
deriving instance ( ToExpr (HeaderHash blk)
, ToExpr (ExtValidationError blk)
)
=> ToExpr (InvalidBlockReason blk)