{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Babbage.TreeDiff (
  module Test.Cardano.Ledger.Alonzo.TreeDiff,
) where

import Cardano.Ledger.Address
import Cardano.Ledger.Alonzo.Rules
import Cardano.Ledger.Babbage (BabbageEra)
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.PParams
import Cardano.Ledger.Babbage.Rules
import Cardano.Ledger.Babbage.TxBody
import Cardano.Ledger.Babbage.TxInfo (BabbageContextError (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Compactible
import Cardano.Ledger.Shelley.Rules
import qualified Data.TreeDiff.OMap as OMap
import Test.Cardano.Ledger.Alonzo.TreeDiff

-- Core
deriving newtype instance ToExpr CoinPerByte

-- Scripts
instance ToExpr (PlutusScript BabbageEra)

-- PlutusContext
instance ToExpr (PlutusPurpose AsIx era) => ToExpr (BabbageContextError era)

-- PParams
instance ToExpr (BabbagePParams StrictMaybe era)

instance ToExpr (BabbagePParams Identity era)

-- TxOut
instance
  ( ToExpr CompactAddr
  , ToExpr (CompactForm (Value era))
  , ToExpr (Script era)
  ) =>
  ToExpr (BabbageTxOut era)

-- TxBody
instance ToExpr (BabbageTxBodyRaw TopTx BabbageEra) where
  toExpr :: BabbageTxBodyRaw TopTx BabbageEra -> Expr
toExpr BabbageTxBodyRaw {Set (KeyHash Guard)
Set TxIn
StrictMaybe ScriptIntegrityHash
StrictMaybe TxAuxDataHash
StrictMaybe (Sized (TxOut BabbageEra))
StrictMaybe Network
StrictMaybe Coin
StrictMaybe (Update BabbageEra)
ValidityInterval
Withdrawals
Coin
MultiAsset
StrictSeq (TxCert BabbageEra)
StrictSeq (Sized (TxOut BabbageEra))
btbrInputs :: Set TxIn
btbrCollateralInputs :: Set TxIn
btbrReferenceInputs :: Set TxIn
btbrOutputs :: StrictSeq (Sized (TxOut BabbageEra))
btbrCollateralReturn :: StrictMaybe (Sized (TxOut BabbageEra))
btbrTotalCollateral :: StrictMaybe Coin
btbrCerts :: StrictSeq (TxCert BabbageEra)
btbrWithdrawals :: Withdrawals
btbrFee :: Coin
btbrValidityInterval :: ValidityInterval
btbrUpdate :: StrictMaybe (Update BabbageEra)
btbrReqSignerHashes :: Set (KeyHash Guard)
btbrMint :: MultiAsset
btbrScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
btbrAuxDataHash :: StrictMaybe TxAuxDataHash
btbrNetworkId :: StrictMaybe Network
btbrNetworkId :: forall era. BabbageTxBodyRaw TopTx era -> StrictMaybe Network
btbrAuxDataHash :: forall era. BabbageTxBodyRaw TopTx era -> StrictMaybe TxAuxDataHash
btbrScriptIntegrityHash :: forall era.
BabbageTxBodyRaw TopTx era -> StrictMaybe ScriptIntegrityHash
btbrMint :: forall era. BabbageTxBodyRaw TopTx era -> MultiAsset
btbrReqSignerHashes :: forall era. BabbageTxBodyRaw TopTx era -> Set (KeyHash Guard)
btbrUpdate :: forall era. BabbageTxBodyRaw TopTx era -> StrictMaybe (Update era)
btbrValidityInterval :: forall era. BabbageTxBodyRaw TopTx era -> ValidityInterval
btbrFee :: forall era. BabbageTxBodyRaw TopTx era -> Coin
btbrWithdrawals :: forall era. BabbageTxBodyRaw TopTx era -> Withdrawals
btbrCerts :: forall era. BabbageTxBodyRaw TopTx era -> StrictSeq (TxCert era)
btbrTotalCollateral :: forall era. BabbageTxBodyRaw TopTx era -> StrictMaybe Coin
btbrCollateralReturn :: forall era.
BabbageTxBodyRaw TopTx era -> StrictMaybe (Sized (TxOut era))
btbrOutputs :: forall era.
BabbageTxBodyRaw TopTx era -> StrictSeq (Sized (TxOut era))
btbrReferenceInputs :: forall era. BabbageTxBodyRaw TopTx era -> Set TxIn
btbrCollateralInputs :: forall era. BabbageTxBodyRaw TopTx era -> Set TxIn
btbrInputs :: forall era. BabbageTxBodyRaw TopTx era -> Set TxIn
..} =
    FieldName -> OMap FieldName Expr -> Expr
Rec FieldName
"BabbageTxBodyRaw" (OMap FieldName Expr -> Expr) -> OMap FieldName Expr -> Expr
forall a b. (a -> b) -> a -> b
$
      [(FieldName, Expr)] -> OMap FieldName Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList
        [ (FieldName
"btbrInputs", Set TxIn -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set TxIn
btbrInputs)
        , (FieldName
"btbrCollateralInputs", Set TxIn -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set TxIn
btbrCollateralInputs)
        , (FieldName
"btbrReferenceInputs", Set TxIn -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set TxIn
btbrReferenceInputs)
        , (FieldName
"btbrOutputs", StrictSeq (Sized (BabbageTxOut BabbageEra)) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictSeq (Sized (TxOut BabbageEra))
StrictSeq (Sized (BabbageTxOut BabbageEra))
btbrOutputs)
        , (FieldName
"btbrCollateralReturn", StrictMaybe (Sized (BabbageTxOut BabbageEra)) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe (Sized (TxOut BabbageEra))
StrictMaybe (Sized (BabbageTxOut BabbageEra))
btbrCollateralReturn)
        , (FieldName
"btbrTotalCollateral", StrictMaybe Coin -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe Coin
btbrTotalCollateral)
        , (FieldName
"btbrCerts", StrictSeq (ShelleyTxCert BabbageEra) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictSeq (TxCert BabbageEra)
StrictSeq (ShelleyTxCert BabbageEra)
btbrCerts)
        , (FieldName
"btbrWithdrawals", Withdrawals -> Expr
forall a. ToExpr a => a -> Expr
toExpr Withdrawals
btbrWithdrawals)
        , (FieldName
"btbrFee", Coin -> Expr
forall a. ToExpr a => a -> Expr
toExpr Coin
btbrFee)
        , (FieldName
"btbrValidityInterval", ValidityInterval -> Expr
forall a. ToExpr a => a -> Expr
toExpr ValidityInterval
btbrValidityInterval)
        , (FieldName
"btbrUpdate", StrictMaybe (Update BabbageEra) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe (Update BabbageEra)
btbrUpdate)
        , (FieldName
"btbrReqSignerHashes", Set (KeyHash Guard) -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set (KeyHash Guard)
btbrReqSignerHashes)
        , (FieldName
"btbrMint", MultiAsset -> Expr
forall a. ToExpr a => a -> Expr
toExpr MultiAsset
btbrMint)
        , (FieldName
"btbrScriptIntegrityHash", StrictMaybe ScriptIntegrityHash -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe ScriptIntegrityHash
btbrScriptIntegrityHash)
        , (FieldName
"btbrAuxDataHash", StrictMaybe TxAuxDataHash -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe TxAuxDataHash
btbrAuxDataHash)
        , (FieldName
"btbrNetworkId", StrictMaybe Network -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe Network
btbrNetworkId)
        ]

instance ToExpr (TxBody TopTx BabbageEra)

-- Rules/Utxo
instance
  ( ToExpr (AlonzoUtxoPredFailure era)
  , ToExpr (TxOut era)
  ) =>
  ToExpr (BabbageUtxoPredFailure era)

-- Rules/Utxow
instance
  ( Era era
  , ToExpr (PredicateFailure (EraRule "UTXO" era))
  , ToExpr (PlutusPurpose AsIx era)
  , ToExpr (PlutusPurpose AsItem era)
  , ToExpr (TxCert era)
  ) =>
  ToExpr (BabbageUtxowPredFailure era)

instance ToExpr (Tx TopTx BabbageEra)