{-# 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.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           System.FS.CRC (CRC (..))
import           Test.Cardano.Slotting.TreeDiff ()
import           Test.Util.ToExpr ()

{-------------------------------------------------------------------------------
  ouroboros-network
-------------------------------------------------------------------------------}

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)

{-------------------------------------------------------------------------------
  ouroboros-consensus
-------------------------------------------------------------------------------}

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 CRC
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)


{-------------------------------------------------------------------------------
  si-timers
--------------------------------------------------------------------------------}

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)