{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.TreeDiff (
  module Test.Cardano.Ledger.Binary.TreeDiff,
) where

import Cardano.Ledger.Address
import Cardano.Ledger.AuxiliaryData
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.CertState
import Cardano.Ledger.Coin
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.EpochBoundary
import Cardano.Ledger.HKD
import Cardano.Ledger.Keys
import Cardano.Ledger.MemoBytes
import Cardano.Ledger.Plutus.CostModels
import Cardano.Ledger.Plutus.Data
import Cardano.Ledger.Plutus.ExUnits
import Cardano.Ledger.Plutus.Language
import Cardano.Ledger.Plutus.TxInfo
import Cardano.Ledger.PoolDistr
import Cardano.Ledger.PoolParams
import Cardano.Ledger.SafeHash
import Cardano.Ledger.TxIn
import Cardano.Ledger.UMap
import Cardano.Ledger.UTxO
import Data.Functor.Identity
import Data.TreeDiff.OMap
import GHC.TypeLits
import Test.Cardano.Ledger.Binary.TreeDiff
import Test.Data.VMap.TreeDiff ()

-- Coin
instance ToExpr Coin

instance ToExpr DeltaCoin

instance ToExpr (CompactForm Coin) where
  toExpr :: CompactForm Coin -> Expr
toExpr CompactForm Coin
x = forall a. ToExpr a => a -> Expr
toExpr (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
x)

deriving newtype instance ToExpr (CompactForm DeltaCoin)

-- HKD
instance ToExpr (NoUpdate a)

-- Keys
instance Crypto c => ToExpr (VKey r c) where
  toExpr :: VKey r c -> Expr
toExpr VKey r c
vk =
    FieldName -> OMap FieldName Expr -> Expr
Rec FieldName
"VKey" forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> OMap k v
fromList [(FieldName
"VKey (hashOf)", forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey VKey r c
vk)]

instance ToExpr (GenDelegs c)

instance ToExpr (GenDelegPair c)

instance ToExpr (KeyHash keyrole c) where
  toExpr :: KeyHash keyrole c -> Expr
toExpr (KeyHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
x) = FieldName -> [Expr] -> Expr
App FieldName
"KeyHash" [forall a. ToExpr a => a -> Expr
toExpr Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
x]

-- PoolDist
instance ToExpr (PoolDistr c)

instance ToExpr (IndividualPoolStake c)

-- SafeHash
instance ToExpr (SafeHash c index) where
  toExpr :: SafeHash c index -> Expr
toExpr SafeHash c index
x = FieldName -> [Expr] -> Expr
App FieldName
"SafeHash" [forall a. ToExpr a => a -> Expr
toExpr (forall c i. SafeHash c i -> Hash (HASH c) i
extractHash SafeHash c index
x)]

-- Language
instance ToExpr (Plutus l)

instance ToExpr PlutusBinary

instance ToExpr Language

-- MemoBytes
instance ToExpr (t era) => ToExpr (MemoBytes t era)

-- Core

instance ToExpr (VoidEraRule (rule :: Symbol) era) where
  toExpr :: VoidEraRule rule era -> Expr
toExpr = forall (rule :: Symbol) era a. VoidEraRule rule era -> a
absurdEraRule

instance ToExpr (ScriptHash c)

instance ToExpr CostModel where
  toExpr :: CostModel -> Expr
toExpr CostModel
costModel =
    FieldName -> [Expr] -> Expr
App
      FieldName
"CostModel"
      [ forall a. ToExpr a => a -> Expr
toExpr (CostModel -> Language
getCostModelLanguage CostModel
costModel)
      , forall {a}. ToExpr a => [a] -> Expr
paramsExpr (CostModel -> [Int64]
getCostModelParams CostModel
costModel)
      ]
    where
      paramsExpr :: [a] -> Expr
paramsExpr [] = [Expr] -> Expr
Lst []
      paramsExpr [a]
xs = FieldName -> [Expr] -> Expr
App FieldName
"concat" [[Expr] -> Expr
Lst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Expr] -> Expr
Lst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Int -> [a] -> [[a]]
chunksOf Int
15 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ [a]
xs]
      chunksOf :: Int -> [a] -> [[a]]
chunksOf Int
_ [] = []
      chunksOf Int
