{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
-- NOTE: This is here because of a bug in fourmolu
-- c.f. https://github.com/fourmolu/fourmolu/issues/374
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Test.Cardano.Ledger.Constrained.TypeRep (
  Rep (..),
  (:~:) (Refl),
  Singleton (..),
  Eql,
  typeRepOf,
  synopsis,
  genSizedRep,
  genRep,
  shrinkRep,
  TxOutF (..),
  unTxOut,
  ValueF (..),
  unValue,
  PParamsF (..),
  unPParams,
  PParamsUpdateF (..),
  unPParamsUpdate,
  liftUTxO,
  Proof (..),
  stringR,
  hasOrd,
  hasEq,
  format,
  genSigningKey,
)
where

import Cardano.Crypto.Hash.Class (sizeHash)
import Cardano.Crypto.Signing (SigningKey (..), shortVerificationKeyHexF, toVerification)
import qualified Cardano.Crypto.Wallet as Byron
import Cardano.Ledger.Address (Addr (..), RewardAccount (..))
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.Tx (IsValid (..))
import Cardano.Ledger.Alonzo.UTxO (AlonzoScriptsNeeded (..))
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..))
import Cardano.Ledger.BaseTypes (
  EpochInterval (..),
  EpochNo (..),
  Network (..),
  ProtVer (..),
  SlotNo (..),
  StrictMaybe (..),
  UnitInterval,
  mkTxIxPartial,
 )
import Cardano.Ledger.Binary.Version (Version)
import Cardano.Ledger.CertState
import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance (
  Committee (..),
  Constitution,
  DRepPulser (..),
  EnactState (..),
  GovAction (..),
  GovActionId (..),
  GovActionIx (..),
  GovActionPurpose (..),
  GovActionState (..),
  GovPurposeId (..),
  GovRelation (..),
  ProposalProcedure (..),
  Proposals,
  RatifyState (..),
  RunConwayRatify (..),
  Vote (..),
  pPropsL,
  proposalsDeposits,
 )
import Cardano.Ledger.Conway.TxCert (ConwayTxCert (..), Delegatee (..))
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (Credential, Ptr)
import qualified Cardano.Ledger.Crypto as CC (Crypto (HASH))
import Cardano.Ledger.EpochBoundary (SnapShots (..))
import Cardano.Ledger.Keys (GenDelegPair (..), GenDelegs (..), KeyHash, KeyRole (..), WitVKey (..))
import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness (..))
import Cardano.Ledger.Mary.Value (AssetName (..), MultiAsset (..), PolicyID (..))
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..), dataToBinaryData)
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.PoolDistr (IndividualPoolStake (..))
import Cardano.Ledger.PoolParams (PoolMetadata (..), PoolParams (ppId))
import Cardano.Ledger.SafeHash (SafeHash, extractHash)
import Cardano.Ledger.Shelley.LedgerState
import qualified Cardano.Ledger.Shelley.SoftForks as SoftForks (restrictPoolMetadataHash)
import Cardano.Ledger.Shelley.TxCert (ShelleyTxCert (..))
import Cardano.Ledger.Shelley.UTxO (ShelleyScriptsNeeded (..))
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.UTxO (UTxO (..))
import Cardano.Ledger.Val (Val ((<+>)))
import Control.Monad.Identity (Identity)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Default.Class (def)
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.OMap.Strict as OMap
import qualified Data.Sequence.Strict as SS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable
import Data.Universe (Eql, Singleton (..), cmpIndex)
import Data.Word (Word16, Word64)
import Formatting (formatToString)
import Lens.Micro
import Numeric.Natural (Natural)
import Prettyprinter (hsep)
import Test.Cardano.Ledger.Alonzo.Arbitrary (genAlonzoPlutusPurposePointer)
import Test.Cardano.Ledger.Binary.Arbitrary (genByteString)
import Test.Cardano.Ledger.Constrained.Classes (
  Adds (add, zero),
  PParamsF (..),
  PParamsUpdateF (..),
  PlutusPointerF (..),
  PlutusPurposeF (..),
  ScriptF (..),
  ScriptsNeededF (..),
  TxAuxDataF (..),
  TxBodyF (..),
  TxCertF (..),
  TxF (..),
  TxOutF (..),
  TxWitsF (..),
  ValueF (..),
  genFuturePParams,
  genPParams,
  genPParamsUpdate,
  genScriptF,
  genTxAuxDataF,
  genTxOut,
  genUTxO,
  genValue,
  liftUTxO,
  unPParams,
  unPParamsUpdate,
  unTxBodyF,
  unTxF,
  unTxOut,
  unValue,
 )
import Test.Cardano.Ledger.Constrained.Combinators (mapSized, setSized)
import Test.Cardano.Ledger.Constrained.Monad (HasConstraint (With), Typed, failT)
import Test.Cardano.Ledger.Constrained.Size (Size (..))
import Test.Cardano.Ledger.Conway.Arbitrary (genConwayPlutusPurposePointer, genProposals)
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
import Test.Cardano.Ledger.Generic.Fields (WitnessesField (..))
import Test.Cardano.Ledger.Generic.Functions (protocolVersion)
import Test.Cardano.Ledger.Generic.PrettyCore (
  PDoc,
  credSummary,
  keyHashSummary,
  pcAnchor,
  pcCoin,
  pcCommittee,
  pcConstitution,
  pcConwayTxCert,
  pcDRep,
  pcDRepPulser,
  pcDRepState,
  pcDState,
  pcData,
  pcDataHash,
  pcDatum,
  pcDelegatee,
  pcEnactState,
  pcFutureGenDeleg,
  pcFuturePParams,
  pcGenDelegPair,
  pcGovAction,
  pcGovActionId,
  pcGovActionState,
  pcIndividualPoolStake,
  pcLedgerState,
  pcMultiAsset,
  pcPParams,
  pcPrevGovActionIds,
  pcProposals,
  pcRatifyState,
  pcReward,
  pcRewardAccount,
  pcScriptHash,
  pcShelleyTxCert,
  pcTx,
  pcTxBody,
  pcTxCert,
  pcTxIn,
  pcTxOut,
  pcVal,
  pcWitVKey,
  pcWitnesses,
  pcWitnessesField,
  ppHash,
  ppInteger,
  ppList,
  ppMap,
  ppMaybe,
  ppRecord',
  ppSet,
  ppString,
  ppVKey,
  ppValidityInterval,
  ppWord16,
  trim,
 )
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Generic.Updaters (newTxBody)
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.Cardano.Ledger.Shelley.Utils (testGlobals)
import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ()
import Test.QuickCheck hiding (Fixed, total)

-- =======================================================================
-- Special functions for dealing with SoftForks properties that
-- depend upon the ProtVer. Whiach can be computed from a (Proof era)

restrictHash :: Proof era -> Bool
restrictHash :: forall era. Proof era -> Bool
restrictHash Proof era
p = ProtVer -> Bool
SoftForks.restrictPoolMetadataHash forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> ProtVer
protocolVersion Proof era
p

hashsize :: forall era. CC.Crypto (EraCrypto era) => Proof era -> Int
hashsize :: forall era. Crypto (EraCrypto era) => Proof era -> Int
hashsize Proof era
_p = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash ([] @(CC.HASH (EraCrypto era)))

-- =======================================================================
infixr 0 :->

