{-# 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.BaseTypes
import Cardano.Ledger.CertState
import Cardano.Ledger.Coin
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
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.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 ToExpr (VKey r) where
  toExpr :: VKey r -> Expr
toExpr VKey r
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 (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey VKey r
vk)]

instance ToExpr GenDelegs

instance ToExpr GenDelegPair

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

instance ToExpr (VRFVerKeyHash keyrole) where
  toExpr :: VRFVerKeyHash keyrole -> Expr
toExpr (VRFVerKeyHash Hash HASH KeyRoleVRF
x) = FieldName -> [Expr] -> Expr
App FieldName
"VRFVerKeyHash" [forall a. ToExpr a => a -> Expr
toExpr Hash HASH KeyRoleVRF
x]

-- PoolDist
instance ToExpr PoolDistr

instance ToExpr IndividualPoolStake

-- SafeHash
instance ToExpr (SafeHash i) where
  toExpr :: SafeHash i -> Expr
toExpr SafeHash i
x = FieldName -> [Expr] -> Expr
App FieldName
"SafeHash" [forall a. ToExpr a => a -> Expr
toExpr (forall i. SafeHash i -> Hash HASH i
extractHash SafeHash i
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

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 ToExpr (WitVKey kr)

-- Keys/Bootstrap
instance ToExpr BootstrapWitness

instance ToExpr ChainCode

-- TxIn
instance ToExpr TxIx

-- BaseTypes
instance ToExpr CertIx where
  toExpr :: CertIx -> Expr
toExpr (CertIx Word16
x) = FieldName -> [Expr] -> Expr
App FieldName
"CertIx" [forall a. ToExpr a => a -> Expr
toExpr Word16
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 HASH Nonce
x) = FieldName -> [Expr] -> Expr
App FieldName
"Nonce" [forall a. Show a => Int -> a -> Expr
trimExprViaShow Int
10 Hash HASH Nonce
x]

instance ToExpr DnsName

instance ToExpr BlocksMade

instance ToExpr ProtVer

instance ToExpr Anchor

instance ToExpr a => ToExpr (Mismatch r a)

instance ToExpr EpochInterval

-- AuxiliaryData
instance ToExpr TxAuxDataHash

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

instance ToExpr StakeReference

deriving newtype instance ToExpr SlotNo32

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

instance ToExpr TxId

-- CertState
instance ToExpr DRep

instance ToExpr DRepState

-- Address
instance ToExpr Addr

instance ToExpr RewardAccount

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

instance ToExpr Withdrawals

instance ToExpr CompactAddr

-- PoolParams
instance ToExpr PoolMetadata

instance ToExpr PoolParams

instance ToExpr StakePoolRelay

instance ToExpr PoolCert

-- UMap
instance ToExpr RDPair

instance ToExpr UMElem

instance ToExpr UMap

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
x) = FieldName -> [Expr] -> Expr
App FieldName
"DatumHash" [forall a. ToExpr a => a -> Expr
toExpr DataHash
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

instance ToExpr SnapShot

deriving newtype instance ToExpr Stake

instance ToExpr (CertState era)

instance ToExpr (PState era)

instance ToExpr (DState era)

instance ToExpr (VState era)

instance ToExpr FutureGenDeleg

instance ToExpr InstantaneousRewards

instance ToExpr CommitteeAuthorization

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