{-# 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.Allegra.TreeDiff (
  module Test.Cardano.Ledger.Shelley.TreeDiff,
) where

import Cardano.Ledger.Allegra (AllegraEra, Tx (..))
import Cardano.Ledger.Allegra.Rules
import Cardano.Ledger.Allegra.Scripts
import Cardano.Ledger.Allegra.TxAuxData
import Cardano.Ledger.Allegra.TxBody
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.PParams
import Control.State.Transition.Extended (STS (..))
import qualified Data.TreeDiff.OMap as OMap
import Test.Cardano.Ledger.Shelley.TreeDiff

-- Scripts
instance ToExpr ValidityInterval

instance ToExpr (TimelockRaw era)

instance ToExpr (Timelock era)

-- TxAuxData
instance ToExpr (NativeScript era) => ToExpr (AllegraTxAuxDataRaw era)

instance ToExpr (NativeScript era) => ToExpr (AllegraTxAuxData era)

-- TxBody
instance
  ( ToExpr ma
  , ToExpr (TxOut era)
  , ToExpr (TxCert era)
  , ToExpr (Update era)
  ) =>
  ToExpr (AllegraTxBodyRaw ma TopTx era)
  where
  toExpr :: AllegraTxBodyRaw ma TopTx era -> Expr
toExpr AllegraTxBodyRaw {ma
Set TxIn
StrictMaybe TxAuxDataHash
StrictMaybe (Update era)
ValidityInterval
Withdrawals
Coin
StrictSeq (TxOut era)
StrictSeq (TxCert era)
atbrInputs :: Set TxIn
atbrOutputs :: StrictSeq (TxOut era)
atbrCerts :: StrictSeq (TxCert era)
atbrWithdrawals :: Withdrawals
atbrFee :: Coin
atbrValidityInterval :: ValidityInterval
atbrUpdate :: StrictMaybe (Update era)
atbrAuxDataHash :: StrictMaybe TxAuxDataHash
atbrMint :: ma
atbrMint :: forall era ma. AllegraTxBodyRaw ma TopTx era -> ma
atbrAuxDataHash :: forall era ma.
AllegraTxBodyRaw ma TopTx era -> StrictMaybe TxAuxDataHash
atbrUpdate :: forall era ma.
AllegraTxBodyRaw ma TopTx era -> StrictMaybe (Update era)
atbrValidityInterval :: forall era ma. AllegraTxBodyRaw ma TopTx era -> ValidityInterval
atbrFee :: forall era ma. AllegraTxBodyRaw ma TopTx era -> Coin
atbrWithdrawals :: forall era ma. AllegraTxBodyRaw ma TopTx era -> Withdrawals
atbrCerts :: forall era ma.
AllegraTxBodyRaw ma TopTx era -> StrictSeq (TxCert era)
atbrOutputs :: forall era ma.
AllegraTxBodyRaw ma TopTx era -> StrictSeq (TxOut era)
atbrInputs :: forall era ma. AllegraTxBodyRaw ma TopTx era -> Set TxIn
..} =
    FieldName -> OMap FieldName Expr -> Expr
Rec
      FieldName
"AllegraTxBodyRaw"
      (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
"atbrInputs", Set TxIn -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set TxIn
atbrInputs)
        , (FieldName
"atbrOutputs", StrictSeq (TxOut era) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictSeq (TxOut era)
atbrOutputs)
        , (FieldName
"atbrCerts", StrictSeq (TxCert era) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictSeq (TxCert era)
atbrCerts)
        , (FieldName
"atbrWithdrawals", Withdrawals -> Expr
forall a. ToExpr a => a -> Expr
toExpr Withdrawals
atbrWithdrawals)
        , (FieldName
"atbrFee", Coin -> Expr
forall a. ToExpr a => a -> Expr
toExpr Coin
atbrFee)
        , (FieldName
"atbrValidityInterval", ValidityInterval -> Expr
forall a. ToExpr a => a -> Expr
toExpr ValidityInterval
atbrValidityInterval)
        , (FieldName
"atbrUpdate", StrictMaybe (Update era) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe (Update era)
atbrUpdate)
        , (FieldName
"atbrAuxDataHash", StrictMaybe TxAuxDataHash -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe TxAuxDataHash
atbrAuxDataHash)
        , (FieldName
"atbrMint", ma -> Expr
forall a. ToExpr a => a -> Expr
toExpr ma
atbrMint)
        ]

instance ToExpr (TxBody TopTx AllegraEra)

-- Rules/Utxo
instance
  ( ToExpr (TxOut era)
  , ToExpr (Value era)
  , ToExpr (EraRuleFailure "PPUP" era)
  ) =>
  ToExpr (AllegraUtxoPredFailure era)

instance
  ( Era era
  , ToExpr (TxOut era)
  , ToExpr (Event (EraRule "PPUP" era))
  ) =>
  ToExpr (AllegraUtxoEvent era)

deriving newtype instance ToExpr (Tx TopTx AllegraEra)