data Rep era t where
  RationalR :: Rep era Rational
  CoinR :: Rep era Coin
  EpochR :: Rep era EpochNo
  EpochIntervalR :: Rep era EpochInterval
  (:->) :: Rep era a -> Rep era b -> Rep era (a -> b)
  MapR :: Ord a => Rep era a -> Rep era b -> Rep era (Map a b)
  SetR :: Ord a => Rep era a -> Rep era (Set a)
  ListR :: Rep era a -> Rep era [a]
  AddrR :: Era era => Rep era (Addr (EraCrypto era))
  CredR :: Era era => Rep era (Credential 'Staking (EraCrypto era))
  VCredR :: Era era => Rep era (Credential 'DRepRole (EraCrypto era))
  PoolHashR :: Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
  WitHashR :: Era era => Rep era (KeyHash 'Witness (EraCrypto era))
  GenHashR :: Era era => Rep era (KeyHash 'Genesis (EraCrypto era))
  GenDelegHashR :: Era era => Rep era (KeyHash 'GenesisDelegate (EraCrypto era))
  VHashR :: Era era => Rep era (KeyHash 'DRepRole (EraCrypto era))
  CommColdCredR :: Era era => Rep era (Credential 'ColdCommitteeRole (EraCrypto era))
  CommHotCredR :: Era era => Rep era (Credential 'HotCommitteeRole (EraCrypto era))
  PoolParamsR :: Era era => Rep era (PoolParams (EraCrypto era))
  NewEpochStateR :: Era era => Rep era (NewEpochState era)
  IntR :: Rep era Int
  FloatR :: Rep era Float
  NaturalR :: Rep era Natural
  Word64R :: Rep era Word64
  TxInR :: Era era => Rep era (TxIn (EraCrypto era))
  TxIdR :: Era era => Rep era (TxId (EraCrypto era))
  CharR :: Rep era Char
  UnitR :: Rep era ()
  PairR :: Rep era a -> Rep era b -> Rep era (a, b)
  ProtVerR :: Era era => Proof era -> Rep era ProtVer -- We need the Proof to get arbitrary instances correct
  -- \^ Rep's for type families (or those that embed type families)
  ValueR :: Era era => Proof era -> Rep era (ValueF era)
  UTxOR :: Era era => Proof era -> Rep era (UTxO era)
  TxOutR :: Era era => Proof era -> Rep era (TxOutF era)
  PParamsR :: Era era => Proof era -> Rep era (PParamsF era)
  FuturePParamsR :: Era era => Proof era -> Rep era (FuturePParams era)
  PParamsUpdateR :: Era era => Proof era -> Rep era (PParamsUpdateF era)
  --
  DeltaCoinR :: Rep era DeltaCoin
  GenDelegPairR :: Era era => Rep era (GenDelegPair (EraCrypto era))
  FutureGenDelegR :: Era era => Rep era (FutureGenDeleg (EraCrypto era))
  PPUPStateR :: Era era => Proof era -> Rep era (ShelleyGovState era)
  PtrR :: Rep era Ptr
  IPoolStakeR :: Era era => Rep era (IndividualPoolStake (EraCrypto era))
  SnapShotsR :: Era era => Rep era (SnapShots (EraCrypto era))
  RewardR :: Era era => Rep era (Reward (EraCrypto era))
  MaybeR :: Rep era t -> Rep era (Maybe t)
  SlotNoR :: Rep era SlotNo
  SizeR :: Rep era Size
  MultiAssetR :: Era era => Rep era (MultiAsset (EraCrypto era))
  PolicyIDR :: Era era => Rep era (PolicyID (EraCrypto era))
  WitnessesFieldR :: Era era => Proof era -> Rep era (WitnessesField era)
  AssetNameR :: Rep era AssetName
  TxCertR :: Era era => Proof era -> Rep era (TxCertF era)
  RewardAccountR :: Era era => Rep era (RewardAccount (EraCrypto era))
  ValidityIntervalR :: Era era => Rep era ValidityInterval
  KeyPairR :: Era era => Rep era (KeyPair 'Witness (EraCrypto era))
  GenR :: Rep era x -> Rep era (Gen x)
  ScriptR :: Era era => Proof era -> Rep era (ScriptF era)
  ScriptHashR :: Era era => Rep era (ScriptHash (EraCrypto era))
  NetworkR :: Rep era Network
  RdmrPtrR :: Era era => Proof era -> Rep era (PlutusPointerF era)
  DataR :: Era era => Rep era (Data era)
  DatumR :: Era era => Rep era (Datum era)
  ExUnitsR :: Rep era ExUnits
  DataHashR :: Era era => Rep era (DataHash (EraCrypto era))
  PCredR :: Era era => Rep era (Credential 'Payment (EraCrypto era))
  ShelleyTxCertR :: Era era => Rep era (ShelleyTxCert era)
  ConwayTxCertR :: Era era => Rep era (ConwayTxCert era)
  MIRPotR :: Rep era MIRPot
  IsValidR :: Rep era IsValid
  IntegerR :: Rep era Integer
  ScriptsNeededR :: Era era => Proof era -> Rep era (ScriptsNeededF era)
  ScriptPurposeR :: Era era => Proof era -> Rep era (PlutusPurposeF era)
  TxBodyR :: Era era => Proof era -> Rep era (TxBodyF era)
  BootstrapWitnessR :: Era era => Rep era (BootstrapWitness (EraCrypto era))
  SigningKeyR :: Rep era SigningKey
  TxWitsR :: Era era => Proof era -> Rep era (TxWitsF era)
  PayHashR :: Era era => Rep era (KeyHash 'Payment (EraCrypto era))
  TxR :: Era era => Proof era -> Rep era (TxF era)
  ScriptIntegrityHashR :: Era era => Rep era (SafeHash (EraCrypto era) EraIndependentScriptIntegrity)
  AuxiliaryDataHashR :: Era era => Rep era (AuxiliaryDataHash (EraCrypto era))
  GovActionR :: Era era => Rep era (GovAction era)
  WitVKeyR :: Era era => Proof era -> Rep era (WitVKey 'Witness (EraCrypto era))
  TxAuxDataR :: Era era => Proof era -> Rep era (TxAuxDataF era)
  LanguageR :: Rep era Language
  LedgerStateR :: Era era => Proof era -> Rep era (LedgerState era)
  StakeHashR :: Era era => Rep era (KeyHash 'Staking (EraCrypto era))
  BoolR :: Rep era Bool
  DRepR :: Era era => Rep era (DRep (EraCrypto era))
  PoolMetadataR :: Era era => Proof era -> Rep era PoolMetadata
  DRepStateR :: Era era => Rep era (DRepState (EraCrypto era))
  DStateR :: Era era => Rep era (DState era)
  GovActionIdR :: Era era => Rep era (GovActionId (EraCrypto era))
  GovActionIxR :: Rep era GovActionIx
  GovActionStateR :: Era era => Rep era (GovActionState era)
  ProposalsR :: Era era => Proof era -> Rep era (Proposals era)
  UnitIntervalR :: Rep era UnitInterval
  CommitteeR :: Era era => Rep era (Committee era)
  ConstitutionR :: Era era => Rep era (Constitution era)
  PrevGovActionIdsR :: Era era => Rep era (GovRelation StrictMaybe era)
  PrevPParamUpdateR :: Era era => Rep era (GovPurposeId 'PParamUpdatePurpose era)
  PrevHardForkR :: Era era => Rep era (GovPurposeId 'HardForkPurpose era)
  PrevCommitteeR :: Era era => Rep era (GovPurposeId 'CommitteePurpose era)
  PrevConstitutionR :: Era era => Rep era (GovPurposeId 'ConstitutionPurpose era)
  RatifyStateR :: Reflect era => Rep era (RatifyState era)
  NumDormantEpochsR :: Era era => Rep era EpochNo
  DRepHashR :: Era era => Rep era (KeyHash 'DRepRole (EraCrypto era))
  AnchorR :: Era era => Rep era (Anchor (EraCrypto era))
  CommitteeStateR :: Era era => Rep era (CommitteeState era)
  CommitteeAuthorizationR :: Era era => Rep era (CommitteeAuthorization (EraCrypto era))
  VStateR :: Era era => Rep era (VState era)
  EnactStateR :: Reflect era => Rep era (EnactState era)
  DRepPulserR ::
    (RunConwayRatify era, Reflect era) => Rep era (DRepPulser era Identity (RatifyState era))
  DelegateeR :: Era era => Rep era (Delegatee (EraCrypto era))
  VoteR :: Rep era Vote

stringR :: Rep era String
stringR :: forall era. Rep era String
stringR = forall era t. Rep era t -> Rep era [t]
ListR forall era. Rep era Char
CharR

-- ===========================================================
-- Proof of Rep equality

data Is c a where
  Is :: c a => Is c a
  Isn't :: Is c a

data HasInstances a where
  Type ::
    Typeable a =>
    Is Eq a ->
    Is Ord a ->
    HasInstances a

pattern IsOrd :: () => (Typeable a, Ord a) => HasInstances a
pattern $bIsOrd :: forall a. (Typeable a, Ord a) => HasInstances a
$mIsOrd :: forall {r} {a}.
HasInstances a -> ((Typeable a, Ord a) => r) -> ((# #) -> r) -> r
IsOrd = Type Is Is

pattern IsEq :: () => (Typeable a, Eq a) => HasInstances a
pattern $bIsEq :: forall a. (Typeable a, Eq a) => HasInstances a
$mIsEq :: forall {r} {a}.
HasInstances a -> ((Typeable a, Eq a) => r) -> ((# #) -> r) -> r
IsEq <- Type Is _
  where
    IsEq = forall a. Typeable a => Is Eq a -> Is Ord a -> HasInstances a
Type forall (c :: * -> Constraint) a. c a => Is c a
Is forall (c :: * -> Constraint) a. Is c a
Isn't

{-# COMPLETE IsTypeable #-}
pattern IsTypeable :: () => Typeable a => HasInstances a
pattern $bIsTypeable :: forall a. Typeable a => HasInstances a
$mIsTypeable :: forall {r} {a}.
HasInstances a -> (Typeable a => r) -> ((# #) -> r) -> r
IsTypeable <- Type _ _
  where
    IsTypeable = forall a. Typeable a => Is Eq a -> Is Ord a -> HasInstances a
Type forall (c :: * -> Constraint) a. Is c a
Isn't forall (c :: * -> Constraint) a. Is c a
Isn't

typeRepOf :: Rep era t -> TypeRep
typeRepOf :: forall era t. Rep era t -> TypeRep
typeRepOf r :: Rep era t
r@(forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances t
IsTypeable) = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Rep era t
r

repHasInstances :: Rep era t -> HasInstances t
repHasInstances :: forall era t. Rep era t -> HasInstances t
repHasInstances Rep era t
r = case Rep era t
r of
  Rep era t
TxIdR -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  Rep era t
VStateR -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  Rep era t
EnactStateR -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  Rep era t
RatifyStateR -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  Rep era t
DRepStateR -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  Rep era t
CommColdCredR -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  Rep era t
CommHotCredR -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  Rep era t
GovActionR -> forall a. Typeable a => HasInstances a
IsTypeable
  PoolMetadataR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  StakeHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  BoolR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  DRepR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  WitVKeyR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  TxAuxDataR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  LanguageR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  LedgerStateR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  TxR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ScriptIntegrityHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  AuxiliaryDataHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  BootstrapWitnessR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  SigningKeyR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  TxWitsR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PayHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  IntegerR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  ScriptsNeededR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  ScriptPurposeR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  {-
    ScriptPurposeR Shelley -> IsEq
    ScriptPurposeR Mary -> IsEq
    ScriptPurposeR Allegra -> IsEq
    ScriptPurposeR Alonzo -> IsEq
    ScriptPurposeR Babbage -> IsEq
    ScriptPurposeR Conway -> IsEq
  -}
  TxBodyR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ShelleyTxCertR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ConwayTxCertR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  MIRPotR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  IsValidR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ExUnitsR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  DataHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PCredR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  NetworkR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  RdmrPtrR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  DataR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  DatumR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  KeyPairR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  ScriptR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ScriptHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  TxCertR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  RewardAccountR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  ValidityIntervalR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  AssetNameR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  WitnessesFieldR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  MultiAssetR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PolicyIDR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  CharR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  RationalR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  CoinR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  EpochR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  EpochIntervalR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  AddrR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  CredR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  VCredR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PoolHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  WitHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  GenHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  GenDelegHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  VHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PoolParamsR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  NewEpochStateR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  IntR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  FloatR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  NaturalR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  Word64R {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  TxInR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  UnitR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  ProtVerR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  ValueR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  UTxOR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  TxOutR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PParamsR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  FuturePParamsR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  PParamsUpdateR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  DeltaCoinR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  GenDelegPairR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  FutureGenDelegR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PPUPStateR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  PtrR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  IPoolStakeR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  SnapShotsR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  RewardR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  SlotNoR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  SizeR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  DStateR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  GovActionIdR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  GovActionIxR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  GovActionStateR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  ProposalsR {} -> forall a. Typeable a => HasInstances a
IsTypeable
  CommitteeAuthorizationR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  CommitteeStateR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  UnitIntervalR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  CommitteeR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ConstitutionR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PrevGovActionIdsR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PrevPParamUpdateR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PrevHardForkR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PrevCommitteeR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PrevConstitutionR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances a
IsTypeable) :-> (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances b
IsTypeable) -> forall a. Typeable a => HasInstances a
IsTypeable
  MapR (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances a
IsTypeable) (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances b
ib) -> forall a (f :: * -> *).
(Ord a => Ord (f a), Eq a => Eq (f a), Typeable f) =>
HasInstances a -> HasInstances (f a)
requireInstances HasInstances b
ib
  SetR (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances a
IsTypeable) -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  ListR (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances a
ia) -> forall a (f :: * -> *).
(Ord a => Ord (f a), Eq a => Eq (f a), Typeable f) =>
HasInstances a -> HasInstances (f a)
requireInstances HasInstances a
ia
  PairR (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances a
ia) (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances b
ib) -> forall a b (f :: * -> * -> *).
((Ord a, Ord b) => Ord (f a b), (Eq a, Eq b) => Eq (f a b),
 Typeable f) =>
HasInstances a -> HasInstances b -> HasInstances (f a b)
lubInstances HasInstances a
ia HasInstances b
ib
  MaybeR (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances t
ia) -> forall a (f :: * -> *).
(Ord a => Ord (f a), Eq a => Eq (f a), Typeable f) =>
HasInstances a -> HasInstances (f a)
requireInstances HasInstances t
ia
  GenR (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances x
IsTypeable) -> forall a. Typeable a => HasInstances a
IsTypeable
  NumDormantEpochsR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  DRepHashR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  AnchorR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  DRepPulserR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  DelegateeR {} -> forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  VoteR {} -> forall a. (Typeable a, Eq a) => HasInstances a
IsEq

-- NOTE: The extra `()` constraint needs to be there for fourmolu.
-- c.f. https://github.com/fourmolu/fourmolu/issues/374
lubIs :: ((c a, c b) => c (f a b), ()) => Is c a -> Is c b -> Is c (f a b)
lubIs :: forall (c :: * -> Constraint) a b (f :: * -> * -> *).
((c a, c b) => c (f a b), () :: Constraint) =>
Is c a -> Is c b -> Is c (f a b)
lubIs Is c a
Is Is c b
Is = forall (c :: * -> Constraint) a. c a => Is c a
Is
lubIs Is c a
_ Is c b
_ = forall (c :: * -> Constraint) a. Is c a
Isn't

lubInstances ::
  ( (Ord a, Ord b) => Ord (f a b)
  , (Eq a, Eq b) => Eq (f a b)
  , Typeable f
  ) =>
  HasInstances a ->
  HasInstances b ->
  HasInstances (f a b)
lubInstances :: forall a b (f :: * -> * -> *).
((Ord a, Ord b) => Ord (f a b), (Eq a, Eq b) => Eq (f a b),
 Typeable f) =>
HasInstances a -> HasInstances b -> HasInstances (f a b)
lubInstances (Type Is Eq a
eq_a Is Ord a
ord_a) (Type Is Eq b
eq_b Is Ord b
ord_b) =
  forall a. Typeable a => Is Eq a -> Is Ord a -> HasInstances a
Type (forall (c :: * -> Constraint) a b (f :: * -> * -> *).
((c a, c b) => c (f a b), () :: Constraint) =>
Is c a -> Is c b -> Is c (f a b)
lubIs Is Eq a
eq_a Is Eq b
eq_b) (forall (c :: * -> Constraint) a b (f :: * -> * -> *).
((c a, c b) => c (f a b), () :: Constraint) =>
Is c a -> Is c b -> Is c (f a b)
lubIs Is Ord a
ord_a Is Ord b
ord_b)

-- NOTE: The extra `()` constraint needs to be there for fourmolu.
-- c.f. https://github.com/fourmolu/fourmolu/issues/374
requireIs :: (c a => c (f a), ()) => Is c a -> Is c (f a)
requireIs :: forall (c :: * -> Constraint) a (f :: * -> *).
(c a => c (f a), () :: Constraint) =>
Is c a -> Is c (f a)
requireIs Is c a
Is = forall (c :: * -> Constraint) a. c a => Is c a
Is
requireIs Is c a
_ = forall (c :: * -> Constraint) a. Is c a
Isn't

requireInstances ::
  ( Ord a => Ord (f a)
  , Eq a => Eq (f a)
  , Typeable f
  ) =>
  HasInstances a ->
  HasInstances (f a)
requireInstances :: forall a (f :: * -> *).
(Ord a => Ord (f a), Eq a => Eq (f a), Typeable f) =>
HasInstances a -> HasInstances (f a)
requireInstances (Type Is Eq a
eq Is Ord a
ord) = forall a. Typeable a => Is Eq a -> Is Ord a -> HasInstances a
Type (forall (c :: * -> Constraint) a (f :: * -> *).
(c a => c (f a), () :: Constraint) =>
Is c a -> Is c (f a)
requireIs Is Eq a
eq) (forall (c :: * -> Constraint) a (f :: * -> *).
(c a => c (f a), () :: Constraint) =>
Is c a -> Is c (f a)
requireIs Is Ord a
ord)

instance Singleton (Rep era) where
  testEql :: forall i j. Rep era i -> Rep era j -> Maybe (i :~: j)
testEql
    (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances i
IsTypeable :: HasInstances a)
    (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances j
IsTypeable :: HasInstances b) = forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @b
  cmpIndex :: forall a b. Rep era a -> Rep era b -> Ordering
cmpIndex Rep era a
x Rep era b
y = forall a. Ord a => a -> a -> Ordering
compare (forall era t. Rep era t -> TypeRep
typeRepOf Rep era a
x) (forall era t. Rep era t -> TypeRep
typeRepOf Rep era b
y)

-- ============================================================
-- Show instances

instance Show (Rep era t) where
  showsPrec :: Int -> Rep era t -> ShowS
showsPrec Int
d (forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances t
IsTypeable :: HasInstances t) = forall a. Show a => Int -> a -> ShowS
showsPrec Int
d forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @t)

synopsis :: forall e t. Rep e t -> t -> String
synopsis :: forall e t. Rep e t -> t -> String
synopsis Rep e t
TxIdR t
r = forall a. Show a => a -> String
show t
r
synopsis Rep e t
RationalR t
r = forall a. Show a => a -> String
show t
r
synopsis Rep e t
CoinR t
c = forall a. Show a => a -> String
show (Coin -> PDoc
pcCoin t
c)
synopsis Rep e t
EpochR t
e = forall a. Show a => a -> String
show t
e
synopsis Rep e t
EpochIntervalR t
e = forall a. Show a => a -> String
show t
e
synopsis (Rep e a
a :-> Rep e b
b) t
_ = String
"(Arrow " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rep e a
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rep e b
b forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
Word64R t
w = forall a. Show a => a -> String
show t
w
synopsis rep :: Rep e t
rep@(MapR Rep e a
a Rep e b
b) t
mp = case forall k a. Map k a -> [(k, a)]
Map.toList t
mp of
  [] -> String
"(empty::Map " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rep e a
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rep e b
b forall a. [a] -> [a] -> [a]
++ String
")"
  ((a
d, b
r) : [(a, b)]
_) ->
    String
"Map{"
      forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synopsis Rep e a
a a
d
      forall a. [a] -> [a] -> [a]
++ String
" -> "
      forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synopsis Rep e b
b b
r
      forall a. [a] -> [a] -> [a]
++ String
" | size = "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall k a. Map k a -> Int
Map.size t
mp)
      forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synSum Rep e t
rep t
mp
      forall a. [a] -> [a] -> [a]
++ String
"}"
synopsis (SetR Rep e a
IntR) t
x = String
"Set" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Set a -> [a]
Set.toList t
x)
synopsis (SetR Rep e a
Word64R) t
x = String
"Set" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Set a -> [a]
Set.toList t
x)
synopsis rep :: Rep e t
rep@(SetR Rep e a
a) t
t = case forall a. Set a -> [a]
Set.elems t
t of
  [] -> String
"(empty::Set " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rep e a
a forall a. [a] -> [a] -> [a]
++ String
")"
  (a
h : [a]
_) -> String
"Set{" forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synopsis Rep e a
a a
h forall a. [a] -> [a] -> [a]
++ String
" | size = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Set a -> Int
Set.size t
t) forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synSum Rep e t
rep t
t forall a. [a] -> [a] -> [a]
++ String
"}"
synopsis (ListR Rep e a
IntR) t
x = forall a. Show a => a -> String
show t
x
synopsis (ListR Rep e a
Word64R) t
x = forall a. Show a => a -> String
show t
x
synopsis rep :: Rep e t
rep@(ListR Rep e a
a) t
ll = case t
ll of
  [] -> String
"(empty::" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall era t. Rep era t -> Rep era [t]
ListR Rep e a
a) forall a. [a] -> [a] -> [a]
++ String
"]"
  (a
d : [a]
_) -> String
"[" forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synopsis Rep e a
a a
d forall a. [a] -> [a] -> [a]
++ String
" | size = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length t
ll) forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synSum Rep e t
rep t
ll forall a. [a] -> [a] -> [a]
++ String
"]"
synopsis Rep e t
AddrR t
a = forall a. Show a => a -> String
show t
a
synopsis Rep e t
CredR t
c = forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
credSummary t
c)
synopsis Rep e t
PoolHashR t
k = String
"(KeyHash 'PoolStake " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
keyHashSummary t
k) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
GenHashR t
k = String
"(KeyHash 'Genesis " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
keyHashSummary t
k) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
WitHashR t
k = String
"(KeyHash 'Witness " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
keyHashSummary t
k) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
GenDelegHashR t
k = String
"(KeyHash 'GenesisDelegate " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
keyHashSummary t
k) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
PoolParamsR t
pp = String
"(PoolParams " forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synopsis @e forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR (forall c. PoolParams c -> KeyHash 'StakePool c
ppId t
pp) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
IntR t
n = forall a. Show a => a -> String
show t
n
synopsis Rep e t
NaturalR t
n = forall a. Show a => a -> String
show t
n
synopsis Rep e t
FloatR t
n = forall a. Show a => a -> String
show t
n
synopsis Rep e t
TxInR t
txin = forall a. Show a => a -> String
show (forall c. TxIn c -> PDoc
pcTxIn t
txin)
synopsis Rep e t
CharR t
s = forall a. Show a => a -> String
show t
s
synopsis (ValueR Proof e
p) (ValueF Proof e
_ Value e
x) = forall a. Show a => a -> String
show (forall era. Proof era -> Value era -> PDoc
pcVal Proof e
p Value e
x)
synopsis (TxOutR Proof e
p) (TxOutF Proof e
_ TxOut e
x) = forall a. Show a => a -> String
show ((forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof e
p TxOut e
x) :: PDoc)
synopsis (UTxOR Proof e
p) (UTxO Map (TxIn (EraCrypto e)) (TxOut e)
mp) = String
"UTxO( " forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synopsis (forall t era s.
Ord t =>
Rep era t -> Rep era s -> Rep era (Map t s)
MapR forall era. Era era => Rep era (TxIn (EraCrypto era))
TxInR (forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR Proof e
p)) (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof e
p) Map (TxIn (EraCrypto e)) (TxOut e)
mp) forall a. [a] -> [a] -> [a]
++ String
" )"
synopsis (PParamsR Proof e
_) (PParamsF Proof e
p PParams e
x) = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> PParams era -> PDoc
pcPParams Proof e
p PParams e
x
synopsis (FuturePParamsR Proof e
p) t
x = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> FuturePParams era -> PDoc
pcFuturePParams Proof e
p t
x
synopsis (PParamsUpdateR Proof e
_) t
_ = String
"PParamsUpdate ..."
synopsis Rep e t
DeltaCoinR (DeltaCoin Integer
n) = forall a. Show a => a -> String
show (forall ann. [Doc ann] -> Doc ann
hsep [forall a. String -> Doc a
ppString String
"▵₳", forall a. Integer -> Doc a
ppInteger Integer
n])
synopsis Rep e t
GenDelegPairR t
x = forall a. Show a => a -> String
show (forall c. GenDelegPair c -> PDoc
pcGenDelegPair t
x)
synopsis Rep e t
FutureGenDelegR t
x = forall a. Show a => a -> String
show (forall c. FutureGenDeleg c -> PDoc
pcFutureGenDeleg t
x)
synopsis (PPUPStateR Proof e
_) t
_ = String
"PPUPStateR ..."
synopsis Rep e t
PtrR t
p = forall a. Show a => a -> String
show t
p
synopsis Rep e t
IPoolStakeR t
p = forall a. Show a => a -> String
show (forall c. IndividualPoolStake c -> PDoc
pcIndividualPoolStake t
p)
synopsis Rep e t
SnapShotsR t
_ = String
"SnapShots ..."
synopsis Rep e t
UnitR () = String
"()"
synopsis (PairR Rep e a
a Rep e b
b) (a
x, b
y) = String
"(" forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synopsis Rep e a
a a
x forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synopsis Rep e b
b b
y forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
RewardR t
x = forall a. Show a => a -> String
show (forall c. Reward c -> PDoc
pcReward t
x)
synopsis (MaybeR Rep e t
_) t
Maybe t
Nothing = String
"Nothing"
synopsis (MaybeR Rep e t
x) (Just t
y) = String
"(Just " forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synopsis Rep e t
x t
y forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
NewEpochStateR t
_ = String
"NewEpochStateR ..."
synopsis (ProtVerR Proof e
_) (ProtVer Version
x Natural
y) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Version
x forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Natural
y forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
SlotNoR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
SizeR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
VCredR t
x = forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
credSummary t
x)
synopsis Rep e t
VHashR t
x = String
"(KeyHash 'Voting " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
keyHashSummary t
x) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
MultiAssetR t
x = String
"(MultiAsset " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. MultiAsset c -> PDoc
pcMultiAsset t
x) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
PolicyIDR (PolicyID ScriptHash (EraCrypto e)
x) = forall a. Show a => a -> String
show (forall era. ScriptHash era -> PDoc
pcScriptHash ScriptHash (EraCrypto e)
x)
synopsis (WitnessesFieldR Proof e
p) t
x = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era.
Reflect era =>
Proof era -> WitnessesField era -> [(Text, PDoc)]
pcWitnessesField Proof e
p t
x
synopsis Rep e t
AssetNameR (AssetName ShortByteString
x) = forall a. Int -> [a] -> [a]
take Int
10 (forall a. Show a => a -> String
show ShortByteString
x)
synopsis (TxCertR Proof e
p) (TxCertF Proof e
_ TxCert e
x) = forall a. Show a => a -> String
show (forall era. Proof era -> TxCert era -> PDoc
pcTxCert Proof e
p TxCert e
x)
synopsis Rep e t
RewardAccountR t
x = forall a. Show a => a -> String
show (forall c. RewardAccount c -> PDoc
pcRewardAccount t
x)
synopsis Rep e t
ValidityIntervalR t
x = forall a. Show a => a -> String
show (ValidityInterval -> PDoc
ppValidityInterval t
x)
synopsis Rep e t
KeyPairR t
_ = String
"(KeyPairR ...)"
synopsis (GenR Rep e x
x) t
_ = String
"(Gen " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rep e x
x forall a. [a] -> [a] -> [a]
++ String
" ...)"
synopsis (ScriptR Proof e
_) t
x = forall a. Show a => a -> String
show t
x -- The Show instance uses pcScript
synopsis Rep e t
ScriptHashR t
x = forall a. Show a => a -> String
show (forall era. ScriptHash era -> PDoc
pcScriptHash t
x)
synopsis Rep e t
NetworkR t
x = forall a. Show a => a -> String
show t
x
synopsis (RdmrPtrR Proof e
_) t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
DataR t
x = forall a. Show a => a -> String
show (forall era. Era era => Data era -> PDoc
pcData t
x)
synopsis Rep e t
DatumR t
x = forall a. Show a => a -> String
show (forall era. Era era => Datum era -> PDoc
pcDatum t
x)
synopsis Rep e t
ExUnitsR (ExUnits Natural
m Natural
d) = String
"(ExUnits mem=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Natural
m forall a. [a] -> [a] -> [a]
++ String
" data=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Natural
d forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
DataHashR t
x = forall a. Show a => a -> String
show (forall era. DataHash era -> PDoc
pcDataHash t
x)
synopsis Rep e t
PCredR t
c = forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
credSummary t
c)
synopsis Rep e t
ConwayTxCertR t
x = forall a. Show a => a -> String
show (forall c. ConwayTxCert c -> PDoc
pcConwayTxCert t
x)
synopsis Rep e t
ShelleyTxCertR t
x = forall a. Show a => a -> String
show (forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert t
x)
synopsis Rep e t
MIRPotR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
IsValidR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
IntegerR t
x = forall a. Show a => a -> String
show t
x
synopsis (ScriptsNeededR Proof e
_) t
x = forall a. Show a => a -> String
show t
x
synopsis (ScriptPurposeR Proof e
_) t
x = forall a. Show a => a -> String
show t
x
synopsis (TxBodyR Proof e
p) t
x = forall a. Show a => a -> String
show (forall era. Proof era -> TxBody era -> PDoc
pcTxBody Proof e
p (forall era. TxBodyF era -> TxBody era
unTxBodyF t
x))
synopsis Rep e t
BootstrapWitnessR t
x = String
"(BootstrapWitness " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c (r :: KeyRole). Crypto c => VKey r c -> PDoc
ppVKey (forall c. Crypto c => BootstrapWitness c -> VKey 'Witness c
bwKey t
x)) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
SigningKeyR t
key = String
"(publicKeyOfSecretKey " forall a. [a] -> [a] -> [a]
++ forall a. Format String a -> a
formatToString forall r. Format r (VerificationKey -> r)
shortVerificationKeyHexF (SigningKey -> VerificationKey
toVerification t
key) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis (TxWitsR Proof e
p) (TxWitsF Proof e
_ TxWits e
x) = forall a. Show a => a -> String
show ((forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era. Reflect era => Proof era -> TxWits era -> PDoc
pcWitnesses Proof e
p TxWits e
x) :: PDoc)
synopsis Rep e t
PayHashR t
k = String
"(KeyHash 'Payment " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
keyHashSummary t
k) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis (TxR Proof e
p) t
x = forall a. Show a => a -> String
show (forall era. Proof era -> Tx era -> PDoc
pcTx Proof e
p (forall era. TxF era -> Tx era
unTxF t
x))
synopsis Rep e t
ScriptIntegrityHashR t
x = forall a. Show a => a -> String
show (PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash (forall c i. SafeHash c i -> Hash (HASH c) i
extractHash t
x)))
synopsis Rep e t
AuxiliaryDataHashR (AuxiliaryDataHash SafeHash (EraCrypto e) EraIndependentTxAuxData
x) = forall a. Show a => a -> String
show (PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash (forall c i. SafeHash c i -> Hash (HASH c) i
extractHash SafeHash (EraCrypto e) EraIndependentTxAuxData
x)))
synopsis Rep e t
GovActionR t
x = forall a. Show a => a -> String
show (forall era. GovAction era -> PDoc
pcGovAction t
x)
synopsis (WitVKeyR Proof e
p) t
x = forall a. Show a => a -> String
show ((forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era (keyrole :: KeyRole).
(Reflect era, Typeable keyrole) =>
Proof era -> WitVKey keyrole (EraCrypto era) -> PDoc
pcWitVKey Proof e
p t
x) :: PDoc)
synopsis (TxAuxDataR Proof e
_) t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
CommColdCredR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
CommHotCredR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
LanguageR t
x = forall a. Show a => a -> String
show t
x
synopsis (LedgerStateR Proof e
p) t
x = forall a. Show a => a -> String
show ((forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof e
p t
x) :: PDoc)
synopsis Rep e t
StakeHashR t
k = String
"(KeyHash 'Staking " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
keyHashSummary t
k) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
BoolR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
DRepR t
x = forall a. Show a => a -> String
show (forall c. DRep c -> PDoc
pcDRep t
x)
synopsis (PoolMetadataR Proof e
_) t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
DRepStateR t
x = forall a. Show a => a -> String
show (forall c. DRepState c -> PDoc
pcDRepState t
x)
synopsis Rep e t
DStateR t
x = forall a. Show a => a -> String
show (forall c. DState c -> PDoc
pcDState t
x)
synopsis Rep e t
GovActionIdR t
x = forall a. Show a => a -> String
show (forall c. GovActionId c -> PDoc
pcGovActionId t
x)
synopsis Rep e t
GovActionIxR (GovActionIx Word16
a) = forall a. Show a => a -> String
show (forall a. Word16 -> Doc a
ppWord16 Word16
a)
synopsis Rep e t
GovActionStateR t
x = forall a. Show a => a -> String
show (forall era. GovActionState era -> PDoc
pcGovActionState t
x)
synopsis (ProposalsR Proof e
_p) t
x = forall a. Show a => a -> String
show (forall era. Proposals era -> PDoc
pcProposals t
x)
synopsis Rep e t
UnitIntervalR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
CommitteeR t
x = forall a. Show a => a -> String
show (forall era. Committee era -> PDoc
pcCommittee t
x)
synopsis Rep e t
ConstitutionR t
x = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall c. Constitution c -> PDoc
pcConstitution t
x
synopsis Rep e t
PrevGovActionIdsR t
x = forall a. Show a => a -> String
show (forall era. GovRelation StrictMaybe era -> PDoc
pcPrevGovActionIds t
x)
synopsis Rep e t
PrevPParamUpdateR (GovPurposeId GovActionId (EraCrypto e)
x) = forall e t. Rep e t -> t -> String
synopsis @e forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR GovActionId (EraCrypto e)
x
synopsis Rep e t
PrevHardForkR (GovPurposeId GovActionId (EraCrypto e)
x) = forall e t. Rep e t -> t -> String
synopsis @e forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR GovActionId (EraCrypto e)
x
synopsis Rep e t
PrevCommitteeR (GovPurposeId GovActionId (EraCrypto e)
x) = forall e t. Rep e t -> t -> String
synopsis @e forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR GovActionId (EraCrypto e)
x
synopsis Rep e t
PrevConstitutionR (GovPurposeId GovActionId (EraCrypto e)
x) = forall e t. Rep e t -> t -> String
synopsis @e forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR GovActionId (EraCrypto e)
x
synopsis Rep e t
RatifyStateR t
dr = forall a. Show a => a -> String
show (forall era. Proof era -> RatifyState era -> PDoc
pcRatifyState forall era. Reflect era => Proof era
reify t
dr)
synopsis Rep e t
NumDormantEpochsR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
CommitteeAuthorizationR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
CommitteeStateR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
VStateR t
x = forall a. Show a => a -> String
show t
x
synopsis Rep e t
DRepHashR t
k = String
"(KeyHash 'DRepRole " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
keyHashSummary t
k) forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
AnchorR t
k = forall a. Show a => a -> String
show (forall c. Anchor c -> PDoc
pcAnchor t
k)
synopsis Rep e t
EnactStateR t
x = forall a. Show a => a -> String
show (forall era. Proof era -> EnactState era -> PDoc
pcEnactState forall era. Reflect era => Proof era
reify t
x)
synopsis Rep e t
DRepPulserR t
x = forall a. Show a => a -> String
show (forall era. DRepPulser era Identity (RatifyState era) -> PDoc
pcDRepPulser t
x)
synopsis Rep e t
DelegateeR t
x = forall a. Show a => a -> String
show (forall c. Delegatee c -> PDoc
pcDelegatee t
x)
synopsis Rep e t
VoteR t
v = forall a. Show a => a -> String
show t
v

synSum :: Rep era a -> a -> String
synSum :: forall e t. Rep e t -> t -> String
synSum (MapR Rep era a
_ Rep era b
CoinR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Coin -> PDoc
pcCoin (forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall a. Semigroup a => a -> a -> a
(<>) forall a. Monoid a => a
mempty a
m))
synSum (MapR Rep era a
_ Rep era b
RationalR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall a. Num a => a -> a -> a
(+) Ratio Integer
0 a
m)
synSum (MapR Rep era a
_ Rep era b
IntR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall a. Num a => a -> a -> a
(+) Int
0 a
m)
synSum (MapR Rep era a
_ Rep era b
Word64R) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall a. Num a => a -> a -> a
(+) Word64
0 a
m)
synSum (MapR Rep era a
_ Rep era b
IPoolStakeR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall {c}. Ratio Integer -> IndividualPoolStake c -> Ratio Integer
accum Ratio Integer
0 a
m)
  where
    accum :: Ratio Integer -> IndividualPoolStake c -> Ratio Integer
accum Ratio Integer
z (IndividualPoolStake Ratio Integer
rat CompactForm Coin
_ Hash c (VerKeyVRF c)
_) = Ratio Integer
z forall a. Num a => a -> a -> a
+ Ratio Integer
rat
synSum (MapR Rep era a
_ (TxOutR Proof era
proof)) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' (forall era. Proof era -> Coin -> TxOutF era -> Coin
accumTxOut Proof era
proof) (Integer -> Coin
Coin Integer
0) a
m)
synSum (MapR Rep era a
_ Rep era b
ExUnitsR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall x. Adds x => x -> x -> x
add forall x. Adds x => x
zero a
m)
synSum (SetR Rep era a
CoinR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Coin -> PDoc
pcCoin (forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' forall a. Semigroup a => a -> a -> a
(<>) forall a. Monoid a => a
mempty a
m))
synSum (SetR Rep era a
RationalR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' forall a. Num a => a -> a -> a
(+) Ratio Integer
0 a
m)
synSum (ListR Rep era a
CoinR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall a. Semigroup a => a -> a -> a
(<>) forall a. Monoid a => a
mempty a
m)
synSum (ListR Rep era a
RationalR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall a. Num a => a -> a -> a
(+) Ratio Integer
0 a
m)
synSum (ListR Rep era a
IntR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall a. Num a => a -> a -> a
(+) Int
0 a
m)
synSum (ListR Rep era a
Word64R) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall a. Num a => a -> a -> a
(+) Word64
0 a
m)
synSum (ListR (TxOutR Proof era
proof)) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (forall era. Proof era -> Coin -> TxOutF era -> Coin
accumTxOut Proof era
proof) (Integer -> Coin
Coin Integer
0) a
m)
synSum (ListR Rep era a
ExUnitsR) a
m = String
", sum = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall x. Adds x => x -> x -> x
add forall x. Adds x => x
zero a
m)
synSum Rep era a
_ a
_ = String
""