n [a]
xs = let ([a]
chunk, [a]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs in [a]
chunk forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
chunksOf Int
n [a]
rest

instance ToExpr CostModels

-- Keys/WitVKey
instance Crypto c => ToExpr (WitVKey kr c)

-- Keys/Bootstrap
instance Crypto c => ToExpr (BootstrapWitness c)

instance ToExpr ChainCode

-- TxIn
instance ToExpr TxIx

-- BaseTypes
instance ToExpr CertIx where
  toExpr :: CertIx -> Expr
toExpr (CertIx Word64
x) = FieldName -> [Expr] -> Expr
App FieldName
"CertIx" [forall a. ToExpr a => a -> Expr
toExpr Word64
x]

instance ToExpr UnitInterval where
  toExpr :: UnitInterval -> Expr
toExpr = forall a. ToExpr a => a -> Expr
toExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. BoundedRational r => r -> Rational
unboundRational

instance ToExpr NonNegativeInterval where
  toExpr :: NonNegativeInterval -> Expr
toExpr = forall a. ToExpr a => a -> Expr
toExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. BoundedRational r => r -> Rational
unboundRational

instance ToExpr Network

instance ToExpr Port

instance ToExpr Url

instance ToExpr Nonce where
  toExpr :: Nonce -> Expr
toExpr Nonce
NeutralNonce = FieldName -> [Expr] -> Expr
App FieldName
"NeutralNonce" []
  toExpr (Nonce Hash Blake2b_256 Nonce
x) = FieldName -> [Expr] -> Expr
App FieldName
"Nonce" [forall a. Show a => Int -> a -> Expr
trimExprViaShow Int
10 Hash Blake2b_256 Nonce
x]

instance ToExpr DnsName

instance ToExpr (BlocksMade c)

instance ToExpr ProtVer

instance ToExpr (Anchor c)

instance ToExpr a => ToExpr (Mismatch r a)

instance ToExpr EpochInterval

-- AuxiliaryData
instance ToExpr (AuxiliaryDataHash c)

-- Plutus/ExUnits
instance ToExpr Prices

instance ToExpr ExUnits where
  toExpr :: ExUnits -> Expr
toExpr (WrapExUnits (ExUnits' Natural
x Natural
y)) = FieldName -> [Expr] -> Expr
App FieldName
"ExUnits" [forall a. Show a => a -> Expr
defaultExprViaShow Natural
x, forall a. Show a => a -> Expr
defaultExprViaShow Natural
y]

-- Credential
instance ToExpr (Credential keyrole c)

instance ToExpr (StakeReference c)

instance ToExpr Ptr

deriving newtype instance
  ToExpr (PParamsHKD Identity era) => ToExpr (PParams era)

deriving newtype instance
  ToExpr (PParamsHKD StrictMaybe era) => ToExpr (PParamsUpdate era)

instance ToExpr (TxIn c)

instance ToExpr (TxId c)

-- CertState
instance ToExpr (DRep c)

instance ToExpr (DRepState c)

-- Address
instance ToExpr (Addr c)

instance ToExpr (RewardAccount era)

instance ToExpr (BootstrapAddress c) where
  toExpr :: BootstrapAddress c -> Expr
toExpr = forall a. Show a => a -> Expr
defaultExprViaShow

instance ToExpr (Withdrawals c)

instance ToExpr (CompactAddr c)

-- PoolParams
instance ToExpr PoolMetadata

instance ToExpr (PoolParams era)

instance ToExpr StakePoolRelay

instance ToExpr (PoolCert c)

-- UMap
instance ToExpr RDPair

instance ToExpr (UMElem c)

instance ToExpr (UMap c)

instance ToExpr (PlutusData era) where
  toExpr :: PlutusData era -> Expr
toExpr = forall a. Show a => Int -> a -> Expr
trimExprViaShow Int
30

instance ToExpr (Data era)

instance ToExpr (BinaryData era) where
  toExpr :: BinaryData era -> Expr
toExpr BinaryData era
_ = FieldName -> [Expr] -> Expr
App FieldName
"BinaryData" []

instance ToExpr (Datum era) where
  toExpr :: Datum era -> Expr
toExpr Datum era
NoDatum = FieldName -> [Expr] -> Expr
App FieldName
"NoDatum" []
  toExpr (DatumHash DataHash (EraCrypto era)
x) = FieldName -> [Expr] -> Expr
App FieldName
"DatumHash" [forall a. ToExpr a => a -> Expr
toExpr DataHash (EraCrypto era)
x]
  toExpr (Datum BinaryData era
bd) = FieldName -> [Expr] -> Expr
App FieldName
"Datum" [forall a. ToExpr a => a -> Expr
toExpr BinaryData era
bd]

-- EpochBoundary
instance ToExpr (SnapShots c)

instance ToExpr (SnapShot c)

deriving newtype instance ToExpr (Stake c)

instance ToExpr (CertState era)

instance ToExpr (PState era)

instance ToExpr (DState era)

instance ToExpr (VState era)

instance ToExpr (FutureGenDeleg c)

instance ToExpr (InstantaneousRewards c)

instance ToExpr (CommitteeAuthorization c)

instance ToExpr (CommitteeState era)

-- UTxO
deriving instance (Era era, ToExpr (Script era)) => ToExpr (ScriptsProvided era)

instance ToExpr (TxOut era) => ToExpr (UTxO era)

instance ToExpr (TxOutSource era)