{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# 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.BaseTypes (
  EpochInterval (..),
  EpochNo (..),
  Network (..),
  ProtVer (..),
  SlotNo (..),
  StrictMaybe (..),
  UnitInterval,
  mkTxIxPartial,
 )
import Cardano.Ledger.Binary.Version (Version)
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.State (VState (..))
import Cardano.Ledger.Conway.TxCert (ConwayTxCert (..), Delegatee (..))
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (Credential, Ptr)
import Cardano.Ledger.Hashes (GenDelegPair (..), GenDelegs (..))
import Cardano.Ledger.Keys (BootstrapWitness (..), WitVKey (..))
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.PoolParams (PoolMetadata (..), PoolParams (ppId))
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.State
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.Val (Val ((<+>)))
import Control.Monad.Identity (Identity)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Default (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.Allegra.Arbitrary ()
import Test.Cardano.Ledger.Alonzo.Arbitrary (genAlonzoPlutusPurposePointer)
import Test.Cardano.Ledger.Binary.Arbitrary (genByteString)
import Test.Cardano.Ledger.Constrained.Classes (
  Adds (add, zero),
  CertStateF (..),
  PParamsF (..),
  PParamsUpdateF (..),
  PlutusPointerF (..),
  PlutusPurposeF (..),
  ScriptF (..),
  ScriptsNeededF (..),
  TxAuxDataF (..),
  TxBodyF (..),
  TxCertF (..),
  TxF (..),
  TxOutF (..),
  TxWitsF (..),
  ValueF (..),
  genCertState,
  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,
  pcCertState,
  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 (ProtVer -> Bool) -> ProtVer -> Bool
forall a b. (a -> b) -> a -> b
$ Proof era -> ProtVer
forall era. Proof era -> ProtVer
protocolVersion Proof era
p

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

-- =======================================================================
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
  CredR :: Era era => Rep era (Credential 'Staking)
  VCredR :: Era era => Rep era (Credential 'DRepRole)
  PoolHashR :: Era era => Rep era (KeyHash 'StakePool)
  WitHashR :: Era era => Rep era (KeyHash 'Witness)
  GenHashR :: Era era => Rep era (KeyHash 'Genesis)
  GenDelegHashR :: Era era => Rep era (KeyHash 'GenesisDelegate)
  VHashR :: Era era => Rep era (KeyHash 'DRepRole)
  CommColdCredR :: Era era => Rep era (Credential 'ColdCommitteeRole)
  CommHotCredR :: Era era => Rep era (Credential 'HotCommitteeRole)
  PoolParamsR :: Era era => Rep era PoolParams
  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
  TxIdR :: Era era => Rep era TxId
  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)
  CertStateR :: Reflect era => Rep era (CertStateF era)
  --
  DeltaCoinR :: Rep era DeltaCoin
  GenDelegPairR :: Era era => Rep era GenDelegPair
  FutureGenDelegR :: Era era => Rep era FutureGenDeleg
  PPUPStateR :: Era era => Proof era -> Rep era (ShelleyGovState era)
  PtrR :: Rep era Ptr
  IPoolStakeR :: Era era => Rep era IndividualPoolStake
  SnapShotsR :: Era era => Rep era SnapShots
  RewardR :: Era era => Rep era Reward
  MaybeR :: Rep era t -> Rep era (Maybe t)
  SlotNoR :: Rep era SlotNo
  SizeR :: Rep era Size
  MultiAssetR :: Era era => Rep era MultiAsset
  PolicyIDR :: Era era => Rep era PolicyID
  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
  ValidityIntervalR :: Era era => Rep era ValidityInterval
  KeyPairR :: Era era => Rep era (KeyPair 'Witness)
  GenR :: Rep era x -> Rep era (Gen x)
  ScriptR :: Era era => Proof era -> Rep era (ScriptF era)
  ScriptHashR :: Era era => Rep era ScriptHash
  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
  PCredR :: Era era => Rep era (Credential 'Payment)
  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
  SigningKeyR :: Rep era SigningKey
  TxWitsR :: Era era => Proof era -> Rep era (TxWitsF era)
  PayHashR :: Era era => Rep era (KeyHash 'Payment)
  TxR :: Era era => Proof era -> Rep era (TxF era)
  ScriptIntegrityHashR :: Era era => Rep era (SafeHash EraIndependentScriptIntegrity)
  TxAuxDataHashR :: Era era => Rep era TxAuxDataHash
  GovActionR :: Era era => Rep era (GovAction era)
  WitVKeyR :: Era era => Proof era -> Rep era (WitVKey 'Witness)
  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)
  BoolR :: Rep era Bool
  DRepR :: Era era => Rep era DRep
  PoolMetadataR :: Era era => Proof era -> Rep era PoolMetadata
  DRepStateR :: Era era => Rep era DRepState
  DStateR :: Era era => Rep era (DState era)
  GovActionIdR :: Era era => Rep era GovActionId
  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)
  AnchorR :: Era era => Rep era Anchor
  CommitteeStateR :: Era era => Rep era (CommitteeState era)
  CommitteeAuthorizationR :: Era era => Rep era CommitteeAuthorization
  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
  VoteR :: Rep era Vote

stringR :: Rep era String
stringR :: forall era. Rep era String
stringR = Rep era Char -> Rep era String
forall era a. Rep era a -> Rep era [a]
ListR Rep era Char
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 $mIsOrd :: forall {r} {a}.
HasInstances a -> ((Typeable a, Ord a) => r) -> ((# #) -> r) -> r
$bIsOrd :: forall a. (Typeable a, Ord a) => HasInstances a
IsOrd = Type Is Is

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

{-# COMPLETE IsTypeable #-}

pattern IsTypeable :: () => Typeable a => HasInstances a
pattern $mIsTypeable :: forall {r} {a}.
HasInstances a -> (Typeable a => r) -> ((# #) -> r) -> r
$bIsTypeable :: forall a. Typeable a => HasInstances a
IsTypeable <- Type _ _
  where
    IsTypeable = Is Eq a -> Is Ord a -> HasInstances a
forall a. Typeable a => Is Eq a -> Is Ord a -> HasInstances a
Type Is Eq a
forall (c :: * -> Constraint) a. Is c a
Isn't Is Ord a
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@(Rep era t -> HasInstances t
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances t
IsTypeable) = Rep era t -> TypeRep
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 -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  Rep era t
VStateR -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  Rep era t
EnactStateR -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  Rep era t
RatifyStateR -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  Rep era t
DRepStateR -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  Rep era t
CommColdCredR -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  Rep era t
CommHotCredR -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  Rep era t
GovActionR -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  PoolMetadataR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  StakeHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  BoolR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  DRepR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  WitVKeyR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  TxAuxDataR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  LanguageR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  LedgerStateR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  TxR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ScriptIntegrityHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  TxAuxDataHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  BootstrapWitnessR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  SigningKeyR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  TxWitsR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PayHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  IntegerR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  ScriptsNeededR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  ScriptPurposeR {} -> HasInstances t
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 {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ShelleyTxCertR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ConwayTxCertR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  MIRPotR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  IsValidR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ExUnitsR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  DataHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PCredR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  NetworkR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  RdmrPtrR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  DataR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  DatumR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  KeyPairR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  ScriptR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ScriptHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  TxCertR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  RewardAccountR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  ValidityIntervalR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  AssetNameR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  WitnessesFieldR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  MultiAssetR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PolicyIDR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  CharR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  RationalR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  CoinR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  EpochR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  EpochIntervalR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  AddrR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  CredR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  VCredR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PoolHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  WitHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  GenHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  GenDelegHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  VHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PoolParamsR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  NewEpochStateR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  IntR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  FloatR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  NaturalR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  Word64R {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  TxInR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  UnitR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  ProtVerR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  ValueR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  UTxOR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  TxOutR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PParamsR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  FuturePParamsR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  PParamsUpdateR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  CertStateR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  DeltaCoinR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  GenDelegPairR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  FutureGenDelegR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  PPUPStateR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  PtrR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  IPoolStakeR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  SnapShotsR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  RewardR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  SlotNoR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  SizeR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  DStateR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  GovActionIdR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  GovActionIxR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  GovActionStateR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  ProposalsR {} -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  CommitteeAuthorizationR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  CommitteeStateR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  UnitIntervalR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  CommitteeR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  ConstitutionR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PrevGovActionIdsR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PrevPParamUpdateR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PrevHardForkR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PrevCommitteeR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  PrevConstitutionR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  (Rep era a -> HasInstances a
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances a
IsTypeable) :-> (Rep era b -> HasInstances b
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances b
IsTypeable) -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  MapR (Rep era a -> HasInstances a
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances a
IsTypeable) (Rep era b -> HasInstances b
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances b
ib) -> HasInstances b -> HasInstances (Map a b)
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 (Rep era a -> HasInstances a
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances a
IsTypeable) -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  ListR (Rep era a -> HasInstances a
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances a
ia) -> HasInstances a -> HasInstances [a]
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 (Rep era a -> HasInstances a
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances a
ia) (Rep era b -> HasInstances b
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances b
ib) -> HasInstances a -> HasInstances b -> HasInstances (a, b)
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 (Rep era t -> HasInstances t
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances t
ia) -> HasInstances t -> HasInstances (Maybe t)
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 (Rep era x -> HasInstances x
forall era t. Rep era t -> HasInstances t
repHasInstances -> HasInstances x
IsTypeable) -> HasInstances t
forall a. Typeable a => HasInstances a
IsTypeable
  NumDormantEpochsR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  DRepHashR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  AnchorR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  DRepPulserR {} -> HasInstances t
forall a. (Typeable a, Eq a) => HasInstances a
IsEq
  DelegateeR {} -> HasInstances t
forall a. (Typeable a, Ord a) => HasInstances a
IsOrd
  VoteR {} -> HasInstances t
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 = Is c (f a b)
forall (c :: * -> Constraint) a. c a => Is c a
Is
lubIs Is c a
_ Is c b
_ = Is c (f a 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) =
  Is Eq (f a b) -> Is Ord (f a b) -> HasInstances (f a b)
forall a. Typeable a => Is Eq a -> Is Ord a -> HasInstances a
Type (Is Eq a -> Is Eq b -> Is Eq (f a 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 Eq a
eq_a Is Eq b
eq_b) (Is Ord a -> Is Ord b -> Is Ord (f a 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 = Is c (f a)
forall (c :: * -> Constraint) a. c a => Is c a
Is
requireIs Is c a
_ = Is c (f 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) = Is Eq (f a) -> Is Ord (f a) -> HasInstances (f a)
forall a. Typeable a => Is Eq a -> Is Ord a -> HasInstances a
Type (Is Eq a -> Is Eq (f a)
forall (c :: * -> Constraint) a (f :: * -> *).
(c a => c (f a), () :: Constraint) =>
Is c a -> Is c (f a)
requireIs Is Eq a
eq) (Is Ord a -> Is Ord (f a)
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
    (Rep era i -> HasInstances i
forall era t. Rep era t -> HasInstances t
repHasInstances -> (HasInstances i
IsTypeable :: HasInstances a))
    (Rep era j -> HasInstances j
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)
forall a b. (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 = TypeRep -> TypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Rep era a -> TypeRep
forall era t. Rep era t -> TypeRep
typeRepOf Rep era a
x) (Rep era b -> TypeRep
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 (Rep era t -> HasInstances t
forall era t. Rep era t -> HasInstances t
repHasInstances -> (HasInstances t
IsTypeable :: HasInstances t)) = Int -> TypeRep -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (TypeRep -> ShowS) -> TypeRep -> ShowS
forall a b. (a -> b) -> a -> b
$ Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
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 = t -> String
forall a. Show a => a -> String
show t
r
synopsis Rep e t
RationalR t
r = t -> String
forall a. Show a => a -> String
show t
r
synopsis Rep e t
CoinR t
c = PDoc -> String
forall a. Show a => a -> String
show (Coin -> PDoc
pcCoin t
Coin
c)
synopsis Rep e t
EpochR t
e = t -> String
forall a. Show a => a -> String
show t
e
synopsis Rep e t
EpochIntervalR t
e = t -> String
forall a. Show a => a -> String
show t
e
synopsis (Rep e a
a :-> Rep e b
b) t
_ = String
"(Arrow " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e a -> String
forall a. Show a => a -> String
show Rep e a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e b -> String
forall a. Show a => a -> String
show Rep e b
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
Word64R t
w = t -> String
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 Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList t
Map a b
mp of
  [] -> String
"(empty::Map " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e a -> String
forall a. Show a => a -> String
show Rep e a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e b -> String
forall a. Show a => a -> String
show Rep e b
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  ((a
d, b
r) : [(a, b)]
_) ->
    String
"Map{"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e a -> a -> String
forall e t. Rep e t -> t -> String
synopsis Rep e a
a a
d
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e b -> b -> String
forall e t. Rep e t -> t -> String
synopsis Rep e b
b b
r
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" | size = "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Map a b -> Int
forall k a. Map k a -> Int
Map.size t
Map a b
mp)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e t -> t -> String
forall e t. Rep e t -> t -> String
synSum Rep e t
rep t
mp
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
synopsis (SetR Rep e a
IntR) t
x = String
"Set" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (Set Int -> [Int]
forall a. Set a -> [a]
Set.toList t
Set Int
x)
synopsis (SetR Rep e a
Word64R) t
x = String
"Set" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Word64] -> String
forall a. Show a => a -> String
show (Set Word64 -> [Word64]
forall a. Set a -> [a]
Set.toList t
Set Word64
x)
synopsis rep :: Rep e t
rep@(SetR Rep e a
a) t
t = case Set a -> [a]
forall a. Set a -> [a]
Set.elems t
Set a
t of
  [] -> String
"(empty::Set " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e a -> String
forall a. Show a => a -> String
show Rep e a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  (a
h : [a]
_) -> String
"Set{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e a -> a -> String
forall e t. Rep e t -> t -> String
synopsis Rep e a
a a
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" | size = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Set a -> Int
forall a. Set a -> Int
Set.size t
Set a
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e t -> t -> String
forall e t. Rep e t -> t -> String
synSum Rep e t
rep t
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
synopsis (ListR Rep e a
IntR) t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis (ListR Rep e a
Word64R) t
x = t -> String
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::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e [a] -> String
forall a. Show a => a -> String
show (Rep e a -> Rep e [a]
forall era a. Rep era a -> Rep era [a]
ListR Rep e a
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
  (a
d : [a]
_) -> String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e a -> a -> String
forall e t. Rep e t -> t -> String
synopsis Rep e a
a a
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" | size = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t
[a]
ll) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e t -> t -> String
forall e t. Rep e t -> t -> String
synSum Rep e t
rep t
ll String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
synopsis Rep e t
AddrR t
a = t -> String
forall a. Show a => a -> String
show t
a
synopsis Rep e t
CredR t
c = PDoc -> String
forall a. Show a => a -> String
show (Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
credSummary t
Credential 'Staking
c)
synopsis Rep e t
PoolHashR t
k = String
"(KeyHash 'PoolStake " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (KeyHash 'StakePool -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
keyHashSummary t
KeyHash 'StakePool
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
GenHashR t
k = String
"(KeyHash 'Genesis " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (KeyHash 'Genesis -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
keyHashSummary t
KeyHash 'Genesis
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
WitHashR t
k = String
"(KeyHash 'Witness " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (KeyHash 'Witness -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
keyHashSummary t
KeyHash 'Witness
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
GenDelegHashR t
k = String
"(KeyHash 'GenesisDelegate " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (KeyHash 'GenesisDelegate -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
keyHashSummary t
KeyHash 'GenesisDelegate
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
PoolParamsR t
pp = String
"(PoolParams " String -> ShowS
forall a. [a] -> [a] -> [a]
++ forall e t. Rep e t -> t -> String
synopsis @e Rep e (KeyHash 'StakePool)
forall era. Era era => Rep era (KeyHash 'StakePool)
PoolHashR (PoolParams -> KeyHash 'StakePool
ppId t
PoolParams
pp) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
IntR t
n = t -> String
forall a. Show a => a -> String
show t
n
synopsis Rep e t
NaturalR t
n = t -> String
forall a. Show a => a -> String
show t
n
synopsis Rep e t
FloatR t
n = t -> String
forall a. Show a => a -> String
show t
n
synopsis Rep e t
TxInR t
txin = PDoc -> String
forall a. Show a => a -> String
show (TxIn -> PDoc
pcTxIn t
TxIn
txin)
synopsis Rep e t
CharR t
s = t -> String
forall a. Show a => a -> String
show t
s
synopsis (ValueR Proof e
p) (ValueF Proof e
_ Value e
x) = PDoc -> String
forall a. Show a => a -> String
show (Proof e -> Value e -> PDoc
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) = PDoc -> String
forall a. Show a => a -> String
show (((Reflect e => Proof e -> TxOut e -> PDoc)
-> Proof e -> TxOut e -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect e => Proof e -> TxOut e -> PDoc
Proof e -> TxOut e -> PDoc
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 (TxOut e)
mp) = String
"UTxO( " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e (Map TxIn (TxOutF e)) -> Map TxIn (TxOutF e) -> String
forall e t. Rep e t -> t -> String
synopsis (Rep e TxIn -> Rep e (TxOutF e) -> Rep e (Map TxIn (TxOutF e))
forall a era b.
Ord a =>
Rep era a -> Rep era b -> Rep era (Map a b)
MapR Rep e TxIn
forall era. Era era => Rep era TxIn
TxInR (Proof e -> Rep e (TxOutF e)
forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR Proof e
p)) ((TxOut e -> TxOutF e) -> Map TxIn (TxOut e) -> Map TxIn (TxOutF e)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Proof e -> TxOut e -> TxOutF e
forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof e
p) Map TxIn (TxOut e)
mp) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" )"
synopsis (PParamsR Proof e
_) (PParamsF Proof e
p PParams e
x) = PDoc -> String
forall a. Show a => a -> String
show (PDoc -> String) -> PDoc -> String
forall a b. (a -> b) -> a -> b
$ Proof e -> PParams e -> PDoc
forall era. Proof era -> PParams era -> PDoc
pcPParams Proof e
p PParams e
x
synopsis (FuturePParamsR Proof e
p) t
x = PDoc -> String
forall a. Show a => a -> String
show (PDoc -> String) -> PDoc -> String
forall a b. (a -> b) -> a -> b
$ Proof e -> FuturePParams e -> PDoc
forall era. Proof era -> FuturePParams era -> PDoc
pcFuturePParams Proof e
p t
FuturePParams e
x
synopsis (PParamsUpdateR Proof e
_) t
_ = String
"PParamsUpdate ..."
synopsis Rep e t
CertStateR (CertStateF Proof e
_ CertState e
x) = PDoc -> String
forall a. Show a => a -> String
show (PDoc -> String) -> PDoc -> String
forall a b. (a -> b) -> a -> b
$ CertState e -> PDoc
forall era. Reflect era => CertState era -> PDoc
pcCertState CertState e
x
synopsis Rep e t
DeltaCoinR (DeltaCoin Integer
n) = Doc Any -> String
forall a. Show a => a -> String
show ([Doc Any] -> Doc Any
forall ann. [Doc ann] -> Doc ann
hsep [String -> Doc Any
forall a. String -> Doc a
ppString String
"▵₳", Integer -> Doc Any
forall a. Integer -> Doc a
ppInteger Integer
n])
synopsis Rep e t
GenDelegPairR t
x = PDoc -> String
forall a. Show a => a -> String
show (GenDelegPair -> PDoc
pcGenDelegPair t
GenDelegPair
x)
synopsis Rep e t
FutureGenDelegR t
x = PDoc -> String
forall a. Show a => a -> String
show (FutureGenDeleg -> PDoc
pcFutureGenDeleg t
FutureGenDeleg
x)
synopsis (PPUPStateR Proof e
_) t
_ = String
"PPUPStateR ..."
synopsis Rep e t
PtrR t
p = t -> String
forall a. Show a => a -> String
show t
p
synopsis Rep e t
IPoolStakeR t
p = PDoc -> String
forall a. Show a => a -> String
show (IndividualPoolStake -> PDoc
pcIndividualPoolStake t
IndividualPoolStake
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
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e a -> a -> String
forall e t. Rep e t -> t -> String
synopsis Rep e a
a a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e b -> b -> String
forall e t. Rep e t -> t -> String
synopsis Rep e b
b b
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
RewardR t
x = PDoc -> String
forall a. Show a => a -> String
show (Reward -> PDoc
pcReward t
Reward
x)
synopsis (MaybeR Rep e t
_) t
Maybe t
Nothing = String
"Nothing"
synopsis (MaybeR Rep e t
x) (Just t
y) = String
"(Just " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e t -> t -> String
forall e t. Rep e t -> t -> String
synopsis Rep e t
x t
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
NewEpochStateR t
_ = String
"NewEpochStateR ..."
synopsis (ProtVerR Proof e
_) (ProtVer Version
x Natural
y) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Show a => a -> String
show Version
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Natural -> String
forall a. Show a => a -> String
show Natural
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
SlotNoR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
SizeR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
VCredR t
x = PDoc -> String
forall a. Show a => a -> String
show (Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
credSummary t
Credential 'DRepRole
x)
synopsis Rep e t
VHashR t
x = String
"(KeyHash 'Voting " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (KeyHash 'DRepRole -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
keyHashSummary t
KeyHash 'DRepRole
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
MultiAssetR t
x = String
"(MultiAsset " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (MultiAsset -> PDoc
pcMultiAsset t
MultiAsset
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
PolicyIDR (PolicyID ScriptHash
x) = PDoc -> String
forall a. Show a => a -> String
show (ScriptHash -> PDoc
pcScriptHash ScriptHash
x)
synopsis (WitnessesFieldR Proof e
p) t
x = PDoc -> String
forall a. Show a => a -> String
show (PDoc -> String) -> PDoc -> String
forall a b. (a -> b) -> a -> b
$ PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' PDoc
forall a. Monoid a => a
mempty ([(Text, PDoc)] -> PDoc) -> [(Text, PDoc)] -> PDoc
forall a b. (a -> b) -> a -> b
$ (Reflect e => Proof e -> t -> [(Text, PDoc)])
-> Proof e -> t -> [(Text, PDoc)]
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect e => Proof e -> t -> [(Text, PDoc)]
Proof e -> t -> [(Text, PDoc)]
Proof e -> WitnessesField e -> [(Text, PDoc)]
forall era.
Reflect era =>
Proof era -> WitnessesField era -> [(Text, PDoc)]
pcWitnessesField Proof e
p t
x
synopsis Rep e t
AssetNameR (AssetName ShortByteString
x) = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
10 (ShortByteString -> String
forall a. Show a => a -> String
show ShortByteString
x)
synopsis (TxCertR Proof e
p) (TxCertF Proof e
_ TxCert e
x) = PDoc -> String
forall a. Show a => a -> String
show (Proof e -> TxCert e -> PDoc
forall era. Proof era -> TxCert era -> PDoc
pcTxCert Proof e
p TxCert e
x)
synopsis Rep e t
RewardAccountR t
x = PDoc -> String
forall a. Show a => a -> String
show (RewardAccount -> PDoc
pcRewardAccount t
RewardAccount
x)
synopsis Rep e t
ValidityIntervalR t
x = PDoc -> String
forall a. Show a => a -> String
show (ValidityInterval -> PDoc
ppValidityInterval t
ValidityInterval
x)
synopsis Rep e t
KeyPairR t
_ = String
"(KeyPairR ...)"
synopsis (GenR Rep e x
x) t
_ = String
"(Gen " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep e x -> String
forall a. Show a => a -> String
show Rep e x
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ...)"
synopsis (ScriptR Proof e
_) t
x = t -> String
forall a. Show a => a -> String
show t
x -- The Show instance uses pcScript
synopsis Rep e t
ScriptHashR t
x = PDoc -> String
forall a. Show a => a -> String
show (ScriptHash -> PDoc
pcScriptHash t
ScriptHash
x)
synopsis Rep e t
NetworkR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis (RdmrPtrR Proof e
_) t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
DataR t
x = PDoc -> String
forall a. Show a => a -> String
show (Data e -> PDoc
forall era. Era era => Data era -> PDoc
pcData t
Data e
x)
synopsis Rep e t
DatumR t
x = PDoc -> String
forall a. Show a => a -> String
show (Datum e -> PDoc
forall era. Era era => Datum era -> PDoc
pcDatum t
Datum e
x)
synopsis Rep e t
ExUnitsR (ExUnits Natural
m Natural
d) = String
"(ExUnits mem=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Natural -> String
forall a. Show a => a -> String
show Natural
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" data=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Natural -> String
forall a. Show a => a -> String
show Natural
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
DataHashR t
x = PDoc -> String
forall a. Show a => a -> String
show (SafeHash EraIndependentData -> PDoc
pcDataHash t
SafeHash EraIndependentData
x)
synopsis Rep e t
PCredR t
c = PDoc -> String
forall a. Show a => a -> String
show (Credential 'Payment -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
credSummary t
Credential 'Payment
c)
synopsis Rep e t
ConwayTxCertR t
x = PDoc -> String
forall a. Show a => a -> String
show (ConwayTxCert e -> PDoc
forall c. ConwayTxCert c -> PDoc
pcConwayTxCert t
ConwayTxCert e
x)
synopsis Rep e t
ShelleyTxCertR t
x = PDoc -> String
forall a. Show a => a -> String
show (ShelleyTxCert e -> PDoc
forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert t
ShelleyTxCert e
x)
synopsis Rep e t
MIRPotR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
IsValidR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
IntegerR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis (ScriptsNeededR Proof e
_) t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis (ScriptPurposeR Proof e
_) t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis (TxBodyR Proof e
p) t
x = PDoc -> String
forall a. Show a => a -> String
show (Proof e -> TxBody e -> PDoc
forall era. Proof era -> TxBody era -> PDoc
pcTxBody Proof e
p (TxBodyF e -> TxBody e
forall era. TxBodyF era -> TxBody era
unTxBodyF t
TxBodyF e
x))
synopsis Rep e t
BootstrapWitnessR t
x = String
"(BootstrapWitness " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (VKey 'Witness -> PDoc
forall (r :: KeyRole). VKey r -> PDoc
ppVKey (BootstrapWitness -> VKey 'Witness
bwKey t
BootstrapWitness
x)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
SigningKeyR t
key = String
"(publicKeyOfSecretKey " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Format String (VerificationKey -> String)
-> VerificationKey -> String
forall a. Format String a -> a
formatToString Format String (VerificationKey -> String)
forall r. Format r (VerificationKey -> r)
shortVerificationKeyHexF (SigningKey -> VerificationKey
toVerification t
SigningKey
key) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis (TxWitsR Proof e
p) (TxWitsF Proof e
_ TxWits e
x) = PDoc -> String
forall a. Show a => a -> String
show (((Reflect e => Proof e -> TxWits e -> PDoc)
-> Proof e -> TxWits e -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect e => Proof e -> TxWits e -> PDoc
Proof e -> TxWits e -> PDoc
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (KeyHash 'Payment -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
keyHashSummary t
KeyHash 'Payment
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis (TxR Proof e
p) t
x = PDoc -> String
forall a. Show a => a -> String
show (Proof e -> Tx e -> PDoc
forall era. Proof era -> Tx era -> PDoc
pcTx Proof e
p (TxF e -> Tx e
forall era. TxF era -> Tx era
unTxF t
TxF e
x))
synopsis Rep e t
ScriptIntegrityHashR t
x = PDoc -> String
forall a. Show a => a -> String
show (PDoc -> PDoc
trim (Hash HASH EraIndependentScriptIntegrity -> PDoc
forall a b. Hash a b -> PDoc
ppHash (SafeHash EraIndependentScriptIntegrity
-> Hash HASH EraIndependentScriptIntegrity
forall i. SafeHash i -> Hash HASH i
extractHash t
SafeHash EraIndependentScriptIntegrity
x)))
synopsis Rep e t
TxAuxDataHashR (TxAuxDataHash SafeHash EraIndependentTxAuxData
x) = PDoc -> String
forall a. Show a => a -> String
show (PDoc -> PDoc
trim (Hash HASH EraIndependentTxAuxData -> PDoc
forall a b. Hash a b -> PDoc
ppHash (SafeHash EraIndependentTxAuxData
-> Hash HASH EraIndependentTxAuxData
forall i. SafeHash i -> Hash HASH i
extractHash SafeHash EraIndependentTxAuxData
x)))
synopsis Rep e t
GovActionR t
x = PDoc -> String
forall a. Show a => a -> String
show (GovAction e -> PDoc
forall era. GovAction era -> PDoc
pcGovAction t
GovAction e
x)
synopsis (WitVKeyR Proof e
p) t
x = PDoc -> String
forall a. Show a => a -> String
show (((Reflect e => Proof e -> t -> PDoc) -> Proof e -> t -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect e => Proof e -> t -> PDoc
Proof e -> t -> PDoc
Proof e -> WitVKey 'Witness -> PDoc
forall era (keyrole :: KeyRole).
Proof era -> WitVKey keyrole -> PDoc
pcWitVKey Proof e
p t
x) :: PDoc)
synopsis (TxAuxDataR Proof e
_) t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
CommColdCredR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
CommHotCredR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
LanguageR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis (LedgerStateR Proof e
p) t
x = PDoc -> String
forall a. Show a => a -> String
show (((Reflect e => Proof e -> t -> PDoc) -> Proof e -> t -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect e => Proof e -> t -> PDoc
Proof e -> t -> PDoc
Proof e -> LedgerState e -> PDoc
forall era. Reflect era => Proof era -> LedgerState era -> PDoc
pcLedgerState Proof e
p t
x) :: PDoc)
synopsis Rep e t
StakeHashR t
k = String
"(KeyHash 'Staking " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (KeyHash 'Staking -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
keyHashSummary t
KeyHash 'Staking
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
BoolR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
DRepR t
x = PDoc -> String
forall a. Show a => a -> String
show (DRep -> PDoc
pcDRep t
DRep
x)
synopsis (PoolMetadataR Proof e
_) t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
DRepStateR t
x = PDoc -> String
forall a. Show a => a -> String
show (DRepState -> PDoc
pcDRepState t
DRepState
x)
synopsis Rep e t
DStateR t
x = PDoc -> String
forall a. Show a => a -> String
show (DState e -> PDoc
forall c. DState c -> PDoc
pcDState t
DState e
x)
synopsis Rep e t
GovActionIdR t
x = PDoc -> String
forall a. Show a => a -> String
show (GovActionId -> PDoc
pcGovActionId t
GovActionId
x)
synopsis Rep e t
GovActionIxR (GovActionIx Word16
a) = Doc Any -> String
forall a. Show a => a -> String
show (Word16 -> Doc Any
forall a. Word16 -> Doc a
ppWord16 Word16
a)
synopsis Rep e t
GovActionStateR t
x = PDoc -> String
forall a. Show a => a -> String
show (GovActionState e -> PDoc
forall era. GovActionState era -> PDoc
pcGovActionState t
GovActionState e
x)
synopsis (ProposalsR Proof e
_p) t
x = PDoc -> String
forall a. Show a => a -> String
show (Proposals e -> PDoc
forall era. Proposals era -> PDoc
pcProposals t
Proposals e
x)
synopsis Rep e t
UnitIntervalR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
CommitteeR t
x = PDoc -> String
forall a. Show a => a -> String
show (Committee e -> PDoc
forall era. Committee era -> PDoc
pcCommittee t
Committee e
x)
synopsis Rep e t
ConstitutionR t
x = PDoc -> String
forall a. Show a => a -> String
show (PDoc -> String) -> PDoc -> String
forall a b. (a -> b) -> a -> b
$ Constitution e -> PDoc
forall c. Constitution c -> PDoc
pcConstitution t
Constitution e
x
synopsis Rep e t
PrevGovActionIdsR t
x = PDoc -> String
forall a. Show a => a -> String
show (GovRelation StrictMaybe e -> PDoc
forall era. GovRelation StrictMaybe era -> PDoc
pcPrevGovActionIds t
GovRelation StrictMaybe e
x)
synopsis Rep e t
PrevPParamUpdateR (GovPurposeId GovActionId
x) = forall e t. Rep e t -> t -> String
synopsis @e Rep e GovActionId
forall era. Era era => Rep era GovActionId
GovActionIdR GovActionId
x
synopsis Rep e t
PrevHardForkR (GovPurposeId GovActionId
x) = forall e t. Rep e t -> t -> String
synopsis @e Rep e GovActionId
forall era. Era era => Rep era GovActionId
GovActionIdR GovActionId
x
synopsis Rep e t
PrevCommitteeR (GovPurposeId GovActionId
x) = forall e t. Rep e t -> t -> String
synopsis @e Rep e GovActionId
forall era. Era era => Rep era GovActionId
GovActionIdR GovActionId
x
synopsis Rep e t
PrevConstitutionR (GovPurposeId GovActionId
x) = forall e t. Rep e t -> t -> String
synopsis @e Rep e GovActionId
forall era. Era era => Rep era GovActionId
GovActionIdR GovActionId
x
synopsis Rep e t
RatifyStateR t
dr = PDoc -> String
forall a. Show a => a -> String
show (Proof e -> RatifyState e -> PDoc
forall era. Proof era -> RatifyState era -> PDoc
pcRatifyState Proof e
forall era. Reflect era => Proof era
reify t
RatifyState e
dr)
synopsis Rep e t
NumDormantEpochsR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
CommitteeAuthorizationR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
CommitteeStateR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
VStateR t
x = t -> String
forall a. Show a => a -> String
show t
x
synopsis Rep e t
DRepHashR t
k = String
"(KeyHash 'DRepRole " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (KeyHash 'DRepRole -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
keyHashSummary t
KeyHash 'DRepRole
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
synopsis Rep e t
AnchorR t
k = PDoc -> String
forall a. Show a => a -> String
show (Anchor -> PDoc
pcAnchor t
Anchor
k)
synopsis Rep e t
EnactStateR t
x = PDoc -> String
forall a. Show a => a -> String
show (Proof e -> EnactState e -> PDoc
forall era. Proof era -> EnactState era -> PDoc
pcEnactState Proof e
forall era. Reflect era => Proof era
reify t
EnactState e
x)
synopsis Rep e t
DRepPulserR t
x = PDoc -> String
forall a. Show a => a -> String
show (DRepPulser e Identity (RatifyState e) -> PDoc
forall era. DRepPulser era Identity (RatifyState era) -> PDoc
pcDRepPulser t
DRepPulser e Identity (RatifyState e)
x)
synopsis Rep e t
DelegateeR t
x = PDoc -> String
forall a. Show a => a -> String
show (Delegatee -> PDoc
pcDelegatee t
Delegatee
x)
synopsis Rep e t
VoteR t
v = t -> String
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 = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (Coin -> PDoc
pcCoin ((Coin -> Coin -> Coin) -> Coin -> Map a Coin -> Coin
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>) Coin
forall a. Monoid a => a
mempty a
Map a Coin
m))
synSum (MapR Rep era a
_ Rep era b
RationalR) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ratio Integer -> String
forall a. Show a => a -> String
show ((Ratio Integer -> Ratio Integer -> Ratio Integer)
-> Ratio Integer -> Map a (Ratio Integer) -> Ratio Integer
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
(+) Ratio Integer
0 a
Map a (Ratio Integer)
m)
synSum (MapR Rep era a
_ Rep era b
IntR) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ((Int -> Int -> Int) -> Int -> Map a Int -> Int
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 a
Map a Int
m)
synSum (MapR Rep era a
_ Rep era b
Word64R) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show ((Word64 -> Word64 -> Word64) -> Word64 -> Map a Word64 -> Word64
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+) Word64
0 a
Map a Word64
m)
synSum (MapR Rep era a
_ Rep era b
IPoolStakeR) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ratio Integer -> String
forall a. Show a => a -> String
show ((Ratio Integer -> IndividualPoolStake -> Ratio Integer)
-> Ratio Integer -> Map a IndividualPoolStake -> Ratio Integer
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Ratio Integer -> IndividualPoolStake -> Ratio Integer
accum Ratio Integer
0 a
Map a IndividualPoolStake
m)
  where
    accum :: Ratio Integer -> IndividualPoolStake -> Ratio Integer
accum Ratio Integer
z (IndividualPoolStake Ratio Integer
rat CompactForm Coin
_ VRFVerKeyHash 'StakePoolVRF
_) = Ratio Integer
z Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
+ Ratio Integer
rat
synSum (MapR Rep era a
_ (TxOutR Proof era
proof)) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show ((Coin -> TxOutF era -> Coin) -> Coin -> Map a (TxOutF era) -> Coin
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' (Proof era -> Coin -> TxOutF era -> Coin
forall era. Proof era -> Coin -> TxOutF era -> Coin
accumTxOut Proof era
proof) (Integer -> Coin
Coin Integer
0) a
Map a (TxOutF era)
m)
synSum (MapR Rep era a
_ Rep era b
ExUnitsR) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExUnits -> String
forall a. Show a => a -> String
show ((ExUnits -> ExUnits -> ExUnits)
-> ExUnits -> Map a ExUnits -> ExUnits
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' ExUnits -> ExUnits -> ExUnits
forall x. Adds x => x -> x -> x
add ExUnits
forall x. Adds x => x
zero a
Map a ExUnits
m)
synSum (SetR Rep era a
CoinR) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (Coin -> PDoc
pcCoin ((Coin -> Coin -> Coin) -> Coin -> Set Coin -> Coin
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>) Coin
forall a. Monoid a => a
mempty a
Set Coin
m))
synSum (SetR Rep era a
RationalR) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ratio Integer -> String
forall a. Show a => a -> String
show ((Ratio Integer -> Ratio Integer -> Ratio Integer)
-> Ratio Integer -> Set (Ratio Integer) -> Ratio Integer
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
(+) Ratio Integer
0 a
Set (Ratio Integer)
m)
synSum (ListR Rep era a
CoinR) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show ((Coin -> Coin -> Coin) -> Coin -> [Coin] -> Coin
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>) Coin
forall a. Monoid a => a
mempty a
[Coin]
m)
synSum (ListR Rep era a
RationalR) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ratio Integer -> String
forall a. Show a => a -> String
show ((Ratio Integer -> Ratio Integer -> Ratio Integer)
-> Ratio Integer -> [Ratio Integer] -> Ratio Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
(+) Ratio Integer
0 a
[Ratio Integer]
m)
synSum (ListR Rep era a
IntR) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ((Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 a
[Int]
m)
synSum (ListR Rep era a
Word64R) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show ((Word64 -> Word64 -> Word64) -> Word64 -> [Word64] -> Word64
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+) Word64
0 a
[Word64]
m)
synSum (ListR (TxOutR Proof era
proof)) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show ((Coin -> TxOutF era -> Coin) -> Coin -> [TxOutF era] -> Coin
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Proof era -> Coin -> TxOutF era -> Coin
forall era. Proof era -> Coin -> TxOutF era -> Coin
accumTxOut Proof era
proof) (Integer -> Coin
Coin Integer
0) a
[TxOutF era]
m)
synSum (ListR Rep era a
ExUnitsR) a
m = String
", sum = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExUnits -> String
forall a. Show a => a -> String
show ((ExUnits -> ExUnits -> ExUnits) -> ExUnits -> [ExUnits] -> ExUnits
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ExUnits -> ExUnits -> ExUnits
forall x. Adds x => x -> x -> x
add ExUnits
forall x. Adds x => x
zero a
[ExUnits]
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 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (TxOut era
ShelleyTxOut ShelleyEra
out ShelleyTxOut ShelleyEra
-> Getting Coin (ShelleyTxOut ShelleyEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Coin Coin)
-> TxOut ShelleyEra -> Const Coin (TxOut ShelleyEra)
Getting Coin (ShelleyTxOut ShelleyEra) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut ShelleyEra) Coin
Core.coinTxOutL)
accumTxOut Proof era
Allegra Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (TxOut era
ShelleyTxOut AllegraEra
out ShelleyTxOut AllegraEra
-> Getting Coin (ShelleyTxOut AllegraEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Coin Coin)
-> TxOut AllegraEra -> Const Coin (TxOut AllegraEra)
Getting Coin (ShelleyTxOut AllegraEra) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut AllegraEra) Coin
Core.coinTxOutL)
accumTxOut Proof era
Mary Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (TxOut era
ShelleyTxOut MaryEra
out ShelleyTxOut MaryEra
-> Getting Coin (ShelleyTxOut MaryEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Coin Coin)
-> TxOut MaryEra -> Const Coin (TxOut MaryEra)
Getting Coin (ShelleyTxOut MaryEra) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut MaryEra) Coin
Core.coinTxOutL)
accumTxOut Proof era
Alonzo Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (TxOut era
AlonzoTxOut AlonzoEra
out AlonzoTxOut AlonzoEra
-> Getting Coin (AlonzoTxOut AlonzoEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Coin Coin)
-> TxOut AlonzoEra -> Const Coin (TxOut AlonzoEra)
Getting Coin (AlonzoTxOut AlonzoEra) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut AlonzoEra) Coin
Core.coinTxOutL)
accumTxOut Proof era
Babbage Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (TxOut era
BabbageTxOut BabbageEra
out BabbageTxOut BabbageEra
-> Getting Coin (BabbageTxOut BabbageEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Coin Coin)
-> TxOut BabbageEra -> Const Coin (TxOut BabbageEra)
Getting Coin (BabbageTxOut BabbageEra) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut BabbageEra) Coin
Core.coinTxOutL)
accumTxOut Proof era
Conway Coin
z (TxOutF Proof era
_ TxOut era
out) = Coin
z Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (TxOut era
BabbageTxOut ConwayEra
out BabbageTxOut ConwayEra
-> Getting Coin (BabbageTxOut ConwayEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Coin Coin)
-> TxOut ConwayEra -> Const Coin (TxOut ConwayEra)
Getting Coin (BabbageTxOut ConwayEra) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut ConwayEra) 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 = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
CoinR =
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then do Positive Integer
m <- Gen (Positive Integer)
forall a. Arbitrary a => Gen a
arbitrary; t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Coin
Coin Integer
m)
    else t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Coin
Coin (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
genSizedRep Int
n (Rep era a
_a :-> Rep era b
b) = b -> t
b -> a -> b
forall a b. a -> b -> a
const (b -> t) -> Gen b -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Rep era b -> Gen 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
  [String] -> Int -> Gen a -> Gen b -> Gen (Map a b)
forall a b.
Ord a =>
[String] -> Int -> Gen a -> Gen b -> Gen (Map a b)
mapSized [String
"From genSizedRep " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep era t -> String
forall a. Show a => a -> String
show Rep era t
r] Int
n (Rep era a -> Gen a
forall era b. Rep era b -> Gen b
genRep Rep era a
a) (Rep era b -> Gen b
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
  [String] -> Int -> Gen a -> Gen (Set a)
forall a. Ord a => [String] -> Int -> Gen a -> Gen (Set a)
setSized [String
"From genSizedRep " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep era t -> String
forall a. Show a => a -> String
show Rep era t
r] Int
n (Rep era a -> Gen a
forall era b. Rep era b -> Gen b
genRep Rep era a
a)
genSizedRep Int
n (ListR Rep era a
a) = Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (Int -> Rep era a -> Gen a
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era a
a)
genSizedRep Int
_ Rep era t
AddrR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
CredR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PoolHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
WitHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
GenHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
GenDelegHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PoolParamsR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
EpochR = t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Gen t) -> t -> Gen t
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Word64 -> EpochNo
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
genSizedRep Int
n Rep era t
EpochIntervalR = t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Gen t) -> t -> Gen t
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval (Word32 -> EpochInterval) -> Word32 -> EpochInterval
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
genSizedRep Int
_ Rep era t
RationalR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
Word64R = (t, t) -> Gen t
forall a. Random a => (a, a) -> Gen a
choose (t
0, t
1000)
genSizedRep Int
n Rep era t
IntR = t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
Int
n
genSizedRep Int
n Rep era t
NaturalR = t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Gen t) -> t -> Gen t
forall a b. (a -> b) -> a -> b
$ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
genSizedRep Int
_ Rep era t
FloatR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
TxInR =
  TxId -> TxIx -> t
TxId -> TxIx -> TxIn
TxIn
    (TxId -> TxIx -> t) -> Gen TxId -> Gen (TxIx -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxId
forall a. Arbitrary a => Gen a
arbitrary
    Gen (TxIx -> t) -> Gen TxIx -> Gen t
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HasCallStack => Integer -> TxIx
Integer -> TxIx
mkTxIxPartial (Integer -> TxIx) -> (Int -> Integer) -> Int -> TxIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> TxIx) -> Gen Int -> Gen TxIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
2, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
forall a. Bounded a => a
maxBound :: Word16))))
genSizedRep Int
_ Rep era t
CharR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (ValueR Proof era
p) = Proof era -> Gen (ValueF era)
forall era. Proof era -> Gen (ValueF era)
genValue Proof era
p
genSizedRep Int
_ (TxOutR Proof era
p) = Proof era -> Gen (TxOutF era)
forall era. Proof era -> Gen (TxOutF era)
genTxOut Proof era
p
genSizedRep Int
_n (UTxOR Proof era
p) = Proof era -> Gen (UTxO era)
forall era. Proof era -> Gen (UTxO era)
genUTxO Proof era
p
genSizedRep Int
_ (PParamsR Proof era
p) = Proof era -> Gen (PParamsF era)
forall era. Proof era -> Gen (PParamsF era)
genPParams Proof era
p
genSizedRep Int
_ (FuturePParamsR Proof era
p) = Proof era -> Gen (FuturePParams era)
forall era. Proof era -> Gen (FuturePParams era)
genFuturePParams Proof era
p
genSizedRep Int
_ (PParamsUpdateR Proof era
p) = Proof era -> Gen (PParamsUpdateF era)
forall era. Proof era -> Gen (PParamsUpdateF era)
genPParamsUpdate Proof era
p
genSizedRep Int
_ Rep era t
CertStateR = Gen t
Gen (CertStateF era)
forall era. Reflect era => Gen (CertStateF era)
genCertState
genSizedRep Int
_ Rep era t
DeltaCoinR = Integer -> t
Integer -> DeltaCoin
DeltaCoin (Integer -> t) -> Gen Integer -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (-Integer
1000, Integer
1000)
genSizedRep Int
_ Rep era t
GenDelegPairR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
FutureGenDelegR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ r :: Rep era t
r@(PPUPStateR Proof era
_) = Rep era (ShelleyGovState era) -> Gen (ShelleyGovState era)
forall era.
Rep era (ShelleyGovState era) -> Gen (ShelleyGovState era)
genpup Rep era t
Rep era (ShelleyGovState era)
r
genSizedRep Int
_ Rep era t
PtrR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
IPoolStakeR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
SnapShotsR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
UnitR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n (PairR Rep era a
a Rep era b
b) = (,) (a -> b -> t) -> Gen a -> Gen (b -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Rep era a -> Gen a
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era a
a Gen (b -> t) -> Gen b -> Gen t
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Rep era b -> Gen b
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era b
b
genSizedRep Int
_ Rep era t
RewardR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n (MaybeR Rep era t
x) = [(Int, Gen t)] -> Gen t
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
Maybe t
forall a. Maybe a
Nothing), (Int
5, t -> t
t -> Maybe t
forall a. a -> Maybe a
Just (t -> t) -> Gen t -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Rep era t -> Gen t
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era t
x)]
genSizedRep Int
_ Rep era t
NewEpochStateR = String -> Gen t
forall a. HasCallStack => String -> a
error String
"no way to gen a random NewEpochState"
genSizedRep Int
_ (ProtVerR Proof era
proof) = Proof era -> Gen ProtVer
forall era. Era era => Proof era -> Gen ProtVer
genProtVer Proof era
proof
genSizedRep Int
n Rep era t
SlotNoR = SlotNo -> Gen SlotNo
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo -> Gen SlotNo) -> SlotNo -> Gen SlotNo
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
genSizedRep Int
_ Rep era t
SizeR = do Int
lo <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
6); Int
hi <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
6, Int
10); t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Size
SzRng Int
lo Int
hi)
genSizedRep Int
_ Rep era t
VCredR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
VHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
MultiAssetR = Map PolicyID (Map AssetName Integer) -> t
Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> t)
-> Gen (Map PolicyID (Map AssetName Integer)) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Rep era (Map PolicyID (Map AssetName Integer))
-> Gen (Map PolicyID (Map AssetName Integer))
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n (Rep era PolicyID
-> Rep era (Map AssetName Integer)
-> Rep era (Map PolicyID (Map AssetName Integer))
forall a era b.
Ord a =>
Rep era a -> Rep era b -> Rep era (Map a b)
MapR (forall era. Era era => Rep era PolicyID
PolicyIDR @era) (Rep era AssetName
-> Rep era Integer -> Rep era (Map AssetName Integer)
forall a era b.
Ord a =>
Rep era a -> Rep era b -> Rep era (Map a b)
MapR Rep era AssetName
forall era. Rep era AssetName
AssetNameR Rep era Integer
forall era. Rep era Integer
IntegerR))
genSizedRep Int
_ Rep era t
PolicyIDR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (WitnessesFieldR Proof era
_) = t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Gen t) -> t -> Gen t
forall a b. (a -> b) -> a -> b
$ Set (WitVKey 'Witness) -> WitnessesField era
forall era. Set (WitVKey 'Witness) -> WitnessesField era
AddrWits Set (WitVKey 'Witness)
forall a. Set a
Set.empty
genSizedRep Int
_ Rep era t
AssetNameR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
RewardAccountR = Network -> Credential 'Staking -> t
Network -> Credential 'Staking -> RewardAccount
RewardAccount (Network -> Credential 'Staking -> t)
-> Gen Network -> Gen (Credential 'Staking -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen Network
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Network
Testnet Gen (Credential 'Staking -> t)
-> Gen (Credential 'Staking) -> Gen t
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Credential 'Staking)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Shelley) = Proof ShelleyEra -> TxCert ShelleyEra -> TxCertF ShelleyEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof ShelleyEra
Shelley (ShelleyTxCert ShelleyEra -> t)
-> Gen (ShelleyTxCert ShelleyEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxCert ShelleyEra)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Allegra) = Proof AllegraEra -> TxCert AllegraEra -> TxCertF AllegraEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof AllegraEra
Allegra (ShelleyTxCert AllegraEra -> t)
-> Gen (ShelleyTxCert AllegraEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxCert AllegraEra)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Mary) = Proof MaryEra -> TxCert MaryEra -> TxCertF MaryEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof MaryEra
Mary (ShelleyTxCert MaryEra -> t)
-> Gen (ShelleyTxCert MaryEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxCert MaryEra)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Alonzo) = Proof AlonzoEra -> TxCert AlonzoEra -> TxCertF AlonzoEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof AlonzoEra
Alonzo (ShelleyTxCert AlonzoEra -> t)
-> Gen (ShelleyTxCert AlonzoEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxCert AlonzoEra)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Babbage) = Proof BabbageEra -> TxCert BabbageEra -> TxCertF BabbageEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof BabbageEra
Babbage (ShelleyTxCert BabbageEra -> t)
-> Gen (ShelleyTxCert BabbageEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxCert BabbageEra)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxCertR Proof era
Conway) = Proof ConwayEra -> TxCert ConwayEra -> TxCertF ConwayEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof ConwayEra
Conway (ConwayTxCert ConwayEra -> t)
-> Gen (ConwayTxCert ConwayEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ConwayTxCert ConwayEra)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
ValidityIntervalR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
KeyPairR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n (GenR Rep era x
x) = t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Rep era x -> Gen x
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era x
x)
genSizedRep Int
_ (ScriptR Proof era
p) = Proof era -> Gen (ScriptF era)
forall era. Proof era -> Gen (ScriptF era)
genScriptF Proof era
p
genSizedRep Int
_ Rep era t
ScriptHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
NetworkR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n (RdmrPtrR Proof era
p) =
  case Proof era
p of
    Proof era
Shelley -> String -> Gen t
forall a. HasCallStack => String -> a
error String
"Redeemers are not supported in Shelley"
    Proof era
Allegra -> String -> Gen t
forall a. HasCallStack => String -> a
error String
"Redeemers are not supported in Allegra"
    Proof era
Mary -> String -> Gen t
forall a. HasCallStack => String -> a
error String
"Redeemers are not supported in Mary"
    Proof era
Alonzo -> do
      Word32
i <- (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
0, Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      Proof era -> PlutusPurpose AsIx era -> PlutusPointerF era
forall era.
Proof era -> PlutusPurpose AsIx era -> PlutusPointerF era
PlutusPointerF Proof era
p (AlonzoPlutusPurpose AsIx AlonzoEra -> t)
-> Gen (AlonzoPlutusPurpose AsIx AlonzoEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Gen (AlonzoPlutusPurpose AsIx AlonzoEra)
forall era. Word32 -> Gen (AlonzoPlutusPurpose AsIx era)
genAlonzoPlutusPurposePointer Word32
i
    Proof era
Babbage -> do
      Word32
i <- (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
0, Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      Proof era -> PlutusPurpose AsIx era -> PlutusPointerF era
forall era.
Proof era -> PlutusPurpose AsIx era -> PlutusPointerF era
PlutusPointerF Proof era
p (AlonzoPlutusPurpose AsIx BabbageEra -> t)
-> Gen (AlonzoPlutusPurpose AsIx BabbageEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Gen (AlonzoPlutusPurpose AsIx BabbageEra)
forall era. Word32 -> Gen (AlonzoPlutusPurpose AsIx era)
genAlonzoPlutusPurposePointer Word32
i
    Proof era
Conway -> do
      Word32
i <- (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
0, Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      Proof era -> PlutusPurpose AsIx era -> PlutusPointerF era
forall era.
Proof era -> PlutusPurpose AsIx era -> PlutusPointerF era
PlutusPointerF Proof era
p (ConwayPlutusPurpose AsIx ConwayEra -> t)
-> Gen (ConwayPlutusPurpose AsIx ConwayEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Gen (ConwayPlutusPurpose AsIx ConwayEra)
forall era. Word32 -> Gen (ConwayPlutusPurpose AsIx era)
genConwayPlutusPurposePointer Word32
i
genSizedRep Int
_ Rep era t
DataR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
DatumR =
  [Gen t] -> Gen t
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
Datum era
forall era. Datum era
NoDatum
    , SafeHash EraIndependentData -> t
SafeHash EraIndependentData -> Datum era
forall era. SafeHash EraIndependentData -> Datum era
DatumHash (SafeHash EraIndependentData -> t)
-> Gen (SafeHash EraIndependentData) -> Gen t
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 Rep era (SafeHash EraIndependentData)
forall era. Era era => Rep era (SafeHash EraIndependentData)
DataHashR
    , BinaryData era -> t
BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> t)
-> (Data era -> BinaryData era) -> Data era -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> t) -> Gen (Data era) -> Gen t
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 Rep era (Data era)
forall era. Era era => Rep era (Data era)
DataR
    ]
genSizedRep Int
_ Rep era t
ExUnitsR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DataHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PCredR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
ShelleyTxCertR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
ConwayTxCertR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
MIRPotR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
IsValidR = [(Int, Gen t)] -> Gen t
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IsValid
IsValid Bool
False)), (Int
9, t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IsValid
IsValid Bool
True))]
genSizedRep Int
_ Rep era t
IntegerR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (ScriptsNeededR Proof era
p) = case Proof era -> UTxOWit era
forall era. Proof era -> UTxOWit era
whichUTxO Proof era
p of
  UTxOWit era
UTxOShelleyToMary -> t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Gen t) -> t -> Gen t
forall a b. (a -> b) -> a -> b
$ Proof era -> ScriptsNeeded era -> ScriptsNeededF era
forall era. Proof era -> ScriptsNeeded era -> ScriptsNeededF era
ScriptsNeededF Proof era
p (Set ScriptHash -> ShelleyScriptsNeeded era
forall era. Set ScriptHash -> ShelleyScriptsNeeded era
ShelleyScriptsNeeded Set ScriptHash
forall a. Set a
Set.empty)
  UTxOWit era
UTxOAlonzoToConway -> t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Gen t) -> t -> Gen t
forall a b. (a -> b) -> a -> b
$ Proof era -> ScriptsNeeded era -> ScriptsNeededF era
forall era. Proof era -> ScriptsNeeded era -> ScriptsNeededF era
ScriptsNeededF Proof era
p ([(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded [])
genSizedRep Int
_ (ScriptPurposeR Proof era
p) =
  case Proof era
p of
    Proof era
Shelley -> String -> Gen t
forall a. HasCallStack => String -> a
error String
"PlutusPurpose is not supported in Shelley"
    Proof era
Allegra -> String -> Gen t
forall a. HasCallStack => String -> a
error String
"PlutusPurpose is not supported in Allegra"
    Proof era
Mary -> String -> Gen t
forall a. HasCallStack => String -> a
error String
"PlutusPurpose is not supported in Mary"
    Proof era
Alonzo -> Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era
forall era.
Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era
PlutusPurposeF Proof era
p (AlonzoPlutusPurpose AsIxItem AlonzoEra -> t)
-> Gen (AlonzoPlutusPurpose AsIxItem AlonzoEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoPlutusPurpose AsIxItem AlonzoEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Babbage -> Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era
forall era.
Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era
PlutusPurposeF Proof era
p (AlonzoPlutusPurpose AsIxItem BabbageEra -> t)
-> Gen (AlonzoPlutusPurpose AsIxItem BabbageEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoPlutusPurpose AsIxItem BabbageEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Conway -> Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era
forall era.
Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era
PlutusPurposeF Proof era
p (ConwayPlutusPurpose AsIxItem ConwayEra -> t)
-> Gen (ConwayPlutusPurpose AsIxItem ConwayEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ConwayPlutusPurpose AsIxItem ConwayEra)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxBodyR Proof era
p) =
  case Proof era
p of
    Proof era
Shelley -> t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof era -> TxBody era -> TxBodyF era
forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
    Proof era
Allegra -> t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof era -> TxBody era -> TxBodyF era
forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
    Proof era
Mary -> t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof era -> TxBody era -> TxBodyF era
forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
    Proof era
Alonzo -> t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof era -> TxBody era -> TxBodyF era
forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
    Proof era
Babbage -> t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof era -> TxBody era -> TxBodyF era
forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
    Proof era
Conway -> t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof era -> TxBody era -> TxBodyF era
forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF Proof era
p (Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
p []))
genSizedRep Int
_ Rep era t
BootstrapWitnessR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
SigningKeyR = Gen t
Gen SigningKey
genSigningKey
genSizedRep Int
_ (TxWitsR Proof era
p) =
  case Proof era
p of
    Proof era
Shelley -> Proof era -> TxWits era -> TxWitsF era
forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p (ShelleyTxWits ShelleyEra -> t)
-> Gen (ShelleyTxWits ShelleyEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxWits ShelleyEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Allegra -> Proof era -> TxWits era -> TxWitsF era
forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p (ShelleyTxWits AllegraEra -> t)
-> Gen (ShelleyTxWits AllegraEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxWits AllegraEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Mary -> Proof era -> TxWits era -> TxWitsF era
forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p (ShelleyTxWits MaryEra -> t)
-> Gen (ShelleyTxWits MaryEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxWits MaryEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Alonzo -> Proof era -> TxWits era -> TxWitsF era
forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p (AlonzoTxWits AlonzoEra -> t)
-> Gen (AlonzoTxWits AlonzoEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTxWits AlonzoEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Babbage -> Proof era -> TxWits era -> TxWitsF era
forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p (AlonzoTxWits BabbageEra -> t)
-> Gen (AlonzoTxWits BabbageEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTxWits BabbageEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Conway -> Proof era -> TxWits era -> TxWitsF era
forall era. Proof era -> TxWits era -> TxWitsF era
TxWitsF Proof era
p (AlonzoTxWits ConwayEra -> t)
-> Gen (AlonzoTxWits ConwayEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTxWits ConwayEra)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PayHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxR Proof era
p) =
  case Proof era
p of
    Proof era
Shelley -> Proof era -> Tx era -> TxF era
forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p (ShelleyTx ShelleyEra -> t) -> Gen (ShelleyTx ShelleyEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTx ShelleyEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Allegra -> Proof era -> Tx era -> TxF era
forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p (ShelleyTx AllegraEra -> t) -> Gen (ShelleyTx AllegraEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTx AllegraEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Mary -> Proof era -> Tx era -> TxF era
forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p (ShelleyTx MaryEra -> t) -> Gen (ShelleyTx MaryEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTx MaryEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Alonzo -> Proof era -> Tx era -> TxF era
forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p (AlonzoTx AlonzoEra -> t) -> Gen (AlonzoTx AlonzoEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTx AlonzoEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Babbage -> Proof era -> Tx era -> TxF era
forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p (AlonzoTx BabbageEra -> t) -> Gen (AlonzoTx BabbageEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTx BabbageEra)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Conway -> Proof era -> Tx era -> TxF era
forall era. Proof era -> Tx era -> TxF era
TxF Proof era
p (AlonzoTx ConwayEra -> t) -> Gen (AlonzoTx ConwayEra) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTx ConwayEra)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
ScriptIntegrityHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
TxAuxDataHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
GovActionR = StrictMaybe (GovPurposeId 'CommitteePurpose era) -> t
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> t)
-> Gen (StrictMaybe (GovPurposeId 'CommitteePurpose era)) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (WitVKeyR Proof era
_) = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (TxAuxDataR Proof era
p) = Proof era -> Gen (TxAuxDataF era)
forall era. Proof era -> Gen (TxAuxDataF era)
genTxAuxDataF Proof era
p
genSizedRep Int
_ Rep era t
CommColdCredR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
CommHotCredR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
LanguageR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (LedgerStateR Proof era
p) = case Proof era
p of
  Proof era
Shelley -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Allegra -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Mary -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Alonzo -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Babbage -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Conway -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
StakeHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
BoolR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DRepR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ (PoolMetadataR Proof era
p) =
  if Proof era -> Bool
forall era. Proof era -> Bool
restrictHash Proof era
p
    then Url -> ByteString -> t
Url -> ByteString -> PoolMetadata
PoolMetadata (Url -> ByteString -> t) -> Gen Url -> Gen (ByteString -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Url
forall a. Arbitrary a => Gen a
arbitrary Gen (ByteString -> t) -> Gen ByteString -> Gen t
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ByteString -> ByteString
BS.take Int
hashsize (ByteString -> ByteString) -> Gen ByteString -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary)
    else Url -> ByteString -> t
Url -> ByteString -> PoolMetadata
PoolMetadata (Url -> ByteString -> t) -> Gen Url -> Gen (ByteString -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Url
forall a. Arbitrary a => Gen a
arbitrary Gen (ByteString -> t) -> Gen ByteString -> Gen t
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DRepStateR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DStateR =
  t -> Gen t
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( UMap
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
forall era.
UMap
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
DState
        UMap
UM.empty
        Map FutureGenDeleg GenDelegPair
forall k a. Map k a
Map.empty
        (Map (KeyHash 'Genesis) GenDelegPair -> GenDelegs
GenDelegs Map (KeyHash 'Genesis) GenDelegPair
forall k a. Map k a
Map.empty)
        (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards Map (Credential 'Staking) Coin
forall k a. Map k a
Map.empty Map (Credential 'Staking) Coin
forall k a. Map k a
Map.empty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
    )
genSizedRep Int
_ Rep era t
GovActionIdR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
GovActionIxR = Word16 -> t
Word16 -> GovActionIx
GovActionIx (Word16 -> t) -> Gen Word16 -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16, Word16) -> Gen Word16
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 -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Allegra -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Mary -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Alonzo -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Babbage -> Gen t
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Conway -> (Int, Int) -> Gen (Proposals ConwayEra)
forall era.
(HasCallStack, EraPParams era,
 Arbitrary (PParamsHKD StrictMaybe era)) =>
(Int, Int) -> Gen (Proposals era)
genProposals (Int
5, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
7)
genSizedRep Int
_ Rep era t
GovActionStateR =
  GovActionId
-> Map (Credential 'HotCommitteeRole) Vote
-> Map (Credential 'DRepRole) Vote
-> Map (KeyHash 'StakePool) Vote
-> ProposalProcedure era
-> EpochNo
-> EpochNo
-> t
GovActionId
-> Map (Credential 'HotCommitteeRole) Vote
-> Map (Credential 'DRepRole) Vote
-> Map (KeyHash 'StakePool) Vote
-> ProposalProcedure era
-> EpochNo
-> EpochNo
-> GovActionState era
forall era.
GovActionId
-> Map (Credential 'HotCommitteeRole) Vote
-> Map (Credential 'DRepRole) Vote
-> Map (KeyHash 'StakePool) Vote
-> ProposalProcedure era
-> EpochNo
-> EpochNo
-> GovActionState era
GovActionState
    (GovActionId
 -> Map (Credential 'HotCommitteeRole) Vote
 -> Map (Credential 'DRepRole) Vote
 -> Map (KeyHash 'StakePool) Vote
 -> ProposalProcedure era
 -> EpochNo
 -> EpochNo
 -> t)
-> Gen GovActionId
-> Gen
     (Map (Credential 'HotCommitteeRole) Vote
      -> Map (Credential 'DRepRole) Vote
      -> Map (KeyHash 'StakePool) Vote
      -> ProposalProcedure era
      -> EpochNo
      -> EpochNo
      -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen GovActionId
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Map (Credential 'HotCommitteeRole) Vote
   -> Map (Credential 'DRepRole) Vote
   -> Map (KeyHash 'StakePool) Vote
   -> ProposalProcedure era
   -> EpochNo
   -> EpochNo
   -> t)
-> Gen (Map (Credential 'HotCommitteeRole) Vote)
-> Gen
     (Map (Credential 'DRepRole) Vote
      -> Map (KeyHash 'StakePool) Vote
      -> ProposalProcedure era
      -> EpochNo
      -> EpochNo
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map (Credential 'HotCommitteeRole) Vote
-> Gen (Map (Credential 'HotCommitteeRole) Vote)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (Credential 'HotCommitteeRole) Vote
forall k a. Map k a
Map.empty
    Gen
  (Map (Credential 'DRepRole) Vote
   -> Map (KeyHash 'StakePool) Vote
   -> ProposalProcedure era
   -> EpochNo
   -> EpochNo
   -> t)
-> Gen (Map (Credential 'DRepRole) Vote)
-> Gen
     (Map (KeyHash 'StakePool) Vote
      -> ProposalProcedure era -> EpochNo -> EpochNo -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map (Credential 'DRepRole) Vote
-> Gen (Map (Credential 'DRepRole) Vote)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (Credential 'DRepRole) Vote
forall k a. Map k a
Map.empty
    Gen
  (Map (KeyHash 'StakePool) Vote
   -> ProposalProcedure era -> EpochNo -> EpochNo -> t)
-> Gen (Map (KeyHash 'StakePool) Vote)
-> Gen (ProposalProcedure era -> EpochNo -> EpochNo -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map (KeyHash 'StakePool) Vote
-> Gen (Map (KeyHash 'StakePool) Vote)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (KeyHash 'StakePool) Vote
forall k a. Map k a
Map.empty
    Gen (ProposalProcedure era -> EpochNo -> EpochNo -> t)
-> Gen (ProposalProcedure era) -> Gen (EpochNo -> EpochNo -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Coin
-> RewardAccount
-> GovAction era
-> Anchor
-> ProposalProcedure era
forall era.
Coin
-> RewardAccount
-> GovAction era
-> Anchor
-> ProposalProcedure era
ProposalProcedure (Coin
 -> RewardAccount
 -> GovAction era
 -> Anchor
 -> ProposalProcedure era)
-> Gen Coin
-> Gen
     (RewardAccount -> GovAction era -> Anchor -> ProposalProcedure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era b. Rep era b -> Gen b
genRep @era Rep era Coin
forall era. Rep era Coin
CoinR Gen
  (RewardAccount -> GovAction era -> Anchor -> ProposalProcedure era)
-> Gen RewardAccount
-> Gen (GovAction era -> Anchor -> ProposalProcedure era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen RewardAccount
forall a. Arbitrary a => Gen a
arbitrary Gen (GovAction era -> Anchor -> ProposalProcedure era)
-> Gen (GovAction era) -> Gen (Anchor -> ProposalProcedure era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall era b. Rep era b -> Gen b
genRep @era Rep era (GovAction era)
forall era. Era era => Rep era (GovAction era)
GovActionR Gen (Anchor -> ProposalProcedure era)
-> Gen Anchor -> Gen (ProposalProcedure era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Anchor
forall a. Arbitrary a => Gen a
arbitrary)
    Gen (EpochNo -> EpochNo -> t) -> Gen EpochNo -> Gen (EpochNo -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary
    Gen (EpochNo -> t) -> Gen EpochNo -> Gen t
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
UnitIntervalR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
CommitteeR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
ConstitutionR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PrevGovActionIdsR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PrevPParamUpdateR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PrevHardForkR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PrevCommitteeR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
PrevConstitutionR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
RatifyStateR =
  EnactState era
-> Seq (GovActionState era) -> Set GovActionId -> Bool -> t
EnactState era
-> Seq (GovActionState era)
-> Set GovActionId
-> Bool
-> RatifyState era
forall era.
EnactState era
-> Seq (GovActionState era)
-> Set GovActionId
-> Bool
-> RatifyState era
RatifyState
    (EnactState era
 -> Seq (GovActionState era) -> Set GovActionId -> Bool -> t)
-> Gen (EnactState era)
-> Gen (Seq (GovActionState era) -> Set GovActionId -> Bool -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Rep era (EnactState era) -> Gen (EnactState era)
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n Rep era (EnactState era)
forall era. Reflect era => Rep era (EnactState era)
EnactStateR
    Gen (Seq (GovActionState era) -> Set GovActionId -> Bool -> t)
-> Gen (Seq (GovActionState era))
-> Gen (Set GovActionId -> Bool -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Seq (GovActionState era) -> Gen (Seq (GovActionState era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq (GovActionState era)
forall a. Monoid a => a
mempty
    Gen (Set GovActionId -> Bool -> t)
-> Gen (Set GovActionId) -> Gen (Bool -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set GovActionId -> Gen (Set GovActionId)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set GovActionId
forall a. Monoid a => a
mempty
    Gen (Bool -> t) -> Gen Bool -> Gen t
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
NumDormantEpochsR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
CommitteeAuthorizationR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
CommitteeStateR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
VStateR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DRepHashR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
AnchorR = Gen t
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
EnactStateR =
  StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking) Coin
-> GovRelation StrictMaybe era
-> t
StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking) Coin
-> GovRelation StrictMaybe era
-> EnactState era
forall era.
StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking) Coin
-> GovRelation StrictMaybe era
-> EnactState era
EnactState
    (StrictMaybe (Committee era)
 -> Constitution era
 -> PParams era
 -> PParams era
 -> Coin
 -> Map (Credential 'Staking) Coin
 -> GovRelation StrictMaybe era
 -> t)
-> Gen (StrictMaybe (Committee era))
-> Gen
     (Constitution era
      -> PParams era
      -> PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (StrictMaybe (Committee era))
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Constitution era
   -> PParams era
   -> PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> t)
-> Gen (Constitution era)
-> Gen
     (PParams era
      -> PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Constitution era)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (PParams era
   -> PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> t)
-> Gen (PParams era)
-> Gen
     (PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PParamsF era -> PParams era
forall era. PParamsF era -> PParams era
unPParams (PParamsF era -> PParams era)
-> Gen (PParamsF era) -> Gen (PParams era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proof era -> Gen (PParamsF era)
forall era. Proof era -> Gen (PParamsF era)
genPParams Proof era
forall era. Reflect era => Proof era
reify)
    Gen
  (PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> t)
-> Gen (PParams era)
-> Gen
     (Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PParamsF era -> PParams era
forall era. PParamsF era -> PParams era
unPParams (PParamsF era -> PParams era)
-> Gen (PParamsF era) -> Gen (PParams era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proof era -> Gen (PParamsF era)
forall era. Proof era -> Gen (PParamsF era)
genPParams Proof era
forall era. Reflect era => Proof era
reify)
    Gen
  (Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> t)
-> Gen Coin
-> Gen
     (Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era -> t)
-> Gen (Map (Credential 'Staking) Coin)
-> Gen (GovRelation StrictMaybe era -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Map (Credential 'Staking) Coin)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (GovRelation StrictMaybe era -> t)
-> Gen (GovRelation StrictMaybe era) -> Gen t
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (GovRelation StrictMaybe era)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
_ Rep era t
DRepPulserR = do
  StrictSeq (GovActionState era)
props <- [GovActionState era] -> StrictSeq (GovActionState era)
forall a. [a] -> StrictSeq a
SS.fromList ([GovActionState era] -> StrictSeq (GovActionState era))
-> (GovActionState era -> [GovActionState era])
-> GovActionState era
-> StrictSeq (GovActionState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovActionState era -> [GovActionState era] -> [GovActionState era]
forall a. a -> [a] -> [a]
: []) (GovActionState era -> StrictSeq (GovActionState era))
-> Gen (GovActionState era) -> Gen (StrictSeq (GovActionState era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rep era (GovActionState era) -> Gen (GovActionState era)
forall era b. Rep era b -> Gen b
genRep Rep era (GovActionState era)
forall era. Era era => Rep era (GovActionState era)
GovActionStateR
  Int
-> UMap
-> Int
-> InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> EnactState era
-> StrictSeq (GovActionState era)
-> Map (Credential 'Staking) (CompactForm Coin)
-> Globals
-> Map (KeyHash 'StakePool) PoolParams
-> t
Int
-> UMap
-> Int
-> InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> EnactState era
-> StrictSeq (GovActionState era)
-> Map (Credential 'Staking) (CompactForm Coin)
-> Globals
-> Map (KeyHash 'StakePool) PoolParams
-> DRepPulser era Identity (RatifyState era)
forall era ans (m :: * -> *).
(ans ~ RatifyState era, m ~ Identity, RunConwayRatify era) =>
Int
-> UMap
-> Int
-> InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> EnactState era
-> StrictSeq (GovActionState era)
-> Map (Credential 'Staking) (CompactForm Coin)
-> Globals
-> Map (KeyHash 'StakePool) PoolParams
-> DRepPulser era m ans
DRepPulser
    (Int
 -> UMap
 -> Int
 -> InstantStake era
 -> PoolDistr
 -> Map DRep (CompactForm Coin)
 -> Map (Credential 'DRepRole) DRepState
 -> EpochNo
 -> CommitteeState era
 -> EnactState era
 -> StrictSeq (GovActionState era)
 -> Map (Credential 'Staking) (CompactForm Coin)
 -> Globals
 -> Map (KeyHash 'StakePool) PoolParams
 -> t)
-> Gen Int
-> Gen
     (UMap
      -> Int
      -> InstantStake era
      -> PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> EnactState era
      -> StrictSeq (GovActionState era)
      -> Map (Credential 'Staking) (CompactForm Coin)
      -> Globals
      -> Map (KeyHash 'StakePool) PoolParams
      -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Arbitrary a => Gen a
arbitrary -- pulsesize
    Gen
  (UMap
   -> Int
   -> InstantStake era
   -> PoolDistr
   -> Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> EnactState era
   -> StrictSeq (GovActionState era)
   -> Map (Credential 'Staking) (CompactForm Coin)
   -> Globals
   -> Map (KeyHash 'StakePool) PoolParams
   -> t)
-> Gen UMap
-> Gen
     (Int
      -> InstantStake era
      -> PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> EnactState era
      -> StrictSeq (GovActionState era)
      -> Map (Credential 'Staking) (CompactForm Coin)
      -> Globals
      -> Map (KeyHash 'StakePool) PoolParams
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UMap
forall a. Arbitrary a => Gen a
arbitrary -- umap
    Gen
  (Int
   -> InstantStake era
   -> PoolDistr
   -> Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> EnactState era
   -> StrictSeq (GovActionState era)
   -> Map (Credential 'Staking) (CompactForm Coin)
   -> Globals
   -> Map (KeyHash 'StakePool) PoolParams
   -> t)
-> Gen Int
-> Gen
     (InstantStake era
      -> PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> EnactState era
      -> StrictSeq (GovActionState era)
      -> Map (Credential 'Staking) (CompactForm Coin)
      -> Globals
      -> Map (KeyHash 'StakePool) PoolParams
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary -- balance
    Gen
  (InstantStake era
   -> PoolDistr
   -> Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> EnactState era
   -> StrictSeq (GovActionState era)
   -> Map (Credential 'Staking) (CompactForm Coin)
   -> Globals
   -> Map (KeyHash 'StakePool) PoolParams
   -> t)
-> Gen (InstantStake era)
-> Gen
     (PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> EnactState era
      -> StrictSeq (GovActionState era)
      -> Map (Credential 'Staking) (CompactForm Coin)
      -> Globals
      -> Map (KeyHash 'StakePool) PoolParams
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proof era -> Gen (InstantStake era)
genInstantStake Proof era
forall era. Reflect era => Proof era
reify -- instantStake
    Gen
  (PoolDistr
   -> Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> EnactState era
   -> StrictSeq (GovActionState era)
   -> Map (Credential 'Staking) (CompactForm Coin)
   -> Globals
   -> Map (KeyHash 'StakePool) PoolParams
   -> t)
-> Gen PoolDistr
-> Gen
     (Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> EnactState era
      -> StrictSeq (GovActionState era)
      -> Map (Credential 'Staking) (CompactForm Coin)
      -> Globals
      -> Map (KeyHash 'StakePool) PoolParams
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PoolDistr
forall a. Arbitrary a => Gen a
arbitrary -- poolDistr
    Gen
  (Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> EnactState era
   -> StrictSeq (GovActionState era)
   -> Map (Credential 'Staking) (CompactForm Coin)
   -> Globals
   -> Map (KeyHash 'StakePool) PoolParams
   -> t)
-> Gen (Map DRep (CompactForm Coin))
-> Gen
     (Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> EnactState era
      -> StrictSeq (GovActionState era)
      -> Map (Credential 'Staking) (CompactForm Coin)
      -> Globals
      -> Map (KeyHash 'StakePool) PoolParams
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Map DRep (CompactForm Coin))
forall a. Arbitrary a => Gen a
arbitrary -- partial drep distr
    Gen
  (Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> EnactState era
   -> StrictSeq (GovActionState era)
   -> Map (Credential 'Staking) (CompactForm Coin)
   -> Globals
   -> Map (KeyHash 'StakePool) PoolParams
   -> t)
-> Gen (Map (Credential 'DRepRole) DRepState)
-> Gen
     (EpochNo
      -> CommitteeState era
      -> EnactState era
      -> StrictSeq (GovActionState era)
      -> Map (Credential 'Staking) (CompactForm Coin)
      -> Globals
      -> Map (KeyHash 'StakePool) PoolParams
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Map (Credential 'DRepRole) DRepState)
forall a. Arbitrary a => Gen a
arbitrary -- drepstate
    Gen
  (EpochNo
   -> CommitteeState era
   -> EnactState era
   -> StrictSeq (GovActionState era)
   -> Map (Credential 'Staking) (CompactForm Coin)
   -> Globals
   -> Map (KeyHash 'StakePool) PoolParams
   -> t)
-> Gen EpochNo
-> Gen
     (CommitteeState era
      -> EnactState era
      -> StrictSeq (GovActionState era)
      -> Map (Credential 'Staking) (CompactForm Coin)
      -> Globals
      -> Map (KeyHash 'StakePool) PoolParams
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary -- epoch
    Gen
  (CommitteeState era
   -> EnactState era
   -> StrictSeq (GovActionState era)
   -> Map (Credential 'Staking) (CompactForm Coin)
   -> Globals
   -> Map (KeyHash 'StakePool) PoolParams
   -> t)
-> Gen (CommitteeState era)
-> Gen
     (EnactState era
      -> StrictSeq (GovActionState era)
      -> Map (Credential 'Staking) (CompactForm Coin)
      -> Globals
      -> Map (KeyHash 'StakePool) PoolParams
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CommitteeState era)
forall a. Arbitrary a => Gen a
arbitrary -- committeestate
    Gen
  (EnactState era
   -> StrictSeq (GovActionState era)
   -> Map (Credential 'Staking) (CompactForm Coin)
   -> Globals
   -> Map (KeyHash 'StakePool) PoolParams
   -> t)
-> Gen (EnactState era)
-> Gen
     (StrictSeq (GovActionState era)
      -> Map (Credential 'Staking) (CompactForm Coin)
      -> Globals
      -> Map (KeyHash 'StakePool) PoolParams
      -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Rep era (EnactState era) -> Gen (EnactState era)
forall era b. Rep era b -> Gen b
genRep Rep era (EnactState era)
forall era. Reflect era => Rep era (EnactState era)
EnactStateR
    Gen
  (StrictSeq (GovActionState era)
   -> Map (Credential 'Staking) (CompactForm Coin)
   -> Globals
   -> Map (KeyHash 'StakePool) PoolParams
   -> t)
-> Gen (StrictSeq (GovActionState era))
-> Gen
     (Map (Credential 'Staking) (CompactForm Coin)
      -> Globals -> Map (KeyHash 'StakePool) PoolParams -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictSeq (GovActionState era)
-> Gen (StrictSeq (GovActionState era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictSeq (GovActionState era)
props
    Gen
  (Map (Credential 'Staking) (CompactForm Coin)
   -> Globals -> Map (KeyHash 'StakePool) PoolParams -> t)
-> Gen (Map (Credential 'Staking) (CompactForm Coin))
-> Gen (Globals -> Map (KeyHash 'StakePool) PoolParams -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map (Credential 'Staking) (CompactForm Coin)
-> Gen (Map (Credential 'Staking) (CompactForm Coin))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proposals era -> Map (Credential 'Staking) (CompactForm Coin)
forall era.
Proposals era -> Map (Credential 'Staking) (CompactForm Coin)
proposalsDeposits (Proposals era -> Map (Credential 'Staking) (CompactForm Coin))
-> Proposals era -> Map (Credential 'Staking) (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ Proposals era
forall a. Default a => a
def Proposals era -> (Proposals era -> Proposals era) -> Proposals era
forall a b. a -> (a -> b) -> b
& (OMap GovActionId (GovActionState era)
 -> Identity (OMap GovActionId (GovActionState era)))
-> Proposals era -> Identity (Proposals era)
forall era (f :: * -> *).
Functor f =>
(OMap GovActionId (GovActionState era)
 -> f (OMap GovActionId (GovActionState era)))
-> Proposals era -> f (Proposals era)
pPropsL ((OMap GovActionId (GovActionState era)
  -> Identity (OMap GovActionId (GovActionState era)))
 -> Proposals era -> Identity (Proposals era))
-> OMap GovActionId (GovActionState era)
-> Proposals era
-> Proposals era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (GovActionState era)
-> OMap GovActionId (GovActionState era)
forall (f :: * -> *) k v.
(Foldable f, HasOKey k v) =>
f v -> OMap k v
OMap.fromFoldable StrictSeq (GovActionState era)
props)
    Gen (Globals -> Map (KeyHash 'StakePool) PoolParams -> t)
-> Gen Globals -> Gen (Map (KeyHash 'StakePool) PoolParams -> t)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Globals -> Gen Globals
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Globals
testGlobals
    Gen (Map (KeyHash 'StakePool) PoolParams -> t)
-> Gen (Map (KeyHash 'StakePool) PoolParams) -> Gen t
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Map (KeyHash 'StakePool) PoolParams)
forall a. Arbitrary a => Gen a
arbitrary -- poolparams
  where
    genInstantStake :: Proof era -> Gen (InstantStake era)
    genInstantStake :: Proof era -> Gen (InstantStake era)
genInstantStake = \case
      Proof era
Shelley -> Gen (InstantStake era)
Gen (ShelleyInstantStake ShelleyEra)
forall a. Arbitrary a => Gen a
arbitrary
      Proof era
Allegra -> Gen (InstantStake era)
Gen (ShelleyInstantStake AllegraEra)
forall a. Arbitrary a => Gen a
arbitrary
      Proof era
Mary -> Gen (InstantStake era)
Gen (ShelleyInstantStake MaryEra)
forall a. Arbitrary a => Gen a
arbitrary
      Proof era
Alonzo -> Gen (InstantStake era)
Gen (ShelleyInstantStake AlonzoEra)
forall a. Arbitrary a => Gen a
arbitrary
      Proof era
Babbage -> Gen (InstantStake era)
Gen (ShelleyInstantStake BabbageEra)
forall a. Arbitrary a => Gen a
arbitrary
      Proof era
Conway -> Gen (InstantStake era)
Gen (ConwayInstantStake ConwayEra)
forall a. Arbitrary a => Gen a
arbitrary
genSizedRep Int
n Rep era t
DelegateeR =
  [Gen t] -> Gen t
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ KeyHash 'StakePool -> t
KeyHash 'StakePool -> Delegatee
DelegStake (KeyHash 'StakePool -> t) -> Gen (KeyHash 'StakePool) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Rep era (KeyHash 'StakePool) -> Gen (KeyHash 'StakePool)
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n (forall era. Era era => Rep era (KeyHash 'StakePool)
PoolHashR @era)
    , DRep -> t
DRep -> Delegatee
DelegVote (DRep -> t) -> Gen DRep -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Rep era DRep -> Gen DRep
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n (forall era. Era era => Rep era DRep
DRepR @era)
    , KeyHash 'StakePool -> DRep -> t
KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote (KeyHash 'StakePool -> DRep -> t)
-> Gen (KeyHash 'StakePool) -> Gen (DRep -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Rep era (KeyHash 'StakePool) -> Gen (KeyHash 'StakePool)
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n (forall era. Era era => Rep era (KeyHash 'StakePool)
PoolHashR @era) Gen (DRep -> t) -> Gen DRep -> Gen t
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Rep era DRep -> Gen DRep
forall era t. Int -> Rep era t -> Gen t
genSizedRep Int
n (forall era. Era era => Rep era DRep
DRepR @era)
    ]
genSizedRep Int
_ Rep era t
VoteR = Gen t
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 = (b, b) -> Gen b
forall a. Random a => (a, a) -> Gen a
choose (b
0, b
10000)
genRep Rep era b
x = do (NonNegative Int
n) <- Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary; Int -> Rep era b -> Gen b
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
  SigningKey -> Gen SigningKey
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrv -> SigningKey
SigningKey (XPrv -> SigningKey) -> XPrv -> SigningKey
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> XPrv
forall passPhrase seed.
(ByteArrayAccess passPhrase, ByteArrayAccess seed) =>
seed -> passPhrase -> XPrv
Byron.generate ByteString
seed (ByteString
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 = [(Int, Gen ProtVer)] -> Gen ProtVer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency ((Int -> Version -> (Int, Gen ProtVer))
-> [Int] -> [Version] -> [(Int, Gen ProtVer)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Version -> (Int, Gen ProtVer)
forall {a}. a -> Version -> (a, Gen ProtVer)
pair [Int
count, Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 .. Int
1] [Version]
versions)
  where
    versions :: [Version]
versions = Proof era -> [Version]
forall era. Era era => Proof era -> [Version]
protVerRange Proof era
proof
    count :: Int
count = [Version] -> Int
forall a. [a] -> Int
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 (Natural -> ProtVer) -> Gen Natural -> Gen ProtVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Natural] -> Gen Natural
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) = Gen (ShelleyGovState era)
forall a. Arbitrary a => Gen a
arbitrary
genpup (PPUPStateR Proof era
Allegra) = Gen (ShelleyGovState era)
forall a. Arbitrary a => Gen a
arbitrary
genpup (PPUPStateR Proof era
Mary) = Gen (ShelleyGovState era)
forall a. Arbitrary a => Gen a
arbitrary
genpup (PPUPStateR Proof era
Alonzo) = Gen (ShelleyGovState era)
forall a. Arbitrary a => Gen a
arbitrary
genpup (PPUPStateR Proof era
Babbage) = Gen (ShelleyGovState era)
forall a. Arbitrary a => Gen a
arbitrary
genpup (PPUPStateR Proof era
Conway) = Gen (ShelleyGovState era)
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 = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
CoinR t
t = 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 = ([(a, b)] -> t)
-> (t -> [(a, b)]) -> ([(a, b)] -> [[(a, b)]]) -> t -> [t]
forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy [(a, b)] -> t
[(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList t -> [(a, b)]
Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList (Rep era [(a, b)] -> [(a, b)] -> [[(a, b)]]
forall era t. Rep era t -> t -> [t]
shrinkRep (Rep era [(a, b)] -> [(a, b)] -> [[(a, b)]])
-> Rep era [(a, b)] -> [(a, b)] -> [[(a, b)]]
forall a b. (a -> b) -> a -> b
$ Rep era (a, b) -> Rep era [(a, b)]
forall era a. Rep era a -> Rep era [a]
ListR (Rep era a -> Rep era b -> Rep era (a, b)
forall era a b. Rep era a -> Rep era b -> Rep era (a, b)
PairR Rep era a
a Rep era b
b)) t
t
shrinkRep (SetR Rep era a
a) t
t = ([a] -> t) -> (t -> [a]) -> ([a] -> [[a]]) -> t -> [t]
forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy [a] -> t
[a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList t -> [a]
Set a -> [a]
forall a. Set a -> [a]
Set.toList (Rep era [a] -> [a] -> [[a]]
forall era t. Rep era t -> t -> [t]
shrinkRep (Rep era [a] -> [a] -> [[a]]) -> Rep era [a] -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Rep era a -> Rep era [a]
forall era a. Rep era a -> Rep era [a]
ListR Rep era a
a) t
t
shrinkRep (ListR Rep era a
a) t
t = (a -> [a]) -> [a] -> [[a]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (Rep era a -> a -> [a]
forall era t. Rep era t -> t -> [t]
shrinkRep Rep era a
a) t
[a]
t
shrinkRep Rep era t
CredR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
PoolHashR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
WitHashR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
GenHashR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
GenDelegHashR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
PoolParamsR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
EpochR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
EpochIntervalR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
RationalR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
Word64R t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
IntR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
NaturalR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
FloatR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
TxInR t
t = 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
CertStateR t
_ = []
shrinkRep Rep era t
CharR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
DeltaCoinR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
GenDelegPairR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
FutureGenDelegR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (PPUPStateR Proof era
_) t
_ = []
shrinkRep Rep era t
PtrR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
IPoolStakeR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
SnapShotsR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
UnitR t
t = 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' <- Rep era a -> a -> [a]
forall era t. Rep era t -> t -> [t]
shrinkRep Rep era a
a a
x] [t] -> [t] -> [t]
forall a. [a] -> [a] -> [a]
++ [(a
x, b
y') | b
y' <- Rep era b -> b -> [b]
forall era t. Rep era t -> t -> [t]
shrinkRep Rep era b
b b
y]
shrinkRep Rep era t
RewardR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (MaybeR Rep era t
a) t
t = ([t] -> t) -> (t -> [t]) -> ([t] -> [[t]]) -> t -> [t]
forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy [t] -> t
[t] -> Maybe t
forall a. [a] -> Maybe a
listToMaybe t -> [t]
Maybe t -> [t]
forall a. Maybe a -> [a]
maybeToList (Rep era [t] -> [t] -> [[t]]
forall era t. Rep era t -> t -> [t]
shrinkRep (Rep era [t] -> [t] -> [[t]]) -> Rep era [t] -> [t] -> [[t]]
forall a b. (a -> b) -> a -> b
$ Rep era t -> Rep era [t]
forall era a. Rep era a -> Rep era [a]
ListR Rep era t
a) t
t
shrinkRep Rep era t
NewEpochStateR t
_ = []
shrinkRep (ProtVerR Proof era
_) t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
SlotNoR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
SizeR t
_ = []
shrinkRep Rep era t
MultiAssetR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
PolicyIDR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (WitnessesFieldR Proof era
_) t
_ = []
shrinkRep Rep era t
AssetNameR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (TxCertR Proof era
Shelley) (TxCertF Proof ShelleyEra
p TxCert ShelleyEra
x) = (ShelleyTxCert ShelleyEra -> t)
-> [ShelleyTxCert ShelleyEra] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (Proof ShelleyEra -> TxCert ShelleyEra -> TxCertF ShelleyEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof ShelleyEra
p) (ShelleyTxCert ShelleyEra -> [ShelleyTxCert ShelleyEra]
forall a. Arbitrary a => a -> [a]
shrink TxCert ShelleyEra
ShelleyTxCert ShelleyEra
x)
shrinkRep (TxCertR Proof era
Allegra) (TxCertF Proof AllegraEra
p TxCert AllegraEra
x) = (ShelleyTxCert AllegraEra -> t)
-> [ShelleyTxCert AllegraEra] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (Proof AllegraEra -> TxCert AllegraEra -> TxCertF AllegraEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof AllegraEra
p) (ShelleyTxCert AllegraEra -> [ShelleyTxCert AllegraEra]
forall a. Arbitrary a => a -> [a]
shrink TxCert AllegraEra
ShelleyTxCert AllegraEra
x)
shrinkRep (TxCertR Proof era
Mary) (TxCertF Proof MaryEra
p TxCert MaryEra
x) = (ShelleyTxCert MaryEra -> t) -> [ShelleyTxCert MaryEra] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (Proof MaryEra -> TxCert MaryEra -> TxCertF MaryEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof MaryEra
p) (ShelleyTxCert MaryEra -> [ShelleyTxCert MaryEra]
forall a. Arbitrary a => a -> [a]
shrink TxCert MaryEra
ShelleyTxCert MaryEra
x)
shrinkRep (TxCertR Proof era
Alonzo) (TxCertF Proof AlonzoEra
p TxCert AlonzoEra
x) = (ShelleyTxCert AlonzoEra -> t) -> [ShelleyTxCert AlonzoEra] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (Proof AlonzoEra -> TxCert AlonzoEra -> TxCertF AlonzoEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof AlonzoEra
p) (ShelleyTxCert AlonzoEra -> [ShelleyTxCert AlonzoEra]
forall a. Arbitrary a => a -> [a]
shrink TxCert AlonzoEra
ShelleyTxCert AlonzoEra
x)
shrinkRep (TxCertR Proof era
Babbage) (TxCertF Proof BabbageEra
p TxCert BabbageEra
x) = (ShelleyTxCert BabbageEra -> t)
-> [ShelleyTxCert BabbageEra] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (Proof BabbageEra -> TxCert BabbageEra -> TxCertF BabbageEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof BabbageEra
p) (ShelleyTxCert BabbageEra -> [ShelleyTxCert BabbageEra]
forall a. Arbitrary a => a -> [a]
shrink TxCert BabbageEra
ShelleyTxCert BabbageEra
x)
shrinkRep (TxCertR Proof era
Conway) (TxCertF Proof ConwayEra
p TxCert ConwayEra
x) = (ConwayTxCert ConwayEra -> t) -> [ConwayTxCert ConwayEra] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (Proof ConwayEra -> TxCert ConwayEra -> TxCertF ConwayEra
forall era. Proof era -> TxCert era -> TxCertF era
TxCertF Proof ConwayEra
p) (ConwayTxCert ConwayEra -> [ConwayTxCert ConwayEra]
forall a. Arbitrary a => a -> [a]
shrink TxCert ConwayEra
ConwayTxCert ConwayEra
x)
shrinkRep Rep era t
RewardAccountR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
ValidityIntervalR t
_ = []
shrinkRep Rep era t
KeyPairR t
t = 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 = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
VCredR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
VHashR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
NetworkR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (RdmrPtrR Proof era
_) t
_ = []
shrinkRep Rep era t
DataR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
DatumR t
_ = []
shrinkRep Rep era t
ExUnitsR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
DataHashR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
AddrR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
PCredR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
ShelleyTxCertR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
ConwayTxCertR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
MIRPotR t
t = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep Rep era t
IsValidR t
_ = []
shrinkRep Rep era t
IntegerR t
t = 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 = 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 = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
t
shrinkRep (TxR Proof era
_) t
_ = []
shrinkRep Rep era t
ScriptIntegrityHashR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
TxAuxDataHashR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
GovActionR t
_ = []
shrinkRep (WitVKeyR Proof era
_) t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep (TxAuxDataR Proof era
_) t
_ = []
shrinkRep Rep era t
CommColdCredR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
CommHotCredR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
LanguageR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep (LedgerStateR Proof era
_) t
_ = []
shrinkRep Rep era t
StakeHashR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
BoolR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
DRepR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep (PoolMetadataR Proof era
_) t
_ = []
shrinkRep Rep era t
DRepStateR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
DStateR t
_ = []
shrinkRep Rep era t
GovActionIdR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
GovActionIxR (GovActionIx Word16
n) = (Word16 -> t) -> [Word16] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Word16 -> t
Word16 -> GovActionIx
GovActionIx (Word16 -> [Word16]
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 = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
CommitteeR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
ConstitutionR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
PrevGovActionIdsR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
PrevPParamUpdateR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
PrevHardForkR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
PrevCommitteeR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
PrevConstitutionR t
x = t -> [t]
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 = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
EnactStateR t
_ = []
shrinkRep Rep era t
NumDormantEpochsR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
DRepHashR t
x = t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x
shrinkRep Rep era t
AnchorR t
x = t -> [t]
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 = t -> [t]
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 Rep era t -> HasInstances t
forall era t. Rep era t -> HasInstances t
repHasInstances Rep era t
rep of
  HasInstances t
IsOrd -> HasConstraint Ord (s t) -> Typed (HasConstraint Ord (s t))
forall a. a -> Typed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HasConstraint Ord (s t) -> Typed (HasConstraint Ord (s t)))
-> HasConstraint Ord (s t) -> Typed (HasConstraint Ord (s t))
forall a b. (a -> b) -> a -> b
$ s t -> HasConstraint Ord (s t)
forall (c :: * -> Constraint) t1 (s :: * -> *).
c t1 =>
s t1 -> HasConstraint c (s t1)
With s t
x
  HasInstances t
IsTypeable -> [String] -> Typed (HasConstraint Ord (s t))
forall a. [String] -> Typed a
failT [Rep era t -> String
forall a. Show a => a -> String
show Rep era t
rep String -> ShowS
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 Rep era t -> HasInstances t
forall era t. Rep era t -> HasInstances t
repHasInstances Rep era t
rep of
  HasInstances t
IsEq -> HasConstraint Eq (s t) -> Typed (HasConstraint Eq (s t))
forall a. a -> Typed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HasConstraint Eq (s t) -> Typed (HasConstraint Eq (s t)))
-> HasConstraint Eq (s t) -> Typed (HasConstraint Eq (s t))
forall a b. (a -> b) -> a -> b
$ s t -> HasConstraint Eq (s t)
forall (c :: * -> Constraint) t1 (s :: * -> *).
c t1 =>
s t1 -> HasConstraint c (s t1)
With s t
x
  HasInstances t
IsTypeable -> [String] -> Typed (HasConstraint Eq (s t))
forall a. [String] -> Typed a
failT [Rep era t -> String
forall a. Show a => a -> String
show Rep era t
rep String -> ShowS
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 = PDoc -> String
forall a. Show a => a -> String
show ((a -> PDoc) -> (b -> PDoc) -> Map a b -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap (Rep era a -> a -> PDoc
forall era t. Rep era t -> t -> PDoc
syn Rep era a
d) (Rep era b -> b -> PDoc
forall era t. Rep era t -> t -> PDoc
syn Rep era b
r) t
Map a b
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep era t -> t -> String
forall e t. Rep e t -> t -> String
synSum Rep era t
rep t
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nsize=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Map a b -> Int
forall k a. Map k a -> Int
Map.size t
Map a b
x)
format rep :: Rep era t
rep@(ListR Rep era a
d) t
x = PDoc -> String
forall a. Show a => a -> String
show ((a -> PDoc) -> [a] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Rep era a -> a -> PDoc
forall era t. Rep era t -> t -> PDoc
syn Rep era a
d) t
[a]
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep era t -> t -> String
forall e t. Rep e t -> t -> String
synSum Rep era t
rep t
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep era t -> t -> String
forall e t. Rep e t -> t -> String
synSum Rep era t
rep t
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nsize=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t
[a]
x)
format rep :: Rep era t
rep@(SetR Rep era a
d) t
x = PDoc -> String
forall a. Show a => a -> String
show ((a -> PDoc) -> Set a -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (Rep era a -> a -> PDoc
forall era t. Rep era t -> t -> PDoc
syn Rep era a
d) t
Set a
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep era t -> t -> String
forall e t. Rep e t -> t -> String
synSum Rep era t
rep t
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rep era t -> t -> String
forall e t. Rep e t -> t -> String
synSum Rep era t
rep t
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nsize=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Set a -> Int
forall a. Set a -> Int
Set.size t
Set a
x)
format (MaybeR Rep era t
d) t
x = PDoc -> String
forall a. Show a => a -> String
show ((t -> PDoc) -> Maybe t -> PDoc
forall x ann. (x -> Doc ann) -> Maybe x -> Doc ann
ppMaybe (Rep era t -> t -> PDoc
forall era t. Rep era t -> t -> PDoc
syn Rep era t
d) t
Maybe t
x)
format Rep era t
r t
x = Rep era t -> t -> String
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 = String -> PDoc
forall a. String -> Doc a
ppString (Rep era t -> t -> String
forall e t. Rep e t -> t -> String
format Rep era t
d t
x)