accumTxOut :: Proof era -> Coin -> TxOutF era -> Coin
accumTxOut :: forall era. Proof era -> Coin -> TxOutF era -> Coin
accumTxOut Proof era
Shelley Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z forall t. Val t => t -> t -> t
<+> (TxOut era
out forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Core.coinTxOutL)
accumTxOut Proof era
Allegra Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z forall t. Val t => t -> t -> t
<+> (TxOut era
out forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Core.coinTxOutL)
accumTxOut Proof era
Mary Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z forall t. Val t => t -> t -> t
<+> (TxOut era
out forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Core.coinTxOutL)
accumTxOut Proof era
Alonzo Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z forall t. Val t => t -> t -> t
<+> (TxOut era
out forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Core.coinTxOutL)
accumTxOut Proof era
Babbage Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z forall t. Val t => t -> t -> t
<+> (TxOut era
out forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Core.coinTxOutL)
accumTxOut Proof era
Conway Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z forall t. Val t => t -> t -> t
<+> (TxOut era
out forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Core.coinTxOutL)

-- ==================================================

genSizedRep ::
  forall era t.
  Int ->
  Rep era t ->
  Gen t
genSizedRep :: forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
_ Rep era t
TxIdR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
CoinR =
  if Int
n forall a. Eq a => a -> a -> Bool
== Int
0
    then do Positive Integer
m <- forall a. Arbitrary a => Gen a
arbitrary; forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Coin
Coin Integer
m)
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Coin
Coin (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
genSizedRep Int
n (Rep era a
_a :-> Rep era b
b) = forall a b. a -> b -> a
const forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era b
b
genSizedRep Int
n r :: Rep era t
r@(MapR Rep era a
a Rep era b
b) = do
  forall a b.
Ord a =>
[String] -> Int -> Gen a -> Gen b -> Gen (Map a b)
mapSized [String
"From genSizedRep " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rep era t
r] Int
n (forall era b. Rep era b -> Gen b
genRep Rep era a
a) (forall era b. Rep era b -> Gen b
genRep Rep era b
b)
genSizedRep Int
n r :: Rep era t
r@(SetR Rep era a
a) = do
  forall a. Ord a => [String] -> Int -> Gen a -> Gen (Set a)
setSized [String
"From genSizedRep " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rep era t
r] Int
n (forall era b. Rep era b -> Gen b
genRep Rep era a
a)
genSizedRep Int
n (ListR Rep era a
a) = forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era a
a)
genSizedRep Int
_ Rep era t
AddrR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
CredR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PoolHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
WitHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
GenHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
GenDelegHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PoolParamsR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
EpochR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word64 -> EpochNo
EpochNo forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
genSizedRep Int
n Rep era t
EpochIntervalR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
genSizedRep Int
_ Rep era t
RationalR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
Word64R = forall a. Random a => (a, a) -> Gen a
choose (t
0, t
1000)
genSizedRep Int
n Rep era t
IntR = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n
genSizedRep Int
n Rep era t
NaturalR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
genSizedRep Int
_ Rep era t
FloatR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
TxInR =
  forall c. TxId c -> TxIx -> TxIn c
TxIn
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HasCallStack => Integer -> TxIx
mkTxIxPartial forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Int
2, forall a. Ord a => a -> a -> a
min Int
n (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word16))))
genSizedRep Int
_ Rep era t
CharR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (ValueR Proof era
p) = forall era. Proof era -> Gen (ValueF era)
genValue Proof era
p
genSizedRep Int
_ (TxOutR Proof era
p) = forall era. Proof era -> Gen (TxOutF era)
genTxOut Proof era
p
genSizedRep Int
_n (UTxOR Proof era
p) = forall era. Proof era -> Gen (UTxO era)
genUTxO Proof era
p
genSizedRep Int
_ (PParamsR Proof era
p) = forall era. Proof era -> Gen (PParamsF era)
genPParams Proof era
p
genSizedRep Int
_ (FuturePParamsR Proof era
p) = forall era. Proof era -> Gen (FuturePParams era)
genFuturePParams Proof era
p
genSizedRep Int
_ (PParamsUpdateR Proof era
p) = forall era. Proof era -> Gen (PParamsUpdateF era)
genPParamsUpdate Proof era
p
genSizedRep Int
_ Rep era t
DeltaCoinR = Integer -> DeltaCoin
DeltaCoin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (-Integer
1000, Integer
1000)
genSizedRep Int
_ Rep era t
GenDelegPairR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
FutureGenDelegR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ r :: Rep era t
r@(PPUPStateR Proof era
_) = forall era.
Rep era (ShelleyGovState era) -> Gen (ShelleyGovState era)
genpup Rep era t
r
genSizedRep Int
_ Rep era t
PtrR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
IPoolStakeR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
SnapShotsR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
UnitR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n (PairR Rep era a
a Rep era b
b) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era b
b
genSizedRep Int
_ Rep era t
RewardR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n (MaybeR Rep era t
x) = forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing), (Int
5, forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era t
x)]
genSizedRep Int
_ Rep era t
NewEpochStateR = forall a. HasCallStack => String -> a
error String
"no way to gen a random NewEpochState"
genSizedRep Int
_ (ProtVerR Proof era
proof) = forall era. Era era => Proof era -> Gen ProtVer
genProtVer Proof era
proof
genSizedRep Int
n Rep era t
SlotNoR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
genSizedRep Int
_ Rep era t
SizeR = do Int
lo <- forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
6); Int
hi <- forall a. Random a => (a, a) -> Gen a
choose (Int
6, Int
10); forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Size
SzRng Int
lo Int
hi)
genSizedRep Int
_ Rep era t
VCredR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
VHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
MultiAssetR = forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n (forall t era s.
Ord t =>
Rep era t -> Rep era s -> Rep era (Map t s)
MapR (forall era. Era era => Rep era (PolicyID (EraCrypto era))
PolicyIDR @era) (forall t era s.
Ord t =>
Rep era t -> Rep era s -> Rep era (Map t s)
MapR forall era. Rep era AssetName
AssetNameR forall era. Rep era Integer
IntegerR))
genSizedRep Int
_ Rep era t
PolicyIDR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (WitnessesFieldR Proof era
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
Set (WitVKey 'Witness (EraCrypto era)) -> WitnessesField era
AddrWits forall a. Set a
Set.empty
genSizedRep Int
_ Rep era t
AssetNameR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
RewardAccountR = forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure Network
Testnet forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Shelley) = forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (ShelleyEra StandardCrypto)
Shelley forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Allegra) = forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (AllegraEra StandardCrypto)
Allegra forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Mary) = forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (MaryEra StandardCrypto)
Mary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Alonzo) = forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (AlonzoEra StandardCrypto)
Alonzo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Babbage) = forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (BabbageEra StandardCrypto)
Babbage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Conway) = forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (ConwayEra StandardCrypto)
Conway forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
ValidityIntervalR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
KeyPairR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n (GenR Rep era x
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era x
x)
genSizedRep Int
_ (ScriptR Proof era
p) = forall era. Era era => Proof era -> Gen (ScriptF era)
genScriptF Proof era
p
genSizedRep Int
_ Rep era t
ScriptHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
NetworkR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n (RdmrPtrR Proof era
p) =
  case Proof era
p of
    Proof era
Shelley -> forall a. HasCallStack => String -> a
error String
"Redeemers are not supported in Shelley"
    Proof era
Allegra -> forall a. HasCallStack => String -> a
error String
"Redeemers are not supported in Allegra"
    Proof era
Mary -> forall a. HasCallStack => String -> a
error String
"Redeemers are not supported in Mary"
    Proof era
Alonzo -> do
      Word32
i <- forall a. Random a => (a, a) -> Gen a
choose (Word32
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      forall era.
Proof era -> PlutusPurpose AsIx era -> PlutusPointerF era
PlutusPointerF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. Word32 -> Gen (AlonzoPlutusPurpose AsIx era)
genAlonzoPlutusPurposePointer Word32
i
    Proof era
Babbage -> do
      Word32
i <- forall a. Random a => (a, a) -> Gen a
choose (Word32
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      forall era.
Proof era -> PlutusPurpose AsIx era -> PlutusPointerF era
PlutusPointerF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. Word32 -> Gen (AlonzoPlutusPurpose AsIx era)
genAlonzoPlutusPurposePointer Word32
i
    Proof era
Conway -> do
      Word32
i <- forall a. Random a => (a, a) -> Gen a
choose (Word32
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      forall era.
Proof era -> PlutusPurpose AsIx era -> PlutusPointerF era
PlutusPointerF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. Word32 -> Gen (ConwayPlutusPurpose AsIx era)
genConwayPlutusPurposePointer Word32
i
genSizedRep Int
_ Rep era t
DataR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
DatumR =
  forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall era. Datum era
NoDatum
    , forall era. DataHash (EraCrypto era) -> Datum era
DatumHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep @era Int
n forall era. Era era => Rep era (DataHash (EraCrypto era))
DataHashR
    , forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep @era Int
n forall era. Era era => Rep era (Data era)
DataR
    ]
genSizedRep Int
_ Rep era t
ExUnitsR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DataHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PCredR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
ShelleyTxCertR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
ConwayTxCertR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
MIRPotR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
IsValidR = forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IsValid
IsValid Bool
False)), (Int
9, forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IsValid
IsValid Bool
True))]
genSizedRep Int
_ Rep era t
IntegerR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (ScriptsNeededR Proof era
p) = case forall era. Proof era -> UTxOWit era
whichUTxO Proof era
p of
  UTxOWit era
UTxOShelleyToMary -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> ScriptsNeeded era -> ScriptsNeededF era
ScriptsNeededF Proof era
p (forall era.
Set (ScriptHash (EraCrypto era)) -> ShelleyScriptsNeeded era
ShelleyScriptsNeeded forall a. Set a
Set.empty)
  UTxOWit era
UTxOAlonzoToConway -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> ScriptsNeeded era -> ScriptsNeededF era
ScriptsNeededF Proof era
p (forall era.
[(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded [])
genSizedRep Int
_ (ScriptPurposeR Proof era
p) =
  case Proof era
p of
    Proof era
Shelley -> forall a. HasCallStack => String -> a
error String
"PlutusPurpose is not supported in Shelley"
    Proof era
Allegra -> forall a. HasCallStack => String -> a
error String
"PlutusPurpose is not supported in Allegra"
    Proof era
Mary -> forall a. HasCallStack => String -> a
error String
"PlutusPurpose is not supported in Mary"
    Proof era
Alonzo -> forall era.
Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era
PlutusPurposeF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Babbage -> forall era.
Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era
PlutusPurposeF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Conway -> forall era.
Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era
PlutusPurposeF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxBodyR Proof era
p) =
  case Proof era
p of
    Proof era
Shelley -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
    Proof era
Allegra -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
    Proof era
Mary -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
    Proof era
Alonzo -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
    Proof era
Babbage -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
    Proof era
Conway -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
genSizedRep Int
_ Rep era t
BootstrapWitnessR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
SigningKeyR = Gen SigningKey
genSigningKey
genSizedRep Int
_ (TxWitsR Proof era
p) =
  case Proof era
p of
    Proof era
Shelley -> forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Allegra -> forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Mary -> forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Alonzo -> forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Babbage -> forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Conway -> forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PayHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxR Proof era
p) =
  case Proof era
p of
    Proof era
Shelley -> forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Allegra -> forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Mary -> forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Alonzo -> forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Babbage -> forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Conway -> forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
ScriptIntegrityHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
AuxiliaryDataHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
GovActionR = forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (WitVKeyR Proof era
_) = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxAuxDataR Proof era
p) = forall era. Proof era -> Gen (TxAuxDataF era)
genTxAuxDataF Proof era
p
genSizedRep Int
_ Rep era t
CommColdCredR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
CommHotCredR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
LanguageR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (LedgerStateR Proof era
p) = case Proof era
p of
  Proof era
Shelley -> forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Allegra -> forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Mary -> forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Alonzo -> forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Babbage -> forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Conway -> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
StakeHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
BoolR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DRepR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (PoolMetadataR Proof era
p) =
  if forall era. Proof era -> Bool
restrictHash Proof era
p
    then Url -> ByteString -> PoolMetadata
PoolMetadata forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ByteString -> ByteString
BS.take (forall era. Crypto (EraCrypto era) => Proof era -> Int
hashsize Proof era
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)
    else Url -> ByteString -> PoolMetadata
PoolMetadata forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DRepStateR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DStateR =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( forall era.
UMap (EraCrypto era)
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> GenDelegs (EraCrypto era)
-> InstantaneousRewards (EraCrypto era)
-> DState era
DState
        forall c. UMap c
UM.empty
        forall k a. Map k a
Map.empty
        (forall c. Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
GenDelegs forall k a. Map k a
Map.empty)
        (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
    )
genSizedRep Int
_ Rep era t
GovActionIdR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
GovActionIxR = Word16 -> GovActionIx
GovActionIx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Word16
0, Word16
100)
genSizedRep Int
n (ProposalsR Proof era
p) = case Proof era
p of
  Proof era
Shelley -> forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Allegra -> forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Mary -> forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Alonzo -> forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Babbage -> forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Conway -> forall era.
(HasCallStack, EraPParams era,
 Arbitrary (PParamsHKD StrictMaybe era)) =>
(Int, Int) -> Gen (Proposals era)
genProposals (Int
5, forall a. Ord a => a -> a -> a
min Int
n Int
7)
genSizedRep Int
_ Rep era t
GovActionStateR =
  forall era.
GovActionId (EraCrypto era)
-> Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
-> Map (KeyHash 'StakePool (EraCrypto era)) Vote
-> ProposalProcedure era
-> EpochNo
-> EpochNo
-> GovActionState era
GovActionState
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Map.empty
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Map.empty
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Map.empty
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall era.
Coin
-> RewardAccount (EraCrypto era)
-> GovAction era
-> Anchor (EraCrypto era)
-> ProposalProcedure era
ProposalProcedure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era b. Rep era b -> Gen b
genRep @era forall era. Rep era Coin
CoinR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall era b. Rep era b -> Gen b
genRep @era forall era. Era era => Rep era (GovAction era)
GovActionR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
UnitIntervalR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
CommitteeR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
ConstitutionR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PrevGovActionIdsR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PrevPParamUpdateR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PrevHardForkR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PrevCommitteeR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PrevConstitutionR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
RatifyStateR =
  forall era.
EnactState era
-> Seq (GovActionState era)
-> Set (GovActionId (EraCrypto era))
-> Bool
-> RatifyState era
RatifyState
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n forall era. Reflect era => Rep era (EnactState era)
EnactStateR
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
NumDormantEpochsR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
CommitteeAuthorizationR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
CommitteeStateR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
VStateR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DRepHashR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
AnchorR = forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
EnactStateR =
  forall era.
StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking (EraCrypto era)) Coin
-> GovRelation StrictMaybe era
-> EnactState era
EnactState
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall era. PParamsF era -> PParams era
unPParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. Proof era -> Gen (PParamsF era)
genPParams forall era. Reflect era => Proof era
reify)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall era. PParamsF era -> PParams era
unPParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. Proof era -> Gen (PParamsF era)
genPParams forall era. Reflect era => Proof era
reify)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DRepPulserR = do
  StrictSeq (GovActionState era)
props <- forall a. [a] -> StrictSeq a
SS.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era b. Rep era b -> Gen b
genRep forall era. Era era => Rep era (GovActionState era)
GovActionStateR
  forall era ans (m :: * -> *).
(ans ~ RatifyState era, m ~ Identity, RunConwayRatify era) =>
Int
-> UMap (EraCrypto era)
-> Int
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
-> PoolDistr (EraCrypto era)
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> EpochNo
-> CommitteeState era
-> EnactState era
-> StrictSeq (GovActionState era)
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
-> Globals
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> DRepPulser era m ans
DRepPulser
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary -- pulsesize
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary -- umap
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary -- balance
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary -- stakedistr
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary -- poolDistr
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary -- partial drep distr
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary -- drepstate
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary -- epoch
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary -- committeestate
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall era b. Rep era b -> Gen b
genRep forall era. Reflect era => Rep era (EnactState era)
EnactStateR
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictSeq (GovActionState era)
props
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era.
Proposals era
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
proposalsDeposits forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
Lens'
  (Proposals era)
  (OMap (GovActionId (EraCrypto era)) (GovActionState era))
pPropsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (f :: * -> *) k v.
(Foldable f, HasOKey k v) =>
f v -> OMap k v
OMap.fromFoldable StrictSeq (GovActionState era)
props)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Globals
testGlobals
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary -- poolparams
genSizedRep Int
n Rep era t
DelegateeR =
  forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ forall c. KeyHash 'StakePool c -> Delegatee c
DelegStake forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n (forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR @era)
    , forall c. DRep c -> Delegatee c
DelegVote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n (forall era. Era era => Rep era (DRep (EraCrypto era))
DRepR @era)
    , forall c. KeyHash 'StakePool c -> DRep c -> Delegatee c
DelegStakeVote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n (forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR @era) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n (forall era. Era era => Rep era (DRep (EraCrypto era))
DRepR @era)
    ]
genSizedRep Int
_ Rep era t
VoteR = forall a. Arbitrary a => Gen a
arbitrary

genRep ::
  forall era b.
  Rep era b ->
  Gen b
genRep :: forall era b. Rep era b -> Gen b
genRep Rep era b
IntR = forall a. Random a => (a, a) -> Gen a
choose (b
0, b
10000)
genRep Rep era b
x = do (NonNegative Int
n) <- forall a. Arbitrary a => Gen a
arbitrary; forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era b
x

-- | Turn a random bytestring into a SigningKey
genSigningKey :: Gen SigningKey
genSigningKey :: Gen SigningKey
genSigningKey = do
  ByteString
seed <- Int -> Gen ByteString
genByteString Int
32
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrv -> SigningKey
SigningKey forall a b. (a -> b) -> a -> b
$ forall passPhrase seed.
(ByteArrayAccess passPhrase, ByteArrayAccess seed) =>
seed -> passPhrase -> XPrv
Byron.generate ByteString
seed (forall a. Monoid a => a
mempty :: ByteString))

genProtVer :: Era era => Proof era -> Gen ProtVer
genProtVer :: forall era. Era era => Proof era -> Gen ProtVer
genProtVer Proof era
proof = forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. a -> Version -> (a, Gen ProtVer)
pair [Int
count, Int
count forall a. Num a => a -> a -> a
- Int
1 .. Int
1] [Version]
versions)
  where
    versions :: [Version]
versions = forall era. Era era => Proof era -> [Version]
protVerRange Proof era
proof
    count :: Int
count = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Version]
versions
    pair :: a -> Version -> (a, Gen ProtVer)
pair a
n Version
version = (a
n, Version -> Natural -> ProtVer
ProtVer Version
version forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
elements [Natural
0 .. Natural
4])

protVerRange :: forall era. Era era => Proof era -> [Version]
protVerRange :: forall era. Era era => Proof era -> [Version]
protVerRange Proof era
_ = [forall era. Era era => Version
Core.eraProtVerLow @era .. forall era. Era era => Version
Core.eraProtVerHigh @era]

genpup :: Rep era (ShelleyGovState era) -> Gen (ShelleyGovState era)
genpup :: forall era.
Rep era (ShelleyGovState era) -> Gen (ShelleyGovState era)
genpup (PPUPStateR Proof era
Shelley) = forall a. Arbitrary a => Gen a
arbitrary
genpup (PPUPStateR Proof era
Allegra) = forall a. Arbitrary a => Gen a
arbitrary
genpup (PPUPStateR Proof era
Mary) = forall a. Arbitrary a => Gen a
arbitrary
genpup (PPUPStateR Proof era
Alonzo) = forall a. Arbitrary a => Gen a
arbitrary
genpup (PPUPStateR Proof era
Babbage) = forall a. Arbitrary a => Gen a
arbitrary
genpup (PPUPStateR Proof era
Conway) = forall a. Arbitrary a => Gen a
arbitrary -- FIXME when Conway is fully defined.

-- ===========================
-- QuickCheck shrinking

-- Not all types in the universe have Arbitrary instances and thus don't shrink (the `[]` cases).
-- TODO: add instances for these types.
shrinkRep :: Rep era t -> t -> [t]
shrinkRep :: forall era t. Rep era t -> t -> [t]
shrinkRep Rep era t
TxIdR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
CoinR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (Rep era a
_ :-> Rep era b
_) t
_ = []
shrinkRep (MapR Rep era a
a Rep era b
b) t
t = forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall k a. Map k a -> [(k, a)]
Map.toList (forall era t. Rep era t -> t -> [t]
shrinkRep forall a b. (a -> b) -> a -> b
$ forall era t. Rep era t -> Rep era [t]
ListR (forall era t s. Rep era t -> Rep era s -> Rep era (t, s)
PairR Rep era a
a Rep era b
b)) t
t
shrinkRep (SetR Rep era a
a) t
t = forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy forall a. Ord a => [a] -> Set a
Set.fromList forall a. Set a -> [a]
Set.toList (forall era t. Rep era t -> t -> [t]
shrinkRep forall a b. (a -> b) -> a -> b
$ forall era t. Rep era t -> Rep era [t]
ListR Rep era a
a) t
t
shrinkRep (ListR Rep era a
a) t
t = forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (forall era t. Rep era t -> t -> [t]
shrinkRep Rep era a
a) t
t
shrinkRep Rep era t
CredR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
PoolHashR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
WitHashR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
GenHashR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
GenDelegHashR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
PoolParamsR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
EpochR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
EpochIntervalR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
RationalR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
Word64R t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
IntR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
NaturalR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
FloatR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
TxInR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (ValueR Proof era
_) t
_ = []
shrinkRep (TxOutR Proof era
_) t
_ = []
shrinkRep (UTxOR Proof era
_) t
_ = []
shrinkRep (PParamsR Proof era
_) t
_ = []
shrinkRep (FuturePParamsR Proof era
_) t
_ = []
shrinkRep (PParamsUpdateR Proof era
_) t
_ = []
shrinkRep Rep era t
CharR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
DeltaCoinR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
GenDelegPairR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
FutureGenDelegR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (PPUPStateR Proof era
_) t
_ = []
shrinkRep Rep era t
PtrR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
IPoolStakeR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
SnapShotsR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
UnitR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (PairR Rep era a
a Rep era b
b) (a
x, b
y) = [(a
x', b
y) | a
x' <- forall era t. Rep era t -> t -> [t]
shrinkRep Rep era a
a a
x] forall a. [a] -> [a] -> [a]
++ [(a
x, b
y') | b
y' <- forall era t. Rep era t -> t -> [t]
shrinkRep Rep era b
b b
y]
shrinkRep Rep era t
RewardR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (MaybeR Rep era t
a) t
t = forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy forall a. [a] -> Maybe a
listToMaybe forall a. Maybe a -> [a]
maybeToList (forall era t. Rep era t -> t -> [t]
shrinkRep forall a b. (a -> b) -> a -> b
$ forall era t. Rep era t -> Rep era [t]
ListR Rep era t
a) t
t
shrinkRep Rep era t
NewEpochStateR t
_ = []
shrinkRep (ProtVerR Proof era
_) t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
SlotNoR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
SizeR t
_ = []
shrinkRep Rep era t
MultiAssetR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
PolicyIDR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (WitnessesFieldR Proof era
_) t
_ = []
shrinkRep Rep era t
AssetNameR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (TxCertR Proof era
Shelley) (TxCertF Proof (ShelleyEra StandardCrypto)
p TxCert (ShelleyEra StandardCrypto)
x) = forall a b. (a -> b) -> [a] -> [b]
map (forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (ShelleyEra StandardCrypto)
p) (forall a. Arbitrary a => a -> [a]
shrink TxCert (ShelleyEra StandardCrypto)
x)
shrinkRep (TxCertR Proof era
Allegra) (TxCertF Proof (AllegraEra StandardCrypto)
p TxCert (AllegraEra StandardCrypto)
x) = forall a b. (a -> b) -> [a] -> [b]
map (forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (AllegraEra StandardCrypto)
p) (forall a. Arbitrary a => a -> [a]
shrink TxCert (AllegraEra StandardCrypto)
x)
shrinkRep (TxCertR Proof era
Mary) (TxCertF Proof (MaryEra StandardCrypto)
p TxCert (MaryEra StandardCrypto)
x) = forall a b. (a -> b) -> [a] -> [b]
map (forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (MaryEra StandardCrypto)
p) (forall a. Arbitrary a => a -> [a]
shrink TxCert (MaryEra StandardCrypto)
x)
shrinkRep (TxCertR Proof era
Alonzo) (TxCertF Proof (AlonzoEra StandardCrypto)
p TxCert (AlonzoEra StandardCrypto)
x) = forall a b. (a -> b) -> [a] -> [b]
map (forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (AlonzoEra StandardCrypto)
p) (forall a. Arbitrary a => a -> [a]
shrink TxCert (AlonzoEra StandardCrypto)
x)
shrinkRep (TxCertR Proof era
Babbage) (TxCertF Proof (BabbageEra StandardCrypto)
p TxCert (BabbageEra StandardCrypto)
x) = forall a b. (a -> b) -> [a] -> [b]
map (forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (BabbageEra StandardCrypto)
p) (forall a. Arbitrary a => a -> [a]
shrink TxCert (BabbageEra StandardCrypto)
x)
shrinkRep (TxCertR Proof era
Conway) (TxCertF Proof (ConwayEra StandardCrypto)
p TxCert (ConwayEra StandardCrypto)
x) = forall a b. (a -> b) -> [a] -> [b]
map (forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof (ConwayEra StandardCrypto)
p) (forall a. Arbitrary a => a -> [a]
shrink TxCert (ConwayEra StandardCrypto)
x)
shrinkRep Rep era t
RewardAccountR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
ValidityIntervalR t
_ = []
shrinkRep Rep era t
KeyPairR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (GenR Rep era x
_) t
_ = []
shrinkRep (ScriptR Proof era
_) t
_ = []
shrinkRep Rep era t
ScriptHashR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
VCredR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
VHashR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
NetworkR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (RdmrPtrR Proof era
_) t
_ = []
shrinkRep Rep era t
DataR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
DatumR t
_ = []
shrinkRep Rep era t
ExUnitsR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
DataHashR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
AddrR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
PCredR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
ShelleyTxCertR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
ConwayTxCertR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
MIRPotR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
IsValidR t
_ = []
shrinkRep Rep era t
IntegerR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (ScriptsNeededR Proof era
_) t
_ = []
shrinkRep (ScriptPurposeR Proof era
_) t
_ = []
shrinkRep (TxBodyR Proof era
_) t
_ = []
shrinkRep Rep era t
BootstrapWitnessR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
SigningKeyR t
_ = []
shrinkRep (TxWitsR Proof era
_p) t
_ = []
shrinkRep Rep era t
PayHashR t
t = forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (TxR Proof era
_) t
_ = []
shrinkRep Rep era t
ScriptIntegrityHashR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
AuxiliaryDataHashR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
GovActionR t
_ = []
shrinkRep (WitVKeyR Proof era
_) t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep (TxAuxDataR Proof era
_) t
_ = []
shrinkRep Rep era t
CommColdCredR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
CommHotCredR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
LanguageR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep (LedgerStateR Proof era
_) t
_ = []
shrinkRep Rep era t
StakeHashR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
BoolR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
DRepR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep (PoolMetadataR Proof era
_) t
_ = []
shrinkRep Rep era t
DRepStateR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
DStateR t
_ = []
shrinkRep Rep era t
GovActionIdR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
GovActionIxR (GovActionIx Word16
n) = forall a b. (a -> b) -> [a] -> [b]
map Word16 -> GovActionIx
GovActionIx (forall a. Arbitrary a => a -> [a]
shrink Word16
n)
shrinkRep Rep era t
GovActionStateR t
_ = []
shrinkRep (ProposalsR Proof era
_) t
_ = []
shrinkRep Rep era t
UnitIntervalR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
CommitteeR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
ConstitutionR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
PrevGovActionIdsR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
PrevPParamUpdateR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
PrevHardForkR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
PrevCommitteeR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
PrevConstitutionR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
RatifyStateR t
_ = []
shrinkRep Rep era t
CommitteeAuthorizationR t
_ = []
shrinkRep Rep era t
CommitteeStateR t
_ = []
shrinkRep Rep era t
VStateR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
EnactStateR t
_ = []
shrinkRep Rep era t
NumDormantEpochsR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
DRepHashR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
AnchorR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
DRepPulserR t
_ = []
shrinkRep Rep era t
DelegateeR t
_ = []
shrinkRep Rep era t
VoteR t
x = forall a. Arbitrary a => a -> [a]
shrink t
x

hasOrd :: Rep era t -> s t -> Typed (HasConstraint Ord (s t))
hasOrd :: forall era t (s :: * -> *).
Rep era t -> s t -> Typed (HasConstraint Ord (s t))
hasOrd Rep era t
rep s t
x = case forall era t. Rep era t -> HasInstances t
repHasInstances Rep era t
rep of
  HasInstances t
IsOrd -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) t (s :: * -> *).
c t =>
s t -> HasConstraint c (s t)
With s t
x
  HasInstances t
IsTypeable -> forall a. [String] -> Typed a
failT [forall a. Show a => a -> String
show Rep era t
rep forall a. [a] -> [a] -> [a]
++ String
" does not have an Ord instance."]

hasEq :: Rep era t -> s t -> Typed (HasConstraint Eq (s t))
hasEq :: forall era t (s :: * -> *).
Rep era t -> s t -> Typed (HasConstraint Eq (s t))
hasEq Rep era t
rep s t
x = case forall era t. Rep era t -> HasInstances t
repHasInstances Rep era t
rep of
  HasInstances t
IsEq -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) t (s :: * -> *).
c t =>
s t -> HasConstraint c (s t)
With s t
x
  HasInstances t
IsTypeable -> forall a. [String] -> Typed a
failT [forall a. Show a => a -> String
show Rep era t
rep forall a. [a] -> [a] -> [a]
++ String
" does not have an Eq instance."]

format :: Rep era t -> t -> String
format :: forall e t. Rep e t -> t -> String
format rep :: Rep era t
rep@(MapR Rep era a
d Rep era b
r) t
x = forall a. Show a => a -> String
show (forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap (forall era t. Rep era t -> t -> PDoc
syn Rep era a
d) (forall era t. Rep era t -> t -> PDoc
syn Rep era b
r) t
x) forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synSum Rep era t
rep t
x forall a. [a] -> [a] -> [a]
++ String
"\nsize=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall k a. Map k a -> Int
Map.size t
x)
format rep :: Rep era t
rep@(ListR Rep era a
d) t
x = forall a. Show a => a -> String
show (forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era t. Rep era t -> t -> PDoc
syn Rep era a
d) t
x) forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synSum Rep era t
rep t
x forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synSum Rep era t
rep t
x forall a. [a] -> [a] -> [a]
++ String
"\nsize=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length t
x)
format rep :: Rep era t
rep@(SetR Rep era a
d) t
x = forall a. Show a => a -> String
show (forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (forall era t. Rep era t -> t -> PDoc
syn Rep era a
d) t
x) forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synSum Rep era t
rep t
x forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synSum Rep era t
rep t
x forall a. [a] -> [a] -> [a]
++ String
"\nsize=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Set a -> Int
Set.size t
x)
format (MaybeR Rep era t
d) t
x = forall a. Show a => a -> String
show (forall x ann. (x -> Doc ann) -> Maybe x -> Doc ann
ppMaybe (forall era t. Rep era t -> t -> PDoc
syn Rep era t
d) t
x)
format Rep era t
r t
x = forall e t. Rep e t -> t -> String
synopsis Rep era t
r t
x

syn :: Rep era t -> t -> PDoc
syn :: forall era t. Rep era t -> t -> PDoc
syn Rep era t
d t
x = forall a. String -> Doc a
ppString (forall e t. Rep e t -> t -> String
format Rep era t
d t
x)