{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Generic.PrettyCore where

import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Address (Addr (..), RewardAccount (..))
import Cardano.Ledger.Allegra.Rules as Allegra (AllegraUtxoPredFailure (..))
import Cardano.Ledger.Allegra.Scripts (
  AllegraEraScript (..),
  Timelock,
  ValidityInterval (..),
  pattern RequireTimeExpire,
  pattern RequireTimeStart,
 )
import Cardano.Ledger.Allegra.TxAuxData (AllegraTxAuxData (..))
import Cardano.Ledger.Allegra.TxBody (AllegraTxBody (..))
import Cardano.Ledger.Alonzo.Core (CoinPerWord (..))
import Cardano.Ledger.Alonzo.Plutus.Context (ContextError)
import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (..))
import Cardano.Ledger.Alonzo.Rules as Alonzo (
  AlonzoBbodyPredFailure (..),
  AlonzoUtxoPredFailure (..),
  AlonzoUtxosPredFailure (..),
  AlonzoUtxowPredFailure (..),
  FailureDescription (..),
  TagMismatchDescription (..),
 )
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoEraScript (..),
  AlonzoPlutusPurpose (..),
  AlonzoScript (..),
  AsItem (..),
  AsIx (..),
  AsIxItem (..),
  ExUnits (..),
  PlutusPurpose,
  plutusScriptLanguage,
 )
import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..))
import Cardano.Ledger.Alonzo.TxAuxData (
  AlonzoTxAuxData,
  atadMetadata',
  getAlonzoTxAuxDataScripts,
 )
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxBody (..), AlonzoTxOut (..))
import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..), TxDats (..), unRedeemers, unTxDats)
import Cardano.Ledger.Alonzo.UTxO (AlonzoScriptsNeeded (..))
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..))
import Cardano.Ledger.Babbage.Core (CoinPerByte (..))
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..), BabbageUtxowPredFailure (..))
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
import Cardano.Ledger.BaseTypes (
  Anchor (..),
  BlocksMade (..),
  EpochInterval (..),
  EpochNo (..),
  FixedPoint,
  Mismatch (..),
  Network (..),
  Nonce (..),
  ProtVer (..),
  SlotNo (..),
  TxIx (..),
  UnitInterval,
  Version,
  certIxToInt,
  getVersion64,
  txIxToInt,
  unboundRational,
 )
import Cardano.Ledger.CertState (CommitteeAuthorization (..), CommitteeState (..))
import qualified Cardano.Ledger.CertState as DP
import Cardano.Ledger.Coin (Coin (..), CompactForm (..), DeltaCoin (..))
import Cardano.Ledger.Conway.Governance (
  Committee (..),
  Constitution (..),
  ConwayGovState (..),
  DRepPulser (..),
  DRepPulsingState (..),
  EnactState (..),
  GovAction (..),
  GovActionId (..),
  GovActionIx (..),
  GovActionState (..),
  GovPurposeId (..),
  GovRelation (..),
  PEdges (..),
  PGraph (..),
  ProposalProcedure (..),
  Proposals,
  PulsingSnapshot (..),
  RatifyEnv (..),
  RatifySignal (..),
  RatifyState (..),
  Vote (..),
  Voter (..),
  VotingProcedure (..),
  VotingProcedures (..),
  pGraphL,
  pRootsL,
  proposalsActionsMap,
  toPrevGovActionIds,
  unPGraph,
 )
import Cardano.Ledger.Conway.Rules (
  CertEnv (..),
  ConwayBbodyPredFailure,
  ConwayCertsPredFailure (..),
  ConwayDelegEnv (..),
  ConwayDelegPredFailure (..),
  ConwayGovCertEnv (..),
  ConwayGovCertPredFailure (..),
  ConwayGovPredFailure (..),
  ConwayLedgerPredFailure (..),
  ConwayNewEpochPredFailure,
  ConwayUtxosPredFailure,
  EnactSignal (..),
  GovEnv (..),
  GovSignal (..),
 )
import qualified Cardano.Ledger.Conway.Rules as ConwayRules
import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..))
import Cardano.Ledger.Conway.TxCert (
  ConwayDelegCert (..),
  ConwayGovCert (..),
  ConwayTxCert (..),
  Delegatee (..),
 )
import Cardano.Ledger.Core
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (
  Credential (
    KeyHashObj,
    ScriptHashObj
  ),
  Ptr (..),
  StakeReference (..),
 )
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.DRep (DRep (..), DRepState (..))
import Cardano.Ledger.EpochBoundary (
  SnapShot (..),
  SnapShots (..),
  Stake (..),
 )
import Cardano.Ledger.Keys (
  GenDelegPair (..),
  GenDelegs (..),
  HasKeyRole (coerceKeyRole),
  KeyHash (..),
  KeyRole (..),
  VKey (..),
  WitVKey (..),
  hashKey,
 )
import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness (..), ChainCode (..))
import Cardano.Ledger.Mary.TxBody (MaryTxBody (..))
import Cardano.Ledger.Mary.Value (
  AssetName (..),
  MaryValue (..),
  MultiAsset (..),
  PolicyID (..),
  flattenMultiAsset,
 )
import Cardano.Ledger.MemoBytes (MemoBytes (..))
import Cardano.Ledger.Plutus.Data (
  Data (..),
  Datum (..),
  binaryDataToData,
  hashData,
 )
import qualified Cardano.Ledger.Plutus.ExUnits as ExUnits (Prices (..))
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.PoolDistr (IndividualPoolStake (..), PoolDistr (..))
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.SafeHash (SafeHash, extractHash, hashAnnotated)
import Cardano.Ledger.Shelley.AdaPots (
  AdaPots (..),
  totalAdaES,
  totalAdaPotsES,
 )
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  AccountState (..),
  CertState (..),
  DState (..),
  EpochState (..),
  FutureGenDeleg (..),
  IncrementalStake (IStake),
  InstantaneousRewards (..),
  LedgerState (..),
  NewEpochState (..),
  PState (..),
  RewardUpdate (..),
  UTxOState (..),
  VState (..),
 )
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..))
import qualified Cardano.Ledger.Shelley.PParams as PParams (Update (..))
import Cardano.Ledger.Shelley.PoolRank (Likelihood (..), LogWeight (..), NonMyopic (..))
import Cardano.Ledger.Shelley.Rules (
  LedgerEnv (..),
  PoolEnv (..),
  ShelleyLedgerPredFailure (..),
  UtxoEnv (..),
 )
import Cardano.Ledger.Shelley.Rules as Shelley (
  ShelleyBbodyPredFailure (..),
  ShelleyBbodyState (..),
  ShelleyDelegPredFailure (..),
  ShelleyDelegsPredFailure (..),
  ShelleyDelplPredFailure (..),
  ShelleyEpochPredFailure (..),
  ShelleyLedgersPredFailure (..),
  ShelleyNewEpochPredFailure (..),
  ShelleyPoolPredFailure (..),
  ShelleyPoolreapPredFailure,
  ShelleyPpupPredFailure (..),
  ShelleySnapPredFailure,
  ShelleyTickPredFailure (..),
  ShelleyUtxoPredFailure (..),
  ShelleyUtxowPredFailure (..),
 )
import Cardano.Ledger.Shelley.Scripts (
  MultiSig,
  ShelleyEraScript,
  pattern RequireAllOf,
  pattern RequireAnyOf,
  pattern RequireMOf,
  pattern RequireSignature,
 )
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxAuxData (Metadatum (..), ShelleyTxAuxData (..))
import Cardano.Ledger.Shelley.TxBody (ShelleyTxBody (..), ShelleyTxBodyRaw (..))
import Cardano.Ledger.Shelley.TxCert (ShelleyDelegCert (..), ShelleyTxCert (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits (..))
import Cardano.Ledger.Shelley.UTxO (ShelleyScriptsNeeded (..))
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Cardano.Ledger.UMap (
  RDPair (..),
  dRepMap,
  depositMap,
  fromCompact,
  ptrMap,
  rewardMap,
  sPoolMap,
 )
import qualified Cardano.Ledger.UMap as UM (UMap, UView (..), size)
import Cardano.Ledger.UTxO (ScriptsNeeded, UTxO (..))
import qualified Cardano.Ledger.Val as Val
import Codec.Binary.Bech32
import Control.Monad.Identity (Identity)
import Control.State.Transition.Extended (STS (..))
import qualified Data.ByteString as Long (ByteString)
import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.OSet.Strict (OSet)
import Data.Sequence (Seq)
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text, pack)
import Data.Typeable (Typeable)
import qualified Data.VMap as VMap
import Data.Void (Void, absurd)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Natural (Natural)
import Lens.Micro ((^.))
import qualified PlutusLedgerApi.V1 as PV1 (Data (..))
import Prettyprinter (
  Pretty (pretty),
  align,
  brackets,
  comma,
  encloseSep,
  fillSep,
  flatAlt,
  group,
  hang,
  hsep,
  lbrace,
  lparen,
  parens,
  punctuate,
  rbrace,
  reAnnotate,
  rparen,
  sep,
  space,
  vcat,
  viaShow,
  vsep,
  (<+>),
 )
import Prettyprinter.Internal (Doc (Empty))
import Prettyprinter.Util (putDocW)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
import Test.Cardano.Ledger.Generic.Fields (
  PParamsField (..),
  TxBodyField (..),
  TxField (..),
  WitnessesField (..),
  abstractPParams,
  abstractTx,
  abstractTxBody,
  abstractWitnesses,
 )
import qualified Test.Cardano.Ledger.Generic.Fields as Fields
import Test.Cardano.Ledger.Generic.Proof (
  AllegraEra,
  AlonzoEra,
  BabbageEra,
  ConwayEra,
  GovStateWit (..),
  MaryEra,
  Proof (..),
  Reflect (..),
  ShelleyEra,
  unReflect,
  whichGovState,
 )

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

class PrettyA t where
  prettyA :: t -> PDoc

instance PrettyA () where
  prettyA :: () -> PDoc
prettyA = forall a. [Char] -> Doc a
ppString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

instance PrettyA Void where
  prettyA :: Void -> PDoc
prettyA = forall a. Void -> a
absurd

instance PrettyA Bool where
  prettyA :: Bool -> PDoc
prettyA = forall a. Bool -> Doc a
ppBool

instance PrettyA Int where
  prettyA :: Int -> PDoc
prettyA = forall a. Int -> Doc a
ppInt

instance PrettyA x => PrettyA [x] where
  prettyA :: [x] -> PDoc
prettyA = forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall t. PrettyA t => t -> PDoc
prettyA

instance PrettyA x => PrettyA (NonEmpty x) where
  prettyA :: NonEmpty x -> PDoc
prettyA = forall t. PrettyA t => t -> PDoc
prettyA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance (PrettyA a, PrettyA b) => PrettyA (Map a b) where
  prettyA :: Map a b -> PDoc
prettyA = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall t. PrettyA t => t -> PDoc
prettyA forall t. PrettyA t => t -> PDoc
prettyA

instance (PrettyA a, PrettyA b) => PrettyA (a, b) where
  prettyA :: (a, b) -> PDoc
prettyA (a
x, b
y) = forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall ann. Doc ann
comma [forall t. PrettyA t => t -> PDoc
prettyA a
x, forall t. PrettyA t => t -> PDoc
prettyA b
y]

instance PrettyA Word32 where
  prettyA :: Word32 -> PDoc
prettyA = forall a. [Char] -> Doc a
ppString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

instance PrettyA Word64 where
  prettyA :: Word64 -> PDoc
prettyA = forall a. [Char] -> Doc a
ppString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

-- =====================================
-- Operations for pretty printing
-- =====================================

isEmpty :: Doc ann -> Bool
isEmpty :: forall ann. Doc ann -> Bool
isEmpty Doc ann
Empty = Bool
True
isEmpty Doc ann
_ = Bool
False

putDoc :: Doc ann -> IO ()
putDoc :: forall ann. Doc ann -> IO ()
putDoc = forall ann. Int -> Doc ann -> IO ()
putDocW Int
80

newtype PrettyAnn = Width Int

type Ann = [PrettyAnn]

type PDoc = Doc Ann

text :: Text -> Doc ann
text :: forall ann. Text -> Doc ann
text = forall a ann. Pretty a => a -> Doc ann
pretty

trim :: PDoc -> PDoc
trim :: PDoc -> PDoc
trim PDoc
x = forall a. [Char] -> Doc a
ppString (forall a. Int -> [a] -> [a]
take Int
10 (forall a. Show a => a -> [Char]
show PDoc
x))

-- ================================================
-- Named pretty printers for simple Haskell types
-- ================================================

ppString :: String -> Doc a
ppString :: forall a. [Char] -> Doc a
ppString = forall a ann. Pretty a => a -> Doc ann
pretty

ppDouble :: Double -> Doc a
ppDouble :: forall a. Double -> Doc a
ppDouble = forall a ann. Show a => a -> Doc ann
viaShow

ppInteger :: Integer -> Doc a
ppInteger :: forall a. Integer -> Doc a
ppInteger = forall a ann. Show a => a -> Doc ann
viaShow

ppRational :: Rational -> Doc a
ppRational :: forall a. Rational -> Doc a
ppRational = forall a ann. Show a => a -> Doc ann
viaShow

ppFloat :: Float -> Doc a
ppFloat :: forall a. Float -> Doc a
ppFloat = forall a ann. Show a => a -> Doc ann
viaShow

ppNatural :: Natural -> Doc a
ppNatural :: forall a. Natural -> Doc a
ppNatural = forall a ann. Show a => a -> Doc ann
viaShow

ppWord64 :: Word64 -> Doc a
ppWord64 :: forall a. Word64 -> Doc a
ppWord64 = forall a ann. Show a => a -> Doc ann
viaShow

ppWord32 :: Word32 -> Doc a
ppWord32 :: forall a. Word32 -> Doc a
ppWord32 = forall a ann. Show a => a -> Doc ann
viaShow

ppWord8 :: Word8 -> Doc a
ppWord8 :: forall a. Word8 -> Doc a
ppWord8 = forall a ann. Show a => a -> Doc ann
viaShow

ppWord16 :: Word16 -> Doc a
ppWord16 :: forall a. Word16 -> Doc a
ppWord16 = forall a ann. Show a => a -> Doc ann
viaShow

ppFixedPoint :: FixedPoint -> Doc a
ppFixedPoint :: forall a. FixedPoint -> Doc a
ppFixedPoint = forall a ann. Show a => a -> Doc ann
viaShow

ppPair :: (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair :: forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair t1 -> PDoc
pp1 t2 -> PDoc
pp2 (t1
x, t2
y) = PDoc -> [PDoc] -> PDoc
ppSexp' forall a. Monoid a => a
mempty [t1 -> PDoc
pp1 t1
x, t2 -> PDoc
pp2 t2
y]

-- ppSignedDSIGN :: SignedDSIGN a b -> Doc ann
ppSignedDSIGN :: Show a => a -> PDoc
ppSignedDSIGN :: forall a. Show a => a -> PDoc
ppSignedDSIGN a
x = forall ann ann'. (ann -> ann') -> Doc ann -> Doc ann'
reAnnotate (Int -> PrettyAnn
Width Int
5 forall a. a -> [a] -> [a]
:) (forall a ann. Show a => a -> Doc ann
viaShow a
x)

ppBool :: Bool -> Doc a
ppBool :: forall a. Bool -> Doc a
ppBool = forall a ann. Show a => a -> Doc ann
viaShow

ppInt :: Int -> Doc a
ppInt :: forall a. Int -> Doc a
ppInt = forall a ann. Show a => a -> Doc ann
viaShow

-- ======================
-- Byte Strings in Bech32 format

long_bech32 :: Long.ByteString -> Text
long_bech32 :: ByteString -> Text
long_bech32 ByteString
x =
  case Text -> Either HumanReadablePartError HumanReadablePart
humanReadablePartFromText Text
"*" of
    Right HumanReadablePart
human ->
      case HumanReadablePart -> DataPart -> Either EncodingError Text
encode HumanReadablePart
human (ByteString -> DataPart
dataPartFromBytes ByteString
x) of
        Right Text
ans -> Text
ans
        Left EncodingError
_ -> Text
"bech32Error"
    Left HumanReadablePartError
_ -> Text
"bech32Error"

lazy_bech32 :: Lazy.ByteString -> Text
lazy_bech32 :: ByteString -> Text
lazy_bech32 ByteString
x =
  case Text -> Either HumanReadablePartError HumanReadablePart
humanReadablePartFromText Text
"*" of
    Right HumanReadablePart
human ->
      case HumanReadablePart -> DataPart -> Either EncodingError Text
encode HumanReadablePart
human (ByteString -> DataPart
dataPartFromBytes (ByteString -> ByteString
Lazy.toStrict ByteString
x)) of
        Right Text
ans -> Text
ans
        Left EncodingError
_ -> Text
"bech32Error"
    Left HumanReadablePartError
_ -> Text
"bech32Error"

ppLong :: Long.ByteString -> PDoc
ppLong :: ByteString -> PDoc
ppLong ByteString
x = forall ann. Text -> Doc ann
text (ByteString -> Text
long_bech32 ByteString
x)

ppLazy :: Lazy.ByteString -> PDoc
ppLazy :: ByteString -> PDoc
ppLazy ByteString
x = forall ann. Text -> Doc ann
text (ByteString -> Text
lazy_bech32 ByteString
x)

instance PrettyA Long.ByteString where
  prettyA :: ByteString -> PDoc
prettyA = ByteString -> PDoc
ppLong

instance PrettyA Lazy.ByteString where
  prettyA :: ByteString -> PDoc
prettyA = ByteString -> PDoc
ppLazy

-- ============================================
-- Combinators for common patterns of layout
-- ============================================

-- | x == y
equate :: Doc a -> Doc a -> Doc a
equate :: forall a. Doc a -> Doc a -> Doc a
equate Doc a
x Doc a
y = forall ann. Doc ann -> Doc ann
group (forall a. Doc a -> Doc a -> Doc a
flatAlt (forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (forall ann. [Doc ann] -> Doc ann
sep [Doc a
x forall a. Doc a -> Doc a -> Doc a
<+> forall ann. Text -> Doc ann
text Text
"=", Doc a
y])) (forall ann. [Doc ann] -> Doc ann
hsep [Doc a
x, forall ann. Text -> Doc ann
text Text
"=", Doc a
y]))

-- | x -> y
arrow :: (Doc a, Doc a) -> Doc a
arrow :: forall a. (Doc a, Doc a) -> Doc a
arrow (Doc a
x, Doc a
y) = forall ann. Doc ann -> Doc ann
group (forall a. Doc a -> Doc a -> Doc a
flatAlt (forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (forall ann. [Doc ann] -> Doc ann
sep [Doc a
x forall a. Doc a -> Doc a -> Doc a
<+> forall ann. Text -> Doc ann
text Text
"->", Doc a
y])) (forall ann. [Doc ann] -> Doc ann
hsep [Doc a
x, forall ann. Text -> Doc ann
text Text
"->", Doc a
y]))

-- | ppSexp x [w,y,z] --> (x w y z)
ppSexp :: Text -> [PDoc] -> PDoc
ppSexp :: Text -> [PDoc] -> PDoc
ppSexp Text
con = PDoc -> [PDoc] -> PDoc
ppSexp' (forall ann. Text -> Doc ann
text Text
con)

ppSexp' :: PDoc -> [PDoc] -> PDoc
ppSexp' :: PDoc -> [PDoc] -> PDoc
ppSexp' PDoc
con [PDoc]
fields =
  forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$
    forall a. Doc a -> Doc a -> Doc a
flatAlt
      (forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall ann. Doc ann
space [PDoc]
docs))
      (forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall ann. Doc ann
space [PDoc]
docs)
  where
    docs :: [PDoc]
docs = if forall ann. Doc ann -> Bool
isEmpty PDoc
con then [PDoc]
fields else PDoc
con forall a. a -> [a] -> [a]
: [PDoc]
fields

-- | ppRecord name [("a",x),("b",y),("c",z)] --> name { a = x, b = y, c = z }
ppRecord :: Text -> [(Text, PDoc)] -> PDoc
ppRecord :: Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
con = PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' (forall ann. Text -> Doc ann
text Text
con)

ppRecord' :: PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' :: PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' PDoc
con [(Text, PDoc)]
fields =
  forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$
    forall a. Doc a -> Doc a -> Doc a
flatAlt
      (forall ann. Int -> Doc ann -> Doc ann
hang Int
1 (forall ann. [Doc ann] -> Doc ann
vcat [PDoc
con, forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
puncLeft forall ann. Doc ann
lbrace (forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x, PDoc
y) -> forall a. Doc a -> Doc a -> Doc a
equate (forall ann. Text -> Doc ann
text Text
x) PDoc
y) [(Text, PDoc)]
fields) forall ann. Doc ann
comma forall ann. Doc ann
rbrace]))
      ( PDoc
con
          forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep
            (forall ann. Doc ann
lbrace forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space)
            (forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rbrace)
            (forall ann. Doc ann
comma forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space)
            (forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x, PDoc
y) -> forall a. Doc a -> Doc a -> Doc a
equate (forall ann. Text -> Doc ann
text Text
x) PDoc
y) [(Text, PDoc)]
fields)
      )

-- | Vertical layout with commas aligned on the left hand side
puncLeft :: Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
puncLeft :: forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
puncLeft Doc ann
open [] Doc ann
_ Doc ann
close = forall ann. [Doc ann] -> Doc ann
hsep [Doc ann
open, Doc ann
close]
puncLeft Doc ann
open [Doc ann
x] Doc ann
_ Doc ann
close = forall ann. [Doc ann] -> Doc ann
hsep [Doc ann
open, Doc ann
x, Doc ann
close]
puncLeft Doc ann
open (Doc ann
x : [Doc ann]
xs) Doc ann
coma Doc ann
close = forall ann. Doc ann -> Doc ann
align (forall ann. [Doc ann] -> Doc ann
sep ((Doc ann
open forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
x) forall a. a -> [a] -> [a]
: [Doc ann] -> [Doc ann]
help [Doc ann]
xs))
  where
    help :: [Doc ann] -> [Doc ann]
help [] = forall a. Monoid a => a
mempty
    help [Doc ann
y] = [forall ann. [Doc ann] -> Doc ann
hsep [Doc ann
coma, Doc ann
y, Doc ann
close]]
    help (Doc ann
y : [Doc ann]
ys) = (Doc ann
coma forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
y) forall a. a -> [a] -> [a]
: [Doc ann] -> [Doc ann]
help [Doc ann]
ys

ppSet :: (x -> Doc ann) -> Set x -> Doc ann
ppSet :: forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet x -> Doc ann
p Set x
xs = forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep forall ann. Doc ann
lbrace forall ann. Doc ann
rbrace forall ann. Doc ann
comma (forall a b. (a -> b) -> [a] -> [b]
map x -> Doc ann
p (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set x
xs))

ppSeq :: (a -> Doc ann) -> Seq a -> Doc ann
ppSeq :: forall a ann. (a -> Doc ann) -> Seq a -> Doc ann
ppSeq a -> Doc ann
p Seq a
xs = forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList a -> Doc ann
p (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] Seq a
xs)

ppList :: (x -> Doc ann) -> [x] -> Doc ann
ppList :: forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList x -> Doc ann
p [x]
xs = forall ann. Doc ann -> Doc ann
brackets forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
fillSep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map x -> Doc ann
p [x]
xs

ppStrictSeq :: (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq :: forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq a -> Doc ann
p StrictSeq a
xs = forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList a -> Doc ann
p (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] StrictSeq a
xs)

ppOSet :: (a -> Doc ann) -> OSet a -> Doc ann
ppOSet :: forall a ann. (a -> Doc ann) -> OSet a -> Doc ann
ppOSet a -> Doc ann
p OSet a
xs = forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList a -> Doc ann
p (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] OSet a
xs)

ppStrictMaybe :: (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe :: forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe x -> Doc ann
_ StrictMaybe x
SNothing = forall ann. Text -> Doc ann
text Text
"?-"
ppStrictMaybe x -> Doc ann
p (SJust x
x) = forall ann. Text -> Doc ann
text Text
"?" forall a. Semigroup a => a -> a -> a
<> x -> Doc ann
p x
x

ppMaybe :: (x -> Doc ann) -> Maybe x -> Doc ann
ppMaybe :: forall x ann. (x -> Doc ann) -> Maybe x -> Doc ann
ppMaybe x -> Doc ann
_ Maybe x
Nothing = forall ann. Text -> Doc ann
text Text
"?-"
ppMaybe x -> Doc ann
p (Just x
x) = forall ann. Text -> Doc ann
text Text
"?" forall a. Semigroup a => a -> a -> a
<> x -> Doc ann
p x
x

ppAssocList :: PDoc -> (k -> PDoc) -> (v -> PDoc) -> [(k, v)] -> PDoc
ppAssocList :: forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> [(k, v)] -> PDoc
ppAssocList PDoc
name k -> PDoc
kf v -> PDoc
vf [(k, v)]
xs =
  let docs :: [PDoc]
docs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(k
k, v
v) -> forall a. (Doc a, Doc a) -> Doc a
arrow (k -> PDoc
kf k
k, v -> PDoc
vf v
v)) [(k, v)]
xs
      vertical :: PDoc
vertical =
        if forall ann. Doc ann -> Bool
isEmpty PDoc
name
          then forall ann. Int -> Doc ann -> Doc ann
hang Int
1 (forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
puncLeft forall ann. Doc ann
lbrace [PDoc]
docs forall ann. Doc ann
comma forall ann. Doc ann
rbrace)
          else forall ann. Int -> Doc ann -> Doc ann
hang Int
1 (forall ann. [Doc ann] -> Doc ann
vcat [PDoc
name, forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
puncLeft forall ann. Doc ann
lbrace [PDoc]
docs forall ann. Doc ann
comma forall ann. Doc ann
rbrace])
   in forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$
        forall a. Doc a -> Doc a -> Doc a
flatAlt
          PDoc
vertical
          (PDoc
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep (forall ann. Doc ann
lbrace forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space) (forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rbrace) (forall ann. Doc ann
comma forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space) [PDoc]
docs)

ppMap' :: PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map.Map k v -> PDoc
ppMap' :: forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' PDoc
name k -> PDoc
kf v -> PDoc
vf = forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> [(k, v)] -> PDoc
ppAssocList PDoc
name k -> PDoc
kf v -> PDoc
vf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList

ppMap :: (k -> PDoc) -> (v -> PDoc) -> Map.Map k v -> PDoc
ppMap :: forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap = forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' (forall ann. Text -> Doc ann
text Text
"Map")

ppVMap ::
  (VMap.Vector kv k, VMap.Vector vv v) =>
  (k -> PDoc) ->
  (v -> PDoc) ->
  VMap.VMap kv vv k v ->
  PDoc
ppVMap :: forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
(k -> PDoc) -> (v -> PDoc) -> VMap kv vv k v -> PDoc
ppVMap k -> PDoc
pk v -> PDoc
pv = forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> [(k, v)] -> PDoc
ppAssocList (forall ann. Text -> Doc ann
text Text
"VMap") k -> PDoc
pk v -> PDoc
pv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> [(k, v)]
VMap.toList

-- =====================================================================================================
-- Pretty printers Cardano.Ledger types
-- =====================================================================================================

ppPolicyID :: PolicyID c -> PDoc
ppPolicyID :: forall c. PolicyID c -> PDoc
ppPolicyID (PolicyID ScriptHash c
sh) = forall era. ScriptHash era -> PDoc
pcScriptHash ScriptHash c
sh

ppLogWeight :: LogWeight -> PDoc
ppLogWeight :: LogWeight -> PDoc
ppLogWeight (LogWeight Float
n) = Text -> [PDoc] -> PDoc
ppSexp Text
"LogWeight" [forall a. Float -> Doc a
ppFloat Float
n]

instance PrettyA LogWeight where
  prettyA :: LogWeight -> PDoc
prettyA = LogWeight -> PDoc
ppLogWeight

ppPrices :: ExUnits.Prices -> PDoc
ppPrices :: Prices -> PDoc
ppPrices (ExUnits.Prices NonNegativeInterval
prMem NonNegativeInterval
prSteps) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Prices"
    [ (Text
"prMem", forall a. Rational -> Doc a
ppRational forall a b. (a -> b) -> a -> b
$ forall r. BoundedRational r => r -> Rational
unboundRational NonNegativeInterval
prMem)
    , (Text
"prSteps", forall a. Rational -> Doc a
ppRational forall a b. (a -> b) -> a -> b
$ forall r. BoundedRational r => r -> Rational
unboundRational NonNegativeInterval
prSteps)
    ]

instance PrettyA ExUnits.Prices where
  prettyA :: Prices -> PDoc
prettyA = Prices -> PDoc
ppPrices

ppRewardType :: RewardType -> PDoc
ppRewardType :: RewardType -> PDoc
ppRewardType RewardType
MemberReward = forall ann. Text -> Doc ann
text Text
"MemberReward"
ppRewardType RewardType
LeaderReward = forall ann. Text -> Doc ann
text Text
"LeaderReward"

ppLikelihood :: Likelihood -> PDoc
ppLikelihood :: Likelihood -> PDoc
ppLikelihood (Likelihood StrictSeq LogWeight
ns) = Text -> [PDoc] -> PDoc
ppSexp Text
"Likelihood" [forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq LogWeight -> PDoc
ppLogWeight StrictSeq LogWeight
ns]

ppNonMyopic :: NonMyopic c -> PDoc
ppNonMyopic :: forall c. NonMyopic c -> PDoc
ppNonMyopic (NonMyopic Map (KeyHash 'StakePool c) Likelihood
m Coin
c) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"NonMyopic"
    [ (Text
"likelihood", forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' PDoc
"" forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash Likelihood -> PDoc
ppLikelihood Map (KeyHash 'StakePool c) Likelihood
m)
    , (Text
"rewardPot", Coin -> PDoc
pcCoin Coin
c)
    ]

ppRewardUpdate :: RewardUpdate c -> PDoc
ppRewardUpdate :: forall c. RewardUpdate c -> PDoc
ppRewardUpdate (RewardUpdate DeltaCoin
dt DeltaCoin
dr Map (Credential 'Staking c) (Set (Reward c))
rss DeltaCoin
df NonMyopic c
nonmyop) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"RewardUpdate"
    [ (Text
"deltaT", DeltaCoin -> PDoc
pcDeltaCoin DeltaCoin
dt)
    , (Text
"deltaR", DeltaCoin -> PDoc
pcDeltaCoin DeltaCoin
dr)
    , (Text
"rs", forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' forall a. Monoid a => a
mempty forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential (forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. Reward c -> PDoc
pcReward) Map (Credential 'Staking c) (Set (Reward c))
rss)
    , (Text
"deltaF", DeltaCoin -> PDoc
pcDeltaCoin DeltaCoin
df)
    , (Text
"nonMyopic", forall c. NonMyopic c -> PDoc
ppNonMyopic NonMyopic c
nonmyop)
    ]

instance PrettyA (RewardUpdate c) where
  prettyA :: RewardUpdate c -> PDoc
prettyA = forall c. RewardUpdate c -> PDoc
ppRewardUpdate

ppLanguage :: Language -> PDoc
ppLanguage :: Language -> PDoc
ppLanguage = forall a. [Char] -> Doc a
ppString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

ppTxWitness ::
  forall era.
  Reflect era =>
  AlonzoTxWits era ->
  PDoc
ppTxWitness :: forall era. Reflect era => AlonzoTxWits era -> PDoc
ppTxWitness (AlonzoTxWits' Set (WitVKey 'Witness (EraCrypto era))
vk Set (BootstrapWitness (EraCrypto era))
wb Map (ScriptHash (EraCrypto era)) (Script era)
sc TxDats era
da Redeemers era
rd) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"AlonzoTxWits"
    [ (Text
"keys", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (forall era (keyrole :: KeyRole).
(Reflect era, Typeable keyrole) =>
Proof era -> WitVKey keyrole (EraCrypto era) -> PDoc
pcWitVKey @era forall era. Reflect era => Proof era
reify) Set (WitVKey 'Witness (EraCrypto era))
vk)
    , (Text
"bootstrap witnesses", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. Crypto c => BootstrapWitness c -> PDoc
ppBootstrapWitness Set (BootstrapWitness (EraCrypto era))
wb)
    , (Text
"scripts map", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall era. ScriptHash era -> PDoc
pcScriptHash (forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript forall era. Reflect era => Proof era
reify) Map (ScriptHash (EraCrypto era)) (Script era)
sc)
    , (Text
"Data map", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c index. SafeHash c index -> PDoc
ppSafeHash forall era. Era era => Data era -> PDoc
pcData (forall era. TxDats era -> Map (DataHash (EraCrypto era)) (Data era)
unTxDats TxDats era
da))
    , (Text
"Redeemer map", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall era. Reflect era => PlutusPurpose AsIx era -> PDoc
ppPlutusPurposeAsIx (forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair forall era. Era era => Data era -> PDoc
pcData ExUnits -> PDoc
pcExUnits) (forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers Redeemers era
rd))
    ]

instance Reflect era => PrettyA (AlonzoTxWits era) where
  prettyA :: AlonzoTxWits era -> PDoc
prettyA = forall era. Reflect era => AlonzoTxWits era -> PDoc
ppTxWitness

ppIsValid :: IsValid -> PDoc
ppIsValid :: IsValid -> PDoc
ppIsValid (IsValid Bool
True) = forall a. [Char] -> Doc a
ppString [Char]
"True"
ppIsValid (IsValid Bool
False) = forall a. [Char] -> Doc a
ppString [Char]
"False"

ppVersion :: Version -> PDoc
ppVersion :: Version -> PDoc
ppVersion = forall a. Word64 -> Doc a
ppWord64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Word64
getVersion64

ppNetwork :: Network -> PDoc
ppNetwork :: Network -> PDoc
ppNetwork Network
Testnet = forall ann. Text -> Doc ann
text Text
"Testnet"
ppNetwork Network
Mainnet = forall ann. Text -> Doc ann
text Text
"Mainnet"

ppValidityInterval :: ValidityInterval -> PDoc
ppValidityInterval :: ValidityInterval -> PDoc
ppValidityInterval (ValidityInterval StrictMaybe SlotNo
b StrictMaybe SlotNo
a) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ValidityInterval"
    [ (Text
"invalidBefore", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe SlotNo -> PDoc
pcSlotNo StrictMaybe SlotNo
b)
    , (Text
"invalidHereafter", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe SlotNo -> PDoc
pcSlotNo StrictMaybe SlotNo
a)
    ]

instance PrettyA ValidityInterval where
  prettyA :: ValidityInterval -> PDoc
prettyA = ValidityInterval -> PDoc
ppValidityInterval

ppAuxiliaryDataHash :: AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash :: forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash (AuxiliaryDataHash SafeHash c EraIndependentTxAuxData
h) = Text -> [PDoc] -> PDoc
ppSexp Text
"AuxiliaryDataHash" [forall c index. SafeHash c index -> PDoc
ppSafeHash SafeHash c EraIndependentTxAuxData
h]

instance PrettyA (AuxiliaryDataHash c) where
  prettyA :: AuxiliaryDataHash c -> PDoc
prettyA = forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash

ppSafeHash :: SafeHash c index -> PDoc
ppSafeHash :: forall c index. SafeHash c index -> PDoc
ppSafeHash SafeHash c index
x = forall a b. Hash a b -> PDoc
ppHash (forall c i. SafeHash c i -> Hash (HASH c) i
extractHash SafeHash c index
x)

instance PrettyA (SafeHash x y) where
  prettyA :: SafeHash x y -> PDoc
prettyA = forall c index. SafeHash c index -> PDoc
ppSafeHash

ppEpochNo :: EpochNo -> Doc ann
ppEpochNo :: forall ann. EpochNo -> Doc ann
ppEpochNo (EpochNo Word64
x) = forall ann. Text -> Doc ann
text Text
"EpochNo" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty Word64
x

instance PrettyA EpochNo where
  prettyA :: EpochNo -> PDoc
prettyA = forall ann. EpochNo -> Doc ann
ppEpochNo

ppEpochInterval :: EpochInterval -> Doc ann
ppEpochInterval :: forall ann. EpochInterval -> Doc ann
ppEpochInterval (EpochInterval Word32
x) = forall ann. Text -> Doc ann
text Text
"EpochInterval" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty Word32
x

instance PrettyA EpochInterval where
  prettyA :: EpochInterval -> PDoc
prettyA = forall ann. EpochInterval -> Doc ann
ppEpochInterval

ppHash :: Hash.Hash a b -> PDoc
ppHash :: forall a b. Hash a b -> PDoc
ppHash Hash a b
x = forall ann. Text -> Doc ann
text Text
"#" forall a. Semigroup a => a -> a -> a
<> forall ann ann'. (ann -> ann') -> Doc ann -> Doc ann'
reAnnotate (Int -> PrettyAnn
Width Int
5 forall a. a -> [a] -> [a]
:) (forall a ann. Show a => a -> Doc ann
viaShow Hash a b
x)

ppUnitInterval :: UnitInterval -> PDoc
ppUnitInterval :: UnitInterval -> PDoc
ppUnitInterval = forall a ann. Show a => a -> Doc ann
viaShow

instance PrettyA UnitInterval where
  prettyA :: UnitInterval -> PDoc
prettyA = UnitInterval -> PDoc
ppUnitInterval

ppNonce :: Nonce -> PDoc
ppNonce :: Nonce -> PDoc
ppNonce (Nonce Hash Blake2b_256 Nonce
h) = forall ann. Text -> Doc ann
text Text
"Nonce" forall a. Doc a -> Doc a -> Doc a
<+> forall a b. Hash a b -> PDoc
ppHash Hash Blake2b_256 Nonce
h
ppNonce Nonce
NeutralNonce = forall ann. Text -> Doc ann
text Text
"NeutralNonce"

ppPtr :: Ptr -> PDoc
ppPtr :: Ptr -> PDoc
ppPtr (Ptr SlotNo
slot TxIx
txIx CertIx
certIx) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Ptr" [SlotNo -> PDoc
pcSlotNo SlotNo
slot, forall a ann. Pretty a => a -> Doc ann
pretty (TxIx -> Int
txIxToInt TxIx
txIx), forall a ann. Pretty a => a -> Doc ann
pretty (CertIx -> Int
certIxToInt CertIx
certIx)]

instance PrettyA Ptr where
  prettyA :: Ptr -> PDoc
prettyA = Ptr -> PDoc
ppPtr

ppProtVer :: ProtVer -> PDoc
ppProtVer :: ProtVer -> PDoc
ppProtVer (ProtVer Version
maj Natural
mi) = Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"ProtVer" [(Text
"major", Version -> PDoc
ppVersion Version
maj), (Text
"minor", forall a. Natural -> Doc a
ppNatural Natural
mi)]

instance PrettyA ProtVer where
  prettyA :: ProtVer -> PDoc
prettyA = ProtVer -> PDoc
ppProtVer

ppVKey :: Crypto c => VKey r c -> PDoc
ppVKey :: forall c (r :: KeyRole). Crypto c => VKey r c -> PDoc
ppVKey vk :: VKey r c
vk@(VKey VerKeyDSIGN (DSIGN c)
x) = forall ann. [Doc ann] -> Doc ann
vsep [forall ann ann'. (ann -> ann') -> Doc ann -> Doc ann'
reAnnotate (Int -> PrettyAnn
Width Int
5 forall a. a -> [a] -> [a]
:) (forall a ann. Show a => a -> Doc ann
viaShow VerKeyDSIGN (DSIGN c)
x), PDoc
"hash = " forall a. Doc a -> Doc a -> Doc a
<+> forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash (forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey VKey r c
vk)]

instance Crypto c => PrettyA (VKey r c) where
  prettyA :: VKey r c -> PDoc
prettyA = forall c (r :: KeyRole). Crypto c => VKey r c -> PDoc
ppVKey

ppBootstrapWitness :: Crypto c => BootstrapWitness c -> PDoc
ppBootstrapWitness :: forall c. Crypto c => BootstrapWitness c -> PDoc
ppBootstrapWitness (BootstrapWitness VKey 'Witness c
key SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
sig (ChainCode ByteString
code) ByteString
attr) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"BootstrapWitness"
    [ (Text
"key", forall c (r :: KeyRole). Crypto c => VKey r c -> PDoc
ppVKey VKey 'Witness c
key)
    , (Text
"signature", forall a. Show a => a -> PDoc
ppSignedDSIGN SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
sig)
    , (Text
"chaincode", ByteString -> PDoc
ppLong ByteString
code)
    , (Text
"attributes", ByteString -> PDoc
ppLong ByteString
attr)
    ]

instance Crypto c => PrettyA (BootstrapWitness c) where
  prettyA :: BootstrapWitness c -> PDoc
prettyA = forall c. Crypto c => BootstrapWitness c -> PDoc
ppBootstrapWitness

ppWitnessSetHKD :: forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD :: forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD (ShelleyTxWits Set (WitVKey 'Witness (EraCrypto era))
addr Map (ScriptHash (EraCrypto era)) (Script era)
scr Set (BootstrapWitness (EraCrypto era))
boot) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ShelleyTxWits"
    [ (Text
"addrWits", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (forall era (keyrole :: KeyRole).
(Reflect era, Typeable keyrole) =>
Proof era -> WitVKey keyrole (EraCrypto era) -> PDoc
pcWitVKey @era forall era. Reflect era => Proof era
reify) Set (WitVKey 'Witness (EraCrypto era))
addr)
    , (Text
"scriptWits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall era. ScriptHash era -> PDoc
pcScriptHash (forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript forall era. Reflect era => Proof era
reify) Map (ScriptHash (EraCrypto era)) (Script era)
scr)
    , (Text
"bootWits", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. Crypto c => BootstrapWitness c -> PDoc
ppBootstrapWitness Set (BootstrapWitness (EraCrypto era))
boot)
    ]

instance Reflect era => PrettyA (ShelleyTxWits era) where
  prettyA :: ShelleyTxWits era -> PDoc
prettyA = forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD

-- TODO Redo this with Fields?
ppPParamsUpdate ::
  (ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8, EraPParams era) =>
  PParamsUpdate era ->
  PDoc
ppPParamsUpdate :: forall era.
(ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8,
 EraPParams era) =>
PParamsUpdate era -> PDoc
ppPParamsUpdate PParamsUpdate era
pp =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PParamsUdate"
    [ (Text
"minfeeA", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Coin -> PDoc
pcCoin forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL)
    , (Text
"minfeeB", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Coin -> PDoc
pcCoin forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeBL)
    , (Text
"maxBBSize", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall a. Word32 -> Doc a
ppWord32 forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxBBSizeL)
    , (Text
"maxTxSize", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall a. Word32 -> Doc a
ppWord32 forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxTxSizeL)
    , (Text
"maxBHSize", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall a. Word16 -> Doc a
ppWord16 forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuMaxBHSizeL)
    , (Text
"keyDeposit", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Coin -> PDoc
pcCoin forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuKeyDepositL)
    , (Text
"poolDeposit", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Coin -> PDoc
pcCoin forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuPoolDepositL)
    , (Text
"eMax", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall ann. EpochInterval -> Doc ann
ppEpochInterval forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuEMaxL)
    , (Text
"nOpt", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall a. Natural -> Doc a
ppNatural forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuNOptL)
    , (Text
"a0", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (forall a. Rational -> Doc a
ppRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. BoundedRational r => r -> Rational
unboundRational) forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuA0L)
    , (Text
"rho", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe UnitInterval -> PDoc
ppUnitInterval forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuRhoL)
    , (Text
"tau", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe UnitInterval -> PDoc
ppUnitInterval forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuTauL)
    , (Text
"d", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe UnitInterval -> PDoc
ppUnitInterval forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuDL)
    , (Text
"extraEntropy", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Nonce -> PDoc
ppNonce forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe Nonce)
ppuExtraEntropyL)
    , (Text
"protocolVersion", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe ProtVer -> PDoc
ppProtVer forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 8) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
ppuProtocolVersionL)
    , (Text
"minUTxOValue", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Coin -> PDoc
pcCoin forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinUTxOValueL)
    , (Text
"minPoolCost", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Coin -> PDoc
pcCoin forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinPoolCostL)
    ]

-- TODO Do we need all these instances?
-- Does this resolve the constraints  (ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8)
instance Crypto c => PrettyA (PParamsUpdate (ShelleyEra c)) where
  prettyA :: PParamsUpdate (ShelleyEra c) -> PDoc
prettyA = forall era.
(ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8,
 EraPParams era) =>
PParamsUpdate era -> PDoc
ppPParamsUpdate

instance Crypto c => PrettyA (PParamsUpdate (AllegraEra c)) where
  prettyA :: PParamsUpdate (AllegraEra c) -> PDoc
prettyA = forall era.
(ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8,
 EraPParams era) =>
PParamsUpdate era -> PDoc
ppPParamsUpdate

instance Crypto c => PrettyA (PParamsUpdate (MaryEra c)) where
  prettyA :: PParamsUpdate (MaryEra c) -> PDoc
prettyA = forall era.
(ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8,
 EraPParams era) =>
PParamsUpdate era -> PDoc
ppPParamsUpdate

instance Crypto c => PrettyA (PParamsUpdate (AlonzoEra c)) where
  prettyA :: PParamsUpdate (AlonzoEra c) -> PDoc
prettyA PParamsUpdate (AlonzoEra c)
_ = forall a. [Char] -> Doc a
ppString ([Char]
"PParamsUpdate (AlonzoEra c)")

instance Crypto c => PrettyA (PParamsUpdate (BabbageEra c)) where
  prettyA :: PParamsUpdate (BabbageEra c) -> PDoc
prettyA PParamsUpdate (BabbageEra c)
_ = forall a. [Char] -> Doc a
ppString ([Char]
"PParamsUpdate (BabbageEra c)")

instance Crypto c => PrettyA (PParamsUpdate (ConwayEra c)) where
  prettyA :: PParamsUpdate (ConwayEra c) -> PDoc
prettyA PParamsUpdate (ConwayEra c)
_ = forall a. [Char] -> Doc a
ppString ([Char]
"PParamsUpdate (ConwayEra c)")

ppUpdate :: PrettyA (PParamsUpdate era) => PParams.Update era -> PDoc
ppUpdate :: forall era. PrettyA (PParamsUpdate era) => Update era -> PDoc
ppUpdate (PParams.Update ProposedPPUpdates era
prop EpochNo
epn) = Text -> [PDoc] -> PDoc
ppSexp Text
"Update" [forall era.
PrettyA (PParamsUpdate era) =>
ProposedPPUpdates era -> PDoc
ppProposedPPUpdates ProposedPPUpdates era
prop, forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
epn]

instance PrettyA (PParamsUpdate e) => PrettyA (PParams.Update e) where
  prettyA :: Update e -> PDoc
prettyA = forall era. PrettyA (PParamsUpdate era) => Update era -> PDoc
ppUpdate

ppProposedPPUpdates :: PrettyA (PParamsUpdate era) => ProposedPPUpdates era -> PDoc
ppProposedPPUpdates :: forall era.
PrettyA (PParamsUpdate era) =>
ProposedPPUpdates era -> PDoc
ppProposedPPUpdates (ProposedPPUpdates Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
m) = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall t. PrettyA t => t -> PDoc
prettyA Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
m

instance PrettyA (PParamsUpdate e) => PrettyA (ProposedPPUpdates e) where
  prettyA :: ProposedPPUpdates e -> PDoc
prettyA = forall era.
PrettyA (PParamsUpdate era) =>
ProposedPPUpdates era -> PDoc
ppProposedPPUpdates

ppMetadatum :: Metadatum -> PDoc
ppMetadatum :: Metadatum -> PDoc
ppMetadatum (Map [(Metadatum, Metadatum)]
m) =
  let pairs :: [PDoc]
pairs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Metadatum
k, Metadatum
v) -> forall a. (Doc a, Doc a) -> Doc a
arrow (Metadatum -> PDoc
ppMetadatum Metadatum
k, Metadatum -> PDoc
ppMetadatum Metadatum
v)) [(Metadatum, Metadatum)]
m
   in Text -> [PDoc] -> PDoc
ppSexp
        Text
"Map"
        [ forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$
            forall a. Doc a -> Doc a -> Doc a
flatAlt
              (forall ann. Int -> Doc ann -> Doc ann
hang Int
1 (forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
puncLeft forall ann. Doc ann
lbrace [PDoc]
pairs forall ann. Doc ann
comma forall ann. Doc ann
rbrace))
              (forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep (forall ann. Doc ann
lbrace forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space) (forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rbrace) (forall ann. Doc ann
comma forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space) [PDoc]
pairs)
        ]
ppMetadatum (List [Metadatum]
ds) = Text -> [PDoc] -> PDoc
ppSexp Text
"List" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList Metadatum -> PDoc
ppMetadatum [Metadatum]
ds]
ppMetadatum (I Integer
n) = Text -> [PDoc] -> PDoc
ppSexp Text
"I" [forall a. Integer -> Doc a
ppInteger Integer
n]
ppMetadatum (B ByteString
bs) = Text -> [PDoc] -> PDoc
ppSexp Text
"B" [ByteString -> PDoc
ppLong ByteString
bs]
ppMetadatum (S Text
txt) = Text -> [PDoc] -> PDoc
ppSexp Text
"S" [forall ann. Text -> Doc ann
text Text
txt]

instance PrettyA Metadatum where
  prettyA :: Metadatum -> PDoc
prettyA = Metadatum -> PDoc
ppMetadatum

ppShelleyTxAuxData :: Era era => ShelleyTxAuxData era -> PDoc
ppShelleyTxAuxData :: forall era. Era era => ShelleyTxAuxData era -> PDoc
ppShelleyTxAuxData (ShelleyTxAuxData Map Word64 Metadatum
m) = forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' (forall ann. Text -> Doc ann
text Text
"ShelleyTxAuxData") forall a. Word64 -> Doc a
ppWord64 Metadatum -> PDoc
ppMetadatum Map Word64 Metadatum
m

instance Era era => PrettyA (ShelleyTxAuxData era) where
  prettyA :: ShelleyTxAuxData era -> PDoc
prettyA = forall era. Era era => ShelleyTxAuxData era -> PDoc
ppShelleyTxAuxData

ppAllegraTxAuxData ::
  (AllegraEraScript era, Reflect era, NativeScript era ~ Timelock era) => AllegraTxAuxData era -> PDoc
ppAllegraTxAuxData :: forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
AllegraTxAuxData era -> PDoc
ppAllegraTxAuxData (AllegraTxAuxData Map Word64 Metadatum
m StrictSeq (Timelock era)
sp) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"AllegraTxAuxData"
    [ (Text
"metadata", forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' (forall ann. Text -> Doc ann
text Text
"Metadata") forall a. Word64 -> Doc a
ppWord64 Metadatum -> PDoc
ppMetadatum Map Word64 Metadatum
m)
    , (Text
"auxiliaryScripts", forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq forall t. PrettyA t => t -> PDoc
prettyA StrictSeq (Timelock era)
sp)
    ]

instance
  (AllegraEraScript era, Reflect era, NativeScript era ~ Timelock era) =>
  PrettyA (AllegraTxAuxData era)
  where
  prettyA :: AllegraTxAuxData era -> PDoc
prettyA = forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
AllegraTxAuxData era -> PDoc
ppAllegraTxAuxData

ppAlonzoTxAuxData ::
  Reflect era =>
  AlonzoTxAuxData era ->
  PDoc
ppAlonzoTxAuxData :: forall era. Reflect era => AlonzoTxAuxData era -> PDoc
ppAlonzoTxAuxData AlonzoTxAuxData era
auxData =
  Text -> [PDoc] -> PDoc
ppSexp
    Text
"AuxiliaryData"
    [ forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall a. Word64 -> Doc a
ppWord64 Metadatum -> PDoc
ppMetadatum (forall era. AlonzoTxAuxData era -> Map Word64 Metadatum
atadMetadata' AlonzoTxAuxData era
auxData)
    , forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq (forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript forall era. Reflect era => Proof era
reify) (forall era.
Reflect era =>
AlonzoTxAuxData era -> StrictSeq (Script era)
extractAlonzoTxAuxDataScripts AlonzoTxAuxData era
auxData)
    ]

extractAlonzoTxAuxDataScripts ::
  forall era.
  Reflect era =>
  AlonzoTxAuxData era ->
  StrictSeq (Script era)
extractAlonzoTxAuxDataScripts :: forall era.
Reflect era =>
AlonzoTxAuxData era -> StrictSeq (Script era)
extractAlonzoTxAuxDataScripts AlonzoTxAuxData era
auxData =
  case forall era. Reflect era => Proof era
reify @era of
    Proof era
Shelley -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Allegra -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Mary -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Alonzo -> forall era.
AlonzoEraScript era =>
AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
getAlonzoTxAuxDataScripts AlonzoTxAuxData era
auxData
    Proof era
Babbage -> forall era.
AlonzoEraScript era =>
AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
getAlonzoTxAuxDataScripts AlonzoTxAuxData era
auxData
    Proof era
Conway -> forall era.
AlonzoEraScript era =>
AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
getAlonzoTxAuxDataScripts AlonzoTxAuxData era
auxData

instance
  (Reflect era, Script era ~ AlonzoScript era) =>
  PrettyA (AlonzoTxAuxData era)
  where
  prettyA :: AlonzoTxAuxData era -> PDoc
prettyA = forall era. Reflect era => AlonzoTxAuxData era -> PDoc
ppAlonzoTxAuxData

pcAuxData :: Proof era -> TxAuxData era -> PDoc
pcAuxData :: forall era. Proof era -> TxAuxData era -> PDoc
pcAuxData Proof era
Shelley TxAuxData era
x = forall era. Era era => ShelleyTxAuxData era -> PDoc
ppShelleyTxAuxData TxAuxData era
x
pcAuxData Proof era
Allegra TxAuxData era
x = forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
AllegraTxAuxData era -> PDoc
ppAllegraTxAuxData TxAuxData era
x
pcAuxData Proof era
Mary TxAuxData era
x = forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
AllegraTxAuxData era -> PDoc
ppAllegraTxAuxData TxAuxData era
x
pcAuxData Proof era
Alonzo TxAuxData era
x = forall era. Reflect era => AlonzoTxAuxData era -> PDoc
ppAlonzoTxAuxData TxAuxData era
x
pcAuxData Proof era
Babbage TxAuxData era
x = forall era. Reflect era => AlonzoTxAuxData era -> PDoc
ppAlonzoTxAuxData TxAuxData era
x
pcAuxData Proof era
Conway TxAuxData era
x = forall era. Reflect era => AlonzoTxAuxData era -> PDoc
ppAlonzoTxAuxData TxAuxData era
x

ppWithdrawals :: Withdrawals c -> PDoc
ppWithdrawals :: forall c. Withdrawals c -> PDoc
ppWithdrawals (Withdrawals Map (RewardAcnt c) Coin
m) = Text -> [PDoc] -> PDoc
ppSexp Text
"Withdrawals" [forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' (forall ann. Text -> Doc ann
text Text
"Wdr") forall c. RewardAccount c -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map (RewardAcnt c) Coin
m]

instance PrettyA (Withdrawals c) where
  prettyA :: Withdrawals c -> PDoc
prettyA = forall c. Withdrawals c -> PDoc
ppWithdrawals

ppWitHashes :: Set (KeyHash 'Witness c) -> PDoc
ppWitHashes :: forall c. Set (KeyHash 'Witness c) -> PDoc
ppWitHashes Set (KeyHash 'Witness c)
hs = Text -> [PDoc] -> PDoc
ppSexp Text
"WitHashes" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash Set (KeyHash 'Witness c)
hs]

-- ================================================
-- Pretty printers for Tx and TxBody
-- ================================================

ppShelleyTx ::
  Reflect era =>
  Tx era ->
  PDoc
ppShelleyTx :: forall era. Reflect era => Tx era -> PDoc
ppShelleyTx Tx era
tx =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Tx"
    [ (Text
"body", forall era. Proof era -> TxBody era -> PDoc
pcTxBody forall era. Reflect era => Proof era
reify forall a b. (a -> b) -> a -> b
$ Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL)
    , (Text
"witnessSet", forall era. Proof era -> TxWits era -> PDoc
ppCoreWitnesses forall era. Reflect era => Proof era
reify forall a b. (a -> b) -> a -> b
$ Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL)
    , (Text
"metadata", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (forall era. Proof era -> TxAuxData era -> PDoc
pcAuxData forall era. Reflect era => Proof era
reify) forall a b. (a -> b) -> a -> b
$ Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (AuxiliaryData era))
auxDataTxL)
    ]

instance
  ( Reflect era
  , Tx era ~ ShelleyTx era
  ) =>
  PrettyA (ShelleyTx era)
  where
  prettyA :: ShelleyTx era -> PDoc
prettyA = forall era. Reflect era => Tx era -> PDoc
ppShelleyTx

ppAlonzoTx ::
  forall era.
  (Reflect era, Tx era ~ AlonzoTx era) =>
  AlonzoTx era ->
  PDoc
ppAlonzoTx :: forall era.
(Reflect era, Tx era ~ AlonzoTx era) =>
AlonzoTx era -> PDoc
ppAlonzoTx AlonzoTx era
tx = Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"AlonzoTx" [(Text, PDoc)]
pairs
  where
    fields :: [TxField era]
fields = forall era. Proof era -> Tx era -> [TxField era]
abstractTx forall era. Reflect era => Proof era
reify AlonzoTx era
tx
    pairs :: [(Text, PDoc)]
pairs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall era.
Reflect era =>
Proof era -> TxField era -> [(Text, PDoc)]
pcTxField @era (forall era. Reflect era => Proof era
reify @era)) [TxField era]
fields

instance
  (Reflect era, Tx era ~ AlonzoTx era) =>
  PrettyA (AlonzoTx era)
  where
  prettyA :: AlonzoTx era -> PDoc
prettyA = forall era.
(Reflect era, Tx era ~ AlonzoTx era) =>
AlonzoTx era -> PDoc
ppAlonzoTx

ppShelleyTxBody ::
  ( Reflect era
  , PrettyA (PParamsUpdate era)
  ) =>
  ShelleyTxBody era ->
  PDoc
ppShelleyTxBody :: forall era.
(Reflect era, PrettyA (PParamsUpdate era)) =>
ShelleyTxBody era -> PDoc
ppShelleyTxBody (TxBodyConstr (Memo (ShelleyTxBodyRaw Set (TxIn (EraCrypto era))
ins StrictSeq (TxOut era)
outs StrictSeq (TxCert era)
cs Withdrawals (EraCrypto era)
withdrawals Coin
fee SlotNo
ttl StrictMaybe (Update era)
upd StrictMaybe (AuxiliaryDataHash (EraCrypto era))
mdh) ShortByteString
_)) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"TxBody"
    [ (Text
"inputs", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. TxIn c -> PDoc
pcTxIn Set (TxIn (EraCrypto era))
ins)
    , (Text
"outputs", forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) StrictSeq (TxOut era)
outs)
    , (Text
"cert", forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq (forall era. Proof era -> TxCert era -> PDoc
pcTxCert forall era. Reflect era => Proof era
reify) StrictSeq (TxCert era)
cs)
    , (Text
"withdrawals", forall c. Withdrawals c -> PDoc
ppWithdrawals Withdrawals (EraCrypto era)
withdrawals)
    , (Text
"fee", Coin -> PDoc
pcCoin Coin
fee)
    , (Text
"timetolive", SlotNo -> PDoc
pcSlotNo SlotNo
ttl)
    , (Text
"update", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall era. PrettyA (PParamsUpdate era) => Update era -> PDoc
ppUpdate StrictMaybe (Update era)
upd)
    , (Text
"metadatahash", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
mdh)
    ]

instance
  ( EraTxOut era
  , PrettyA (PParamsUpdate era)
  , Reflect era
  ) =>
  PrettyA (ShelleyTxBody era)
  where
  prettyA :: ShelleyTxBody era -> PDoc
prettyA = forall era.
(Reflect era, PrettyA (PParamsUpdate era)) =>
ShelleyTxBody era -> PDoc
ppShelleyTxBody

ppAllegraTxBody ::
  forall era. (TxBody era ~ AllegraTxBody era, Reflect era) => AllegraTxBody era -> PDoc
ppAllegraTxBody :: forall era.
(TxBody era ~ AllegraTxBody era, Reflect era) =>
AllegraTxBody era -> PDoc
ppAllegraTxBody AllegraTxBody era
txbody = Text -> [(Text, PDoc)] -> PDoc
ppRecord (Text
"TxBody " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show (forall era. Reflect era => Proof era
reify @era))) [(Text, PDoc)]
pairs
  where
    fields :: [TxBodyField era]
fields = forall era. Proof era -> TxBody era -> [TxBodyField era]
abstractTxBody forall era. Reflect era => Proof era
reify AllegraTxBody era
txbody
    pairs :: [(Text, PDoc)]
pairs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall era. Proof era -> TxBodyField era -> [(Text, PDoc)]
pcTxBodyField forall era. Reflect era => Proof era
reify) [TxBodyField era]
fields

instance (TxBody era ~ AllegraTxBody era, Reflect era) => PrettyA (AllegraTxBody era) where
  prettyA :: AllegraTxBody era -> PDoc
prettyA = forall era.
(TxBody era ~ AllegraTxBody era, Reflect era) =>
AllegraTxBody era -> PDoc
ppAllegraTxBody

ppAlonzoTxBody ::
  forall era. (TxBody era ~ AlonzoTxBody era, Reflect era) => AlonzoTxBody era -> PDoc
ppAlonzoTxBody :: forall era.
(TxBody era ~ AlonzoTxBody era, Reflect era) =>
AlonzoTxBody era -> PDoc
ppAlonzoTxBody AlonzoTxBody era
txbody = Text -> [(Text, PDoc)] -> PDoc
ppRecord (Text
"TxBody " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show (forall era. Reflect era => Proof era
reify @era))) [(Text, PDoc)]
pairs
  where
    fields :: [TxBodyField era]
fields = forall era. Proof era -> TxBody era -> [TxBodyField era]
abstractTxBody forall era. Reflect era => Proof era
reify AlonzoTxBody era
txbody
    pairs :: [(Text, PDoc)]
pairs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall era. Proof era -> TxBodyField era -> [(Text, PDoc)]
pcTxBodyField forall era. Reflect era => Proof era
reify) [TxBodyField era]
fields

instance (TxBody era ~ AlonzoTxBody era, Reflect era) => PrettyA (AlonzoTxBody era) where
  prettyA :: AlonzoTxBody era -> PDoc
prettyA = forall era.
(TxBody era ~ AlonzoTxBody era, Reflect era) =>
AlonzoTxBody era -> PDoc
ppAlonzoTxBody

ppMaryTxBody :: forall era. (TxBody era ~ MaryTxBody era, Reflect era) => MaryTxBody era -> PDoc
ppMaryTxBody :: forall era.
(TxBody era ~ MaryTxBody era, Reflect era) =>
MaryTxBody era -> PDoc
ppMaryTxBody MaryTxBody era
txbody = Text -> [(Text, PDoc)] -> PDoc
ppRecord (Text
"TxBody " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show (forall era. Reflect era => Proof era
reify @era))) [(Text, PDoc)]
pairs
  where
    fields :: [TxBodyField era]
fields = forall era. Proof era -> TxBody era -> [TxBodyField era]
abstractTxBody forall era. Reflect era => Proof era
reify MaryTxBody era
txbody
    pairs :: [(Text, PDoc)]
pairs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall era. Proof era -> TxBodyField era -> [(Text, PDoc)]
pcTxBodyField forall era. Reflect era => Proof era
reify) [TxBodyField era]
fields

instance (TxBody era ~ MaryTxBody era, Reflect era) => PrettyA (MaryTxBody era) where
  prettyA :: MaryTxBody era -> PDoc
prettyA = forall era.
(TxBody era ~ MaryTxBody era, Reflect era) =>
MaryTxBody era -> PDoc
ppMaryTxBody

-- =============================================================
-- Pretty Printers for Type families must have a (Proof era) as
-- an argument. Because they are type families, they cannot
-- have a PrettyA instance. As one cannot write an instance for
-- any type family.
-- ==============================================================

ppCoreWitnesses :: Proof era -> TxWits era -> PDoc
ppCoreWitnesses :: forall era. Proof era -> TxWits era -> PDoc
ppCoreWitnesses Proof era
Conway TxWits era
x = forall era. Reflect era => AlonzoTxWits era -> PDoc
ppTxWitness TxWits era
x
ppCoreWitnesses Proof era
Babbage TxWits era
x = forall era. Reflect era => AlonzoTxWits era -> PDoc
ppTxWitness TxWits era
x
ppCoreWitnesses Proof era
Alonzo TxWits era
x = forall era. Reflect era => AlonzoTxWits era -> PDoc
ppTxWitness TxWits era
x
ppCoreWitnesses Proof era
Mary TxWits era
x = forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD TxWits era
x
ppCoreWitnesses Proof era
Allegra TxWits era
x = forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD TxWits era
x
ppCoreWitnesses Proof era
Shelley TxWits era
x = forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD TxWits era
x

pcTxOut :: Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut :: forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut p :: Proof era
p@Proof era
Conway (BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
addr Value (ConwayEra StandardCrypto)
v Datum (ConwayEra StandardCrypto)
d StrictMaybe (Script (ConwayEra StandardCrypto))
s) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [forall c. Addr c -> PDoc
pcAddr Addr (EraCrypto (ConwayEra StandardCrypto))
addr, forall c. MaryValue c -> PDoc
pcValue Value (ConwayEra StandardCrypto)
v, forall era. Era era => Datum era -> PDoc
pcDatum Datum (ConwayEra StandardCrypto)
d, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
p) StrictMaybe (Script (ConwayEra StandardCrypto))
s]
pcTxOut p :: Proof era
p@Proof era
Babbage (BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
addr Value (BabbageEra StandardCrypto)
v Datum (BabbageEra StandardCrypto)
d StrictMaybe (Script (BabbageEra StandardCrypto))
s) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [forall c. Addr c -> PDoc
pcAddr Addr (EraCrypto (BabbageEra StandardCrypto))
addr, forall c. MaryValue c -> PDoc
pcValue Value (BabbageEra StandardCrypto)
v, forall era. Era era => Datum era -> PDoc
pcDatum Datum (BabbageEra StandardCrypto)
d, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
p) StrictMaybe (Script (BabbageEra StandardCrypto))
s]
pcTxOut Proof era
Alonzo (AlonzoTxOut Addr (EraCrypto (AlonzoEra StandardCrypto))
addr Value (AlonzoEra StandardCrypto)
v StrictMaybe (DataHash (EraCrypto (AlonzoEra StandardCrypto)))
md) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [forall c. Addr c -> PDoc
pcAddr Addr (EraCrypto (AlonzoEra StandardCrypto))
addr, forall c. MaryValue c -> PDoc
pcValue Value (AlonzoEra StandardCrypto)
v, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall era. DataHash era -> PDoc
pcDataHash StrictMaybe (DataHash (EraCrypto (AlonzoEra StandardCrypto)))
md]
pcTxOut p :: Proof era
p@Proof era
Mary (ShelleyTxOut Addr (EraCrypto (MaryEra StandardCrypto))
addr Value (MaryEra StandardCrypto)
v) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [forall c. Addr c -> PDoc
pcAddr Addr (EraCrypto (MaryEra StandardCrypto))
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value (MaryEra StandardCrypto)
v]
pcTxOut p :: Proof era
p@Proof era
Allegra (ShelleyTxOut Addr (EraCrypto (AllegraEra StandardCrypto))
addr Value (AllegraEra StandardCrypto)
v) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [forall c. Addr c -> PDoc
pcAddr Addr (EraCrypto (AllegraEra StandardCrypto))
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value (AllegraEra StandardCrypto)
v]
pcTxOut p :: Proof era
p@Proof era
Shelley (ShelleyTxOut Addr (EraCrypto (ShelleyEra StandardCrypto))
addr Value (ShelleyEra StandardCrypto)
v) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [forall c. Addr c -> PDoc
pcAddr Addr (EraCrypto (ShelleyEra StandardCrypto))
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value (ShelleyEra StandardCrypto)
v]

pcScript :: forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript :: forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
Conway (TimelockScript Timelock era
t) = forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock @era Timelock era
t
pcScript p :: Proof era
p@Proof era
Conway s :: Script era
s@(PlutusScript PlutusScript (ConwayEra StandardCrypto)
v) =
  forall ann. Doc ann -> Doc ann
parens (forall ann. [Doc ann] -> Doc ann
hsep [forall a. [Char] -> Doc a
ppString ([Char]
"PlutusScript " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript (ConwayEra StandardCrypto)
v) forall a. Semigroup a => a -> a -> a
<> [Char]
" "), forall era. Reflect era => Proof era -> Script era -> PDoc
pcHashScript Proof era
p Script era
s])
pcScript Proof era
Babbage (TimelockScript Timelock era
t) = forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock @era Timelock era
t
pcScript p :: Proof era
p@Proof era
Babbage s :: Script era
s@(PlutusScript PlutusScript (BabbageEra StandardCrypto)
v) =
  forall ann. Doc ann -> Doc ann
parens (forall ann. [Doc ann] -> Doc ann
hsep [forall a. [Char] -> Doc a
ppString ([Char]
"PlutusScript " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript (BabbageEra StandardCrypto)
v) forall a. Semigroup a => a -> a -> a
<> [Char]
" "), forall era. Reflect era => Proof era -> Script era -> PDoc
pcHashScript Proof era
p Script era
s])
pcScript Proof era
Alonzo (TimelockScript Timelock era
t) = forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock @era Timelock era
t
pcScript p :: Proof era
p@Proof era
Alonzo s :: Script era
s@(PlutusScript PlutusScript (AlonzoEra StandardCrypto)
v) =
  forall ann. Doc ann -> Doc ann
parens (forall ann. [Doc ann] -> Doc ann
hsep [forall a. [Char] -> Doc a
ppString ([Char]
"PlutusScript " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript (AlonzoEra StandardCrypto)
v) forall a. Semigroup a => a -> a -> a
<> [Char]
" "), forall era. Reflect era => Proof era -> Script era -> PDoc
pcHashScript Proof era
p Script era
s])
pcScript Proof era
Mary Script era
s = forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock @era Script era
s
pcScript Proof era
Allegra Script era
s = forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock @era Script era
s
pcScript p :: Proof era
p@Proof era
Shelley Script era
s = forall era.
(ShelleyEraScript era, Reflect era,
 NativeScript era ~ MultiSig era) =>
PDoc -> MultiSig era -> PDoc
pcMultiSig @era (forall era. Reflect era => Proof era -> Script era -> PDoc
pcHashScript @era Proof era
p Script era
s) Script era
s

pcWitnesses ::
  Reflect era =>
  Proof era ->
  TxWits era ->
  PDoc
pcWitnesses :: forall era. Reflect era => Proof era -> TxWits era -> PDoc
pcWitnesses Proof era
proof TxWits era
txwits = Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"Witnesses" [(Text, PDoc)]
pairs
  where
    fields :: [WitnessesField era]
fields = forall era. Proof era -> TxWits era -> [WitnessesField era]
abstractWitnesses Proof era
proof TxWits era
txwits
    pairs :: [(Text, PDoc)]
pairs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map (forall era.
Reflect era =>
Proof era -> WitnessesField era -> [(Text, PDoc)]
pcWitnessesField Proof era
proof) [WitnessesField era]
fields)

-- | Pretty print a Tx.
--   Also see Test.Cardano.Ledger.Constrained.Preds.Tx(pcTxWithUTxO)
--   which expands the inputs (given the UTxO)
pcTx :: Proof era -> Tx era -> PDoc
pcTx :: forall era. Proof era -> Tx era -> PDoc
pcTx Proof era
proof Tx era
tx = Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"Tx" [(Text, PDoc)]
pairs
  where
    fields :: [TxField era]
fields = forall era. Proof era -> Tx era -> [TxField era]
abstractTx Proof era
proof Tx era
tx
    pairs :: [(Text, PDoc)]
pairs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era.
Reflect era =>
Proof era -> TxField era -> [(Text, PDoc)]
pcTxField Proof era
proof) [TxField era]
fields

pcTxBody :: Proof era -> TxBody era -> PDoc
pcTxBody :: forall era. Proof era -> TxBody era -> PDoc
pcTxBody Proof era
proof TxBody era
txbody = Text -> [(Text, PDoc)] -> PDoc
ppRecord (Text
"TxBody " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show Proof era
proof)) [(Text, PDoc)]
pairs
  where
    fields :: [TxBodyField era]
fields = forall era. Proof era -> TxBody era -> [TxBodyField era]
abstractTxBody Proof era
proof TxBody era
txbody
    pairs :: [(Text, PDoc)]
pairs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall era. Proof era -> TxBodyField era -> [(Text, PDoc)]
pcTxBodyField Proof era
proof) [TxBodyField era]
fields

pcPParams :: Proof era -> PParams era -> PDoc
pcPParams :: forall era. Proof era -> PParams era -> PDoc
pcPParams Proof era
proof PParams era
pp = Text -> [(Text, PDoc)] -> PDoc
ppRecord (Text
"PParams " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show Proof era
proof)) [(Text, PDoc)]
pairs
  where
    fields :: [PParamsField era]
fields = forall era. Proof era -> PParams era -> [PParamsField era]
abstractPParams Proof era
proof PParams era
pp
    pairs :: [(Text, PDoc)]
pairs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall era. PParamsField era -> [(Text, PDoc)]
pcPParamsField [PParamsField era]
fields

-- | Unike other type families, PParams CAN have a PrettyA instance, as they
--   are a newtype wrapped around a type family.
instance Reflect era => PrettyA (PParams era) where
  prettyA :: PParams era -> PDoc
prettyA = forall era. Proof era -> PParams era -> PDoc
pcPParams forall era. Reflect era => Proof era
reify

-- =================================
-- Type families that have Fields, can be pretty printed (for all eras) by using
-- function that can pretty print each field.
-- =================================

pcTxBodyField ::
  Proof era ->
  TxBodyField era ->
  [(Text, PDoc)]
pcTxBodyField :: forall era. Proof era -> TxBodyField era -> [(Text, PDoc)]
pcTxBodyField Proof era
proof TxBodyField era
x = case TxBodyField era
x of
  Inputs Set (TxIn (EraCrypto era))
s -> [(Text
"spend inputs", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. TxIn c -> PDoc
pcTxIn Set (TxIn (EraCrypto era))
s)]
  Collateral Set (TxIn (EraCrypto era))
s -> [(Text
"coll inputs", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. TxIn c -> PDoc
pcTxIn Set (TxIn (EraCrypto era))
s)]
  RefInputs Set (TxIn (EraCrypto era))
s -> [(Text
"ref inputs", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. TxIn c -> PDoc
pcTxIn Set (TxIn (EraCrypto era))
s)]
  Outputs StrictSeq (TxOut era)
s -> [(Text
"outputs", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxOut era)
s))]
  CollateralReturn StrictMaybe (TxOut era)
SNothing -> []
  CollateralReturn (SJust TxOut era
txout) -> [(Text
"coll return", forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof TxOut era
txout)]
  TotalCol StrictMaybe Coin
SNothing -> []
  TotalCol (SJust Coin
c) -> [(Text
"total coll", Coin -> PDoc
pcCoin Coin
c)]
  Certs StrictSeq (TxCert era)
xs -> [(Text
"certs", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Proof era -> TxCert era -> PDoc
pcTxCert Proof era
proof) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxCert era)
xs))]
  Withdrawals' (Withdrawals Map (RewardAcnt (EraCrypto era)) Coin
m) -> [(Text
"withdrawal", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. RewardAccount c -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map (RewardAcnt (EraCrypto era)) Coin
m)]
  Txfee Coin
c -> [(Text
"fee", Coin -> PDoc
pcCoin Coin
c)]
  Vldt ValidityInterval
v -> [(Text
"validity interval", ValidityInterval -> PDoc
ppValidityInterval ValidityInterval
v)]
  TTL SlotNo
slot -> [(Text
"time to live", SlotNo -> PDoc
pcSlotNo SlotNo
slot)]
  Update StrictMaybe (Update era)
SNothing -> []
  Update (SJust Update era
_) -> [(Text
"update", forall a. [Char] -> Doc a
ppString [Char]
"UPDATE")]
  ReqSignerHashes Set (KeyHash 'Witness (EraCrypto era))
s -> [(Text
"required hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash Set (KeyHash 'Witness (EraCrypto era))
s)]
  Fields.Mint (MultiAsset Map (PolicyID (EraCrypto era)) (Map AssetName Integer)
m) -> [(Text
"minted", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. PolicyID c -> PDoc
pcPolicyID (forall k a. Map k a -> Set k
Map.keysSet Map (PolicyID (EraCrypto era)) (Map AssetName Integer)
m))]
  WppHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
SNothing -> []
  WppHash (SJust ScriptIntegrityHash (EraCrypto era)
h) -> [(Text
"integrity hash", PDoc -> PDoc
trim (forall c index. SafeHash c index -> PDoc
ppSafeHash ScriptIntegrityHash (EraCrypto era)
h))]
  AdHash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
SNothing -> []
  AdHash (SJust (AuxiliaryDataHash SafeHash (EraCrypto era) EraIndependentTxAuxData
h)) -> [(Text
"aux data hash", PDoc -> PDoc
trim (forall c index. SafeHash c index -> PDoc
ppSafeHash SafeHash (EraCrypto era) EraIndependentTxAuxData
h))]
  Txnetworkid StrictMaybe Network
SNothing -> [(Text
"network id", forall a. [Char] -> Doc a
ppString [Char]
"Nothing")]
  Txnetworkid (SJust Network
nid) -> [(Text
"network id", Network -> PDoc
pcNetwork Network
nid)]
  ProposalProc OSet (ProposalProcedure era)
props -> [(Text
"proposing procedure", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall era. ProposalProcedure era -> PDoc
pcProposalProcedure (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OSet (ProposalProcedure era)
props))]
  VotingProc VotingProcedures era
votes -> [(Text
"voting procedure", forall era. VotingProcedures era -> PDoc
pcVotingProcedures VotingProcedures era
votes)]
  CurrentTreasuryValue StrictMaybe Coin
ctv -> [(Text
"current treasury value", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Coin -> PDoc
pcCoin StrictMaybe Coin
ctv)]
  TreasuryDonation Coin
td -> [(Text
"treasury donation", Coin -> PDoc
pcCoin Coin
td)]

pcTxField ::
  forall era.
  Reflect era =>
  Proof era ->
  TxField era ->
  [(Text, PDoc)]
pcTxField :: forall era.
Reflect era =>
Proof era -> TxField era -> [(Text, PDoc)]
pcTxField Proof era
proof TxField era
x = case TxField era
x of
  Body TxBody era
b -> [(Text
"txbody hash", forall c index. SafeHash c index -> PDoc
ppSafeHash (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
b)), (Text
"body", forall era. Proof era -> TxBody era -> PDoc
pcTxBody Proof era
proof TxBody era
b)]
  BodyI [TxBodyField era]
xs -> [(Text
"body", Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"TxBody" (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map (forall era. Proof era -> TxBodyField era -> [(Text, PDoc)]
pcTxBodyField Proof era
proof) [TxBodyField era]
xs)))]
  TxWits TxWits era
w -> [(Text
"witnesses", forall era. Reflect era => Proof era -> TxWits era -> PDoc
pcWitnesses Proof era
proof TxWits era
w)]
  WitnessesI [WitnessesField era]
ws -> [(Text
"witnesses", Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"Witnesses" (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map (forall era.
Reflect era =>
Proof era -> WitnessesField era -> [(Text, PDoc)]
pcWitnessesField Proof era
proof) [WitnessesField era]
ws)))]
  AuxData StrictMaybe (TxAuxData era)
SNothing -> []
  AuxData (SJust TxAuxData era
auxdata) -> [(Text
"aux data", forall era. Proof era -> TxAuxData era -> PDoc
pcAuxData Proof era
proof TxAuxData era
auxdata)]
  Valid (IsValid Bool
v) -> [(Text
"is valid", forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show Bool
v))]

pcWitnessesField ::
  forall era.
  Reflect era =>
  Proof era ->
  WitnessesField era ->
  [(Text, PDoc)]
pcWitnessesField :: forall era.
Reflect era =>
Proof era -> WitnessesField era -> [(Text, PDoc)]
pcWitnessesField Proof era
proof WitnessesField era
x = case WitnessesField era
x of
  AddrWits Set (WitVKey 'Witness (EraCrypto era))
set -> [(Text
"key wits", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (forall era (keyrole :: KeyRole).
(Reflect era, Typeable keyrole) =>
Proof era -> WitVKey keyrole (EraCrypto era) -> PDoc
pcWitVKey Proof era
proof) Set (WitVKey 'Witness (EraCrypto era))
set)]
  BootWits Set (BootstrapWitness (EraCrypto era))
bwits -> [(Text
"boot wits", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (\BootstrapWitness StandardCrypto
z -> forall c (r :: KeyRole). Crypto c => VKey r c -> PDoc
ppVKey (forall c. Crypto c => BootstrapWitness c -> VKey 'Witness c
bwKey BootstrapWitness StandardCrypto
z)) Set (BootstrapWitness (EraCrypto era))
bwits)]
  ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
mp -> [(Text
"script wits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall era. ScriptHash era -> PDoc
pcScriptHash (forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
proof) Map (ScriptHash (EraCrypto era)) (Script era)
mp)]
  DataWits (TxDats Map (DataHash (EraCrypto era)) (Data era)
m) -> [(Text
"data wits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall era. DataHash era -> PDoc
pcDataHash forall era. Era era => Data era -> PDoc
pcData Map (DataHash (EraCrypto era)) (Data era)
m)]
  RdmrWits Redeemers era
m ->
    [(Text
"redeemer wits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall era. Reflect era => PlutusPurpose AsIx era -> PDoc
ppPlutusPurposeAsIx (forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
pcPair forall era. Era era => Data era -> PDoc
pcData ExUnits -> PDoc
pcExUnits) (forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers Redeemers era
m))]

pcPParamsField ::
  PParamsField era ->
  [(Text, PDoc)]
pcPParamsField :: forall era. PParamsField era -> [(Text, PDoc)]
pcPParamsField PParamsField era
x = case PParamsField era
x of
  MinfeeA Coin
coin -> [(Text
"minfeeA", Coin -> PDoc
pcCoin Coin
coin)]
  MinfeeB Coin
coin -> [(Text
"minfeeB", Coin -> PDoc
pcCoin Coin
coin)]
  MaxBBSize Word32
natural -> [(Text
"maxBBsize", forall a. Word32 -> Doc a
ppWord32 Word32
natural)]
  MaxTxSize Word32
natural -> [(Text
"maxTxsize", forall a. Word32 -> Doc a
ppWord32 Word32
natural)]
  MaxBHSize Word16
natural -> [(Text
"maxBHsize", forall a. Word16 -> Doc a
ppWord16 Word16
natural)]
  KeyDeposit Coin
coin -> [(Text
"keydeposit", Coin -> PDoc
pcCoin Coin
coin)]
  PoolDeposit Coin
coin -> [(Text
"pooldeposit", Coin -> PDoc
pcCoin Coin
coin)]
  EMax EpochInterval
n -> [(Text
"emax", forall ann. EpochInterval -> Doc ann
ppEpochInterval EpochInterval
n)]
  NOpt Natural
natural -> [(Text
"NOpt", forall a. Natural -> Doc a
ppNatural Natural
natural)]
  A0 NonNegativeInterval
i -> [(Text
"A0", forall a ann. Show a => a -> Doc ann
viaShow NonNegativeInterval
i)]
  Rho UnitInterval
u -> [(Text
"Rho", UnitInterval -> PDoc
ppUnitInterval UnitInterval
u)]
  Tau UnitInterval
u -> [(Text
"Tau", UnitInterval -> PDoc
ppUnitInterval UnitInterval
u)]
  D UnitInterval
u -> [(Text
"D", UnitInterval -> PDoc
ppUnitInterval UnitInterval
u)]
  ExtraEntropy Nonce
n -> [(Text
"extraEntropy", Nonce -> PDoc
ppNonce Nonce
n)]
  ProtocolVersion ProtVer
protVer -> [(Text
"ProtocolVersion", ProtVer -> PDoc
ppProtVer ProtVer
protVer)]
  MinPoolCost Coin
coin -> [(Text
"minPoolCost", Coin -> PDoc
pcCoin Coin
coin)]
  MinUTxOValue Coin
coin -> [(Text
"minUTxOValue", Coin -> PDoc
pcCoin Coin
coin)]
  CoinPerUTxOWord (CoinPerWord Coin
c) -> [(Text
"coinPerUTxOWord", Coin -> PDoc
pcCoin Coin
c)]
  CoinPerUTxOByte (CoinPerByte Coin
c) -> [(Text
"coinPerUTxOByte", Coin -> PDoc
pcCoin Coin
c)]
  Costmdls CostModels
_ -> [(Text
"costmodels", forall a. [Char] -> Doc a
ppString [Char]
"?")]
  Fields.Prices Prices
prices -> [(Text
"prices", Prices -> PDoc
ppPrices Prices
prices)]
  MaxTxExUnits ExUnits
e -> [(Text
"maxTxExUnits", ExUnits -> PDoc
pcExUnits ExUnits
e)]
  MaxBlockExUnits ExUnits
e -> [(Text
"maxBlockExUnits", ExUnits -> PDoc
pcExUnits ExUnits
e)]
  MaxValSize Natural
n -> [(Text
"maxValSize", forall a. Natural -> Doc a
ppNatural Natural
n)]
  CollateralPercentage Natural
n -> [(Text
"Collateral%", forall a. Natural -> Doc a
ppNatural Natural
n)]
  MaxCollateralInputs Natural
n -> [(Text
"maxCollateralInputs", forall a. Natural -> Doc a
ppNatural Natural
n)]
  PoolVotingThreshold PoolVotingThresholds
_ -> [(Text
"PoolVotingThresholds", forall a. [Char] -> Doc a
ppString [Char]
"?")]
  DRepVotingThreshold DRepVotingThresholds
_ -> [(Text
"DRepVotingThresholds", forall a. [Char] -> Doc a
ppString [Char]
"?")]
  MinCommitteeSize Natural
n -> [(Text
"minCommitteeSize", forall a. Natural -> Doc a
ppNatural Natural
n)]
  CommitteeTermLimit EpochInterval
n -> [(Text
"committeeTermLimit", forall ann. EpochInterval -> Doc ann
ppEpochInterval EpochInterval
n)]
  GovActionExpiration EpochInterval
epochNo -> [(Text
"govActionExpire", forall ann. EpochInterval -> Doc ann
ppEpochInterval EpochInterval
epochNo)]
  GovActionDeposit Coin
coin -> [(Text
"govActiondDeposit", Coin -> PDoc
pcCoin Coin
coin)]
  DRepDeposit Coin
coin -> [(Text
"drepdeposit", Coin -> PDoc
pcCoin Coin
coin)]
  DRepActivity EpochInterval
epochNo -> [(Text
"drepActivity", forall ann. EpochInterval -> Doc ann
ppEpochInterval EpochInterval
epochNo)]

-- =======================================================
-- @@
-- Pretty printers for PredicateFailures can be difficult because they often have componenents like
-- PredicateFailure (EraRule "LEDGER" era)
-- where both PredicateFailure and (EraRule "LEDGER" era) are type families.
-- Note that field can be different for every era. For example look at the type of the constructor
-- LedgerFailure :: PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era
-- So we must resort to case analysis over Proofs
-- So for some EraRule "XXX", we write ppXXX :: Proof era -> PredicateFailure (EraRule "XXX") -> PDoc
-- Complicated because some Eras do NOT have type instances for all (EraRule "XXX")

ppUTXOW :: Reflect era => Proof era -> PredicateFailure (EraRule "UTXOW" era) -> PDoc
ppUTXOW :: forall era.
Reflect era =>
Proof era -> PredicateFailure (EraRule "UTXOW" era) -> PDoc
ppUTXOW Proof era
Shelley PredicateFailure (EraRule "UTXOW" era)
x = forall era. Reflect era => ShelleyUtxowPredFailure era -> PDoc
ppShelleyUtxowPredFailure PredicateFailure (EraRule "UTXOW" era)
x
ppUTXOW Proof era
Allegra PredicateFailure (EraRule "UTXOW" era)
x = forall era. Reflect era => ShelleyUtxowPredFailure era -> PDoc
ppShelleyUtxowPredFailure PredicateFailure (EraRule "UTXOW" era)
x
ppUTXOW Proof era
Mary PredicateFailure (EraRule "UTXOW" era)
x = forall era. Reflect era => ShelleyUtxowPredFailure era -> PDoc
ppShelleyUtxowPredFailure PredicateFailure (EraRule "UTXOW" era)
x
ppUTXOW Proof era
Alonzo PredicateFailure (EraRule "UTXOW" era)
x = forall era. Reflect era => AlonzoUtxowPredFailure era -> PDoc
ppAlonzoUtxowPredFailure PredicateFailure (EraRule "UTXOW" era)
x
ppUTXOW p :: Proof era
p@Proof era
Babbage PredicateFailure (EraRule "UTXOW" era)
x = forall era.
Reflect era =>
Proof era -> BabbageUtxowPredFailure era -> PDoc
ppBabbageUtxowPredFailure Proof era
p PredicateFailure (EraRule "UTXOW" era)
x
ppUTXOW p :: Proof era
p@Proof era
Conway PredicateFailure (EraRule "UTXOW" era)
x = forall era.
Reflect era =>
Proof era -> ConwayUtxowPredFailure era -> PDoc
ppConwayUtxowPredFailure Proof era
p PredicateFailure (EraRule "UTXOW" era)
x

ppUTXOS :: Proof era -> PredicateFailure (EraRule "UTXOS" era) -> PDoc
ppUTXOS :: forall era.
Proof era -> PredicateFailure (EraRule "UTXOS" era) -> PDoc
ppUTXOS Proof era
Alonzo PredicateFailure (EraRule "UTXOS" era)
x = forall era. Reflect era => AlonzoUtxosPredFailure era -> PDoc
ppUtxosPredicateFailure PredicateFailure (EraRule "UTXOS" era)
x
ppUTXOS Proof era
Babbage PredicateFailure (EraRule "UTXOS" era)
x = forall era. Reflect era => AlonzoUtxosPredFailure era -> PDoc
ppUtxosPredicateFailure PredicateFailure (EraRule "UTXOS" era)
x
ppUTXOS Proof era
Conway PredicateFailure (EraRule "UTXOS" era)
x = forall t. PrettyA t => t -> PDoc
prettyA PredicateFailure (EraRule "UTXOS" era)
x
ppUTXOS Proof era
proof PredicateFailure (EraRule "UTXOS" era)
_ =
  forall a. HasCallStack => [Char] -> a
error
    ( [Char]
"Only the AlonzoEra, BabbageEra, and ConwayEra have a (PredicateFailure (EraRule \"UTXOS\" era))."
        forall a. [a] -> [a] -> [a]
++ [Char]
"This Era is "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Proof era
proof
    )

ppDELEGS :: Proof era -> PredicateFailure (EraRule "DELEGS" era) -> PDoc
ppDELEGS :: forall era.
Proof era -> PredicateFailure (EraRule "DELEGS" era) -> PDoc
ppDELEGS p :: Proof era
p@Proof era
Shelley PredicateFailure (EraRule "DELEGS" era)
x = forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
p PredicateFailure (EraRule "DELEGS" era)
x
ppDELEGS p :: Proof era
p@Proof era
Allegra PredicateFailure (EraRule "DELEGS" era)
x = forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
p PredicateFailure (EraRule "DELEGS" era)
x
ppDELEGS p :: Proof era
p@Proof era
Mary PredicateFailure (EraRule "DELEGS" era)
x = forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
p PredicateFailure (EraRule "DELEGS" era)
x
ppDELEGS p :: Proof era
p@Proof era
Alonzo PredicateFailure (EraRule "DELEGS" era)
x = forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
p PredicateFailure (EraRule "DELEGS" era)
x
ppDELEGS p :: Proof era
p@Proof era
Babbage PredicateFailure (EraRule "DELEGS" era)
x = forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
p PredicateFailure (EraRule "DELEGS" era)
x
ppDELEGS p :: Proof era
p@Proof era
Conway PredicateFailure (EraRule "DELEGS" era)
_ =
  forall a. HasCallStack => [Char] -> a
error
    ( [Char]
"Only the Shelley, Allegra, Mary, Alonzo, and Babbage era have a (PredicateFailure (EraRule \"DELEGS\" era))."
        forall a. [a] -> [a] -> [a]
++ [Char]
"This Era is "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Proof era
p
    )

ppDELEG :: Proof era -> PredicateFailure (EraRule "DELEG" era) -> PDoc
ppDELEG :: forall era.
Proof era -> PredicateFailure (EraRule "DELEG" era) -> PDoc
ppDELEG Proof era
Shelley PredicateFailure (EraRule "DELEG" era)
x = forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure PredicateFailure (EraRule "DELEG" era)
x
ppDELEG Proof era
Allegra PredicateFailure (EraRule "DELEG" era)
x = forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure PredicateFailure (EraRule "DELEG" era)
x
ppDELEG Proof era
Mary PredicateFailure (EraRule "DELEG" era)
x = forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure PredicateFailure (EraRule "DELEG" era)
x
ppDELEG Proof era
Alonzo PredicateFailure (EraRule "DELEG" era)
x = forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure PredicateFailure (EraRule "DELEG" era)
x
ppDELEG Proof era
Babbage PredicateFailure (EraRule "DELEG" era)
x = forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure PredicateFailure (EraRule "DELEG" era)
x
ppDELEG Proof era
Conway PredicateFailure (EraRule "DELEG" era)
x = forall era. ConwayDelegPredFailure era -> PDoc
ppConwayDelegPredFailure PredicateFailure (EraRule "DELEG" era)
x

ppPOOL :: Proof era -> PredicateFailure (EraRule "POOL" era) -> PDoc
ppPOOL :: forall era.
Proof era -> PredicateFailure (EraRule "POOL" era) -> PDoc
ppPOOL Proof era
Shelley PredicateFailure (EraRule "POOL" era)
x = forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
x
ppPOOL Proof era
Allegra PredicateFailure (EraRule "POOL" era)
x = forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
x
ppPOOL Proof era
Mary PredicateFailure (EraRule "POOL" era)
x = forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
x
ppPOOL Proof era
Alonzo PredicateFailure (EraRule "POOL" era)
x = forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
x
ppPOOL Proof era
Babbage PredicateFailure (EraRule "POOL" era)
x = forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
x
ppPOOL Proof era
Conway PredicateFailure (EraRule "POOL" era)
x = forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
x

ppLEDGER :: Reflect era => Proof era -> PredicateFailure (EraRule "LEDGER" era) -> PDoc
ppLEDGER :: forall era.
Reflect era =>
Proof era -> PredicateFailure (EraRule "LEDGER" era) -> PDoc
ppLEDGER p :: Proof era
p@Proof era
Shelley PredicateFailure (EraRule "LEDGER" era)
x = forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
x
ppLEDGER p :: Proof era
p@Proof era
Allegra PredicateFailure (EraRule "LEDGER" era)
x = forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
x
ppLEDGER p :: Proof era
p@Proof era
Mary PredicateFailure (EraRule "LEDGER" era)
x = forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
x
ppLEDGER p :: Proof era
p@Proof era
Alonzo PredicateFailure (EraRule "LEDGER" era)
x = forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
x
ppLEDGER p :: Proof era
p@Proof era
Babbage PredicateFailure (EraRule "LEDGER" era)
x = forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
x
ppLEDGER p :: Proof era
p@Proof era
Conway PredicateFailure (EraRule "LEDGER" era)
x = forall era.
Reflect era =>
Proof era -> ConwayLedgerPredFailure era -> PDoc
ppConwayLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
x

ppUTXO :: Proof era -> PredicateFailure (EraRule "UTXO" era) -> PDoc
ppUTXO :: forall era.
Proof era -> PredicateFailure (EraRule "UTXO" era) -> PDoc
ppUTXO Proof era
Shelley PredicateFailure (EraRule "UTXO" era)
x = forall era. Reflect era => ShelleyUtxoPredFailure era -> PDoc
ppShelleyUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
x
ppUTXO Proof era
Allegra PredicateFailure (EraRule "UTXO" era)
x = forall era. Reflect era => AllegraUtxoPredFailure era -> PDoc
ppAllegraUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
x
ppUTXO Proof era
Mary PredicateFailure (EraRule "UTXO" era)
x = forall era. Reflect era => AllegraUtxoPredFailure era -> PDoc
ppAllegraUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
x
ppUTXO Proof era
Alonzo PredicateFailure (EraRule "UTXO" era)
x = forall era. Reflect era => AlonzoUtxoPredFailure era -> PDoc
ppAlonzoUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
x
ppUTXO Proof era
Babbage PredicateFailure (EraRule "UTXO" era)
x = forall era. Reflect era => BabbageUtxoPredFailure era -> PDoc
ppBabbageUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
x
ppUTXO Proof era
Conway PredicateFailure (EraRule "UTXO" era)
x = forall era. Reflect era => ConwayUtxoPredFailure era -> PDoc
ppConwayUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
x

ppLEDGERS :: Proof era -> PredicateFailure (EraRule "LEDGERS" era) -> PDoc
ppLEDGERS :: forall era.
Proof era -> PredicateFailure (EraRule "LEDGERS" era) -> PDoc
ppLEDGERS p :: Proof era
p@Proof era
Shelley PredicateFailure (EraRule "LEDGERS" era)
x = forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
x
ppLEDGERS p :: Proof era
p@Proof era
Allegra PredicateFailure (EraRule "LEDGERS" era)
x = forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
x
ppLEDGERS p :: Proof era
p@Proof era
Mary PredicateFailure (EraRule "LEDGERS" era)
x = forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
x
ppLEDGERS p :: Proof era
p@Proof era
Alonzo PredicateFailure (EraRule "LEDGERS" era)
x = forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
x
ppLEDGERS p :: Proof era
p@Proof era
Babbage PredicateFailure (EraRule "LEDGERS" era)
x = forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
x
ppLEDGERS p :: Proof era
p@Proof era
Conway PredicateFailure (EraRule "LEDGERS" era)
x = forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
x

ppDELPL :: Proof era -> PredicateFailure (EraRule "DELPL" era) -> PDoc
ppDELPL :: forall era.
Proof era -> PredicateFailure (EraRule "DELPL" era) -> PDoc
ppDELPL p :: Proof era
p@Proof era
Shelley PredicateFailure (EraRule "DELPL" era)
x = forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p PredicateFailure (EraRule "DELPL" era)
x
ppDELPL p :: Proof era
p@Proof era
Allegra PredicateFailure (EraRule "DELPL" era)
x = forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p PredicateFailure (EraRule "DELPL" era)
x
ppDELPL p :: Proof era
p@Proof era
Mary PredicateFailure (EraRule "DELPL" era)
x = forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p PredicateFailure (EraRule "DELPL" era)
x
ppDELPL p :: Proof era
p@Proof era
Alonzo PredicateFailure (EraRule "DELPL" era)
x = forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p PredicateFailure (EraRule "DELPL" era)
x
ppDELPL p :: Proof era
p@Proof era
Babbage PredicateFailure (EraRule "DELPL" era)
x = forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p PredicateFailure (EraRule "DELPL" era)
x
ppDELPL p :: Proof era
p@Proof era
Conway PredicateFailure (EraRule "DELPL" era)
_ =
  forall a. HasCallStack => [Char] -> a
error
    ( [Char]
"Only the Shelley, Allegra, Mary, Alonzo, and Babbage era have a (PredicateFailure (EraRule \"DELPL\" era))."
        forall a. [a] -> [a] -> [a]
++ [Char]
"This Era is "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Proof era
p
    )

ppNEWEPOCH :: Proof era -> PredicateFailure (EraRule "NEWEPOCH" era) -> PDoc
ppNEWEPOCH :: forall era.
Proof era -> PredicateFailure (EraRule "NEWEPOCH" era) -> PDoc
ppNEWEPOCH Proof era
Shelley PredicateFailure (EraRule "NEWEPOCH" era)
x = forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure PredicateFailure (EraRule "NEWEPOCH" era)
x
ppNEWEPOCH Proof era
Allegra PredicateFailure (EraRule "NEWEPOCH" era)
x = forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure PredicateFailure (EraRule "NEWEPOCH" era)
x
ppNEWEPOCH Proof era
Mary PredicateFailure (EraRule "NEWEPOCH" era)
x = forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure PredicateFailure (EraRule "NEWEPOCH" era)
x
ppNEWEPOCH Proof era
Alonzo PredicateFailure (EraRule "NEWEPOCH" era)
x = forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure PredicateFailure (EraRule "NEWEPOCH" era)
x
ppNEWEPOCH Proof era
Babbage PredicateFailure (EraRule "NEWEPOCH" era)
x = forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure PredicateFailure (EraRule "NEWEPOCH" era)
x
ppNEWEPOCH Proof era
Conway PredicateFailure (EraRule "NEWEPOCH" era)
x = forall era. ConwayNewEpochPredFailure era -> PDoc
ppConwayNewEpochPredFailure PredicateFailure (EraRule "NEWEPOCH" era)
x

ppEPOCH :: Proof era -> PredicateFailure (EraRule "EPOCH" era) -> PDoc
ppEPOCH :: forall era.
Proof era -> PredicateFailure (EraRule "EPOCH" era) -> PDoc
ppEPOCH Proof era
Shelley PredicateFailure (EraRule "EPOCH" era)
x = forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure PredicateFailure (EraRule "EPOCH" era)
x
ppEPOCH Proof era
Allegra PredicateFailure (EraRule "EPOCH" era)
x = forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure PredicateFailure (EraRule "EPOCH" era)
x
ppEPOCH Proof era
Mary PredicateFailure (EraRule "EPOCH" era)
x = forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure PredicateFailure (EraRule "EPOCH" era)
x
ppEPOCH Proof era
Alonzo PredicateFailure (EraRule "EPOCH" era)
x = forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure PredicateFailure (EraRule "EPOCH" era)
x
ppEPOCH Proof era
Babbage PredicateFailure (EraRule "EPOCH" era)
x = forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure PredicateFailure (EraRule "EPOCH" era)
x
ppEPOCH Proof era
Conway PredicateFailure (EraRule "EPOCH" era)
_ = forall a. [Char] -> Doc a
ppString [Char]
"PredicateFailure (ConwayEPOCH era) = Void, and can never Fail"

-- | A bit different since it is NOT of the form: PredicateFailure (EraRule "LEDGERS" era)
--   but instead:  State (EraRule "LEDGERS" era)
--   But the effect is still the same. The Proof era, fixes the type family result.
ppStateLEDGERS :: Proof era -> State (EraRule "LEDGERS" era) -> PDoc
ppStateLEDGERS :: forall era. Proof era -> State (EraRule "LEDGERS" era) -> PDoc
ppStateLEDGERS p :: Proof era
p@Proof era
Shelley = forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p
ppStateLEDGERS p :: Proof era
p@Proof era
Allegra = forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p
ppStateLEDGERS p :: Proof era
p@Proof era
Mary = forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p
ppStateLEDGERS p :: Proof era
p@Proof era
Alonzo = forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p
ppStateLEDGERS p :: Proof era
p@Proof era
Babbage = forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p
ppStateLEDGERS p :: Proof era
p@Proof era
Conway = forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p

-- ============================================================================
-- pretty printers for concrete types that are the target of PredicateFailure type instances

ppShelleyDelegsPredFailure :: forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure :: forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
_ (Shelley.DelegateeNotRegisteredDELEG KeyHash 'StakePool (EraCrypto era)
x) = forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool (EraCrypto era)
x
ppShelleyDelegsPredFailure Proof era
_ (WithdrawalsNotInRewardsDELEGS Map (RewardAccount (EraCrypto era)) Coin
x) = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. RewardAccount c -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map (RewardAccount (EraCrypto era)) Coin
x
ppShelleyDelegsPredFailure Proof era
p (DelplFailure PredicateFailure (EraRule "DELPL" era)
x) = forall era.
Proof era -> PredicateFailure (EraRule "DELPL" era) -> PDoc
ppDELPL Proof era
p PredicateFailure (EraRule "DELPL" era)
x

instance Reflect era => PrettyA (ShelleyDelegsPredFailure era) where
  prettyA :: ShelleyDelegsPredFailure era -> PDoc
prettyA = forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure forall era. Reflect era => Proof era
reify

ppConwayUtxoPredFailure ::
  forall era.
  Reflect era =>
  ConwayRules.ConwayUtxoPredFailure era ->
  PDoc
ppConwayUtxoPredFailure :: forall era. Reflect era => ConwayUtxoPredFailure era -> PDoc
ppConwayUtxoPredFailure = \case
  ConwayRules.UtxosFailure PredicateFailure (EraRule "UTXOS" era)
yy -> Text -> [PDoc] -> PDoc
ppSexp Text
"UtxosFailure" [forall era.
Proof era -> PredicateFailure (EraRule "UTXOS" era) -> PDoc
ppUTXOS @era forall era. Reflect era => Proof era
reify PredicateFailure (EraRule "UTXOS" era)
yy]
  ConwayRules.BadInputsUTxO Set (TxIn (EraCrypto era))
txins -> Text -> [PDoc] -> PDoc
ppSexp Text
"BadInputsUTxO" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. TxIn c -> PDoc
pcTxIn Set (TxIn (EraCrypto era))
txins]
  ConwayRules.OutsideValidityIntervalUTxO ValidityInterval
vi SlotNo
slot ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"OutsideValidityIntervalUTxO"
      [ (Text
"provided interval", ValidityInterval -> PDoc
ppValidityInterval ValidityInterval
vi)
      , (Text
"current slot", SlotNo -> PDoc
pcSlotNo SlotNo
slot)
      ]
  ConwayRules.MaxTxSizeUTxO Integer
actual Integer
maxs ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"MaxTxSizeUTxO" [(Text
"Actual", forall a. Integer -> Doc a
ppInteger Integer
actual), (Text
"max transaction size", forall a. Integer -> Doc a
ppInteger Integer
maxs)]
  ConwayUtxoPredFailure era
ConwayRules.InputSetEmptyUTxO -> forall a. [Char] -> Doc a
ppString [Char]
"InputSetEmptyUTxO"
  ConwayRules.FeeTooSmallUTxO Coin
computed Coin
supplied ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"FeeTooSmallUTxO"
      [ (Text
"min fee for this transaction", Coin -> PDoc
pcCoin Coin
computed)
      , (Text
"fee supplied by this transaction", Coin -> PDoc
pcCoin Coin
supplied)
      ]
  ConwayRules.ValueNotConservedUTxO Value era
consumed Value era
produced ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ValueNotConservedUTxO"
      [(Text
"coin consumed", forall era. Proof era -> Value era -> PDoc
pcVal @era forall era. Reflect era => Proof era
reify Value era
consumed), (Text
"coin produced", forall era. Proof era -> Value era -> PDoc
pcVal @era forall era. Reflect era => Proof era
reify Value era
produced)]
  ConwayRules.WrongNetwork Network
n Set (Addr (EraCrypto era))
add ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"WrongNetwork"
      [ (Text
"expected network id", Network -> PDoc
ppNetwork Network
n)
      , (Text
"set of addresses with wrong network id", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. Addr c -> PDoc
pcAddr Set (Addr (EraCrypto era))
add)
      ]
  ConwayRules.WrongNetworkWithdrawal Network
n Set (RewardAccount (EraCrypto era))
accnt ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"WrongNetworkWithdrawal"
      [ (Text
"expected network id", Network -> PDoc
ppNetwork Network
n)
      , (Text
"set reward address with wrong network id", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. RewardAccount c -> PDoc
pcRewardAccount Set (RewardAccount (EraCrypto era))
accnt)
      ]
  ConwayRules.OutputTooSmallUTxO [TxOut era]
xs ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"OutputTooSmallUTxO"
      [(Text
"list of supplied transaction outputs that are too small", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
  ConwayRules.OutputBootAddrAttrsTooBig [TxOut era]
xs ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"OutputBootAddrAttrsTooBig"
      [(Text
"list of supplied bad transaction outputs", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
  ConwayRules.OutputTooBigUTxO [(Int, Int, TxOut era)]
xs ->
    Text -> [PDoc] -> PDoc
ppSexp
      Text
"OutputTooBigUTxO"
      [ forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList
          ( \(Int
a, Int
b, TxOut era
c) ->
              PDoc -> [(Text, PDoc)] -> PDoc
ppRecord'
                PDoc
""
                [(Text
"actual size", forall a. Int -> Doc a
ppInt Int
a), (Text
"PParam max value", forall a. Int -> Doc a
ppInt Int
b), (Text
"TxOut", forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify TxOut era
c)]
          )
          [(Int, Int, TxOut era)]
xs
      ]
  ConwayRules.InsufficientCollateral DeltaCoin
c1 Coin
c2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"InsufficientCollateral"
      [ (Text
"balance computed", forall t. PrettyA t => t -> PDoc
prettyA DeltaCoin
c1)
      , (Text
"the required collateral for the given fee", Coin -> PDoc
pcCoin Coin
c2)
      ]
  ConwayRules.ScriptsNotPaidUTxO UTxO era
u -> Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNotPaidUTxO" [forall era. Proof era -> UTxO era -> PDoc
pcUTxO forall era. Reflect era => Proof era
reify UTxO era
u]
  ConwayRules.ExUnitsTooBigUTxO ExUnits
e1 ExUnits
e2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ExUnitsTooBigUTxO"
      [ (Text
"Max EXUnits from the protocol parameters", ExUnits -> PDoc
pcExUnits ExUnits
e1)
      , (Text
"EXUnits supplied", ExUnits -> PDoc
pcExUnits ExUnits
e2)
      ]
  ConwayRules.CollateralContainsNonADA Value era
v -> Text -> [PDoc] -> PDoc
ppSexp Text
"CollateralContainsNonADA" [forall era. Proof era -> Value era -> PDoc
pcVal (forall era. Reflect era => Proof era
reify @era) Value era
v]
  ConwayRules.WrongNetworkInTxBody Network
n1 Network
n2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"WrongNetworkInTxBody"
      [ (Text
"Actual Network ID", Network -> PDoc
ppNetwork Network
n1)
      , (Text
"Network ID in transaction body", Network -> PDoc
ppNetwork Network
n2)
      ]
  ConwayRules.OutsideForecast SlotNo
slot -> Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"OutsideForecast" [(Text
"slot number outside consensus forecast range", SlotNo -> PDoc
pcSlotNo SlotNo
slot)]
  ConwayRules.TooManyCollateralInputs Natural
n1 Natural
n2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"TooManyCollateralInputs"
      [ (Text
"Max allowed collateral inputs", forall a. Natural -> Doc a
ppNatural Natural
n1)
      , (Text
"Number of collateral inputs", forall a. Natural -> Doc a
ppNatural Natural
n2)
      ]
  ConwayUtxoPredFailure era
ConwayRules.NoCollateralInputs -> Text -> [PDoc] -> PDoc
ppSexp Text
" NoCollateralInputs" []
  ConwayRules.IncorrectTotalCollateralField DeltaCoin
c1 Coin
c2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"IncorrectTotalCollateralField"
      [(Text
"collateral provided", forall t. PrettyA t => t -> PDoc
prettyA DeltaCoin
c1), (Text
"collateral declared", Coin -> PDoc
pcCoin Coin
c2)]
  ConwayRules.BabbageOutputTooSmallUTxO [(TxOut era, Coin)]
xs ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"BabbageOutputTooSmallUTxO" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) Coin -> PDoc
pcCoin) [(TxOut era, Coin)]
xs]
  ConwayRules.BabbageNonDisjointRefInputs NonEmpty (TxIn (EraCrypto era))
xs ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"BabbageNonDisjointRefInputs" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall c. TxIn c -> PDoc
pcTxIn (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (TxIn (EraCrypto era))
xs)]

instance
  Reflect era =>
  PrettyA (ConwayRules.ConwayUtxoPredFailure era)
  where
  prettyA :: ConwayUtxoPredFailure era -> PDoc
prettyA = forall era. Reflect era => ConwayUtxoPredFailure era -> PDoc
ppConwayUtxoPredFailure

ppBabbageUtxoPredFailure :: Reflect era => BabbageUtxoPredFailure era -> PDoc
ppBabbageUtxoPredFailure :: forall era. Reflect era => BabbageUtxoPredFailure era -> PDoc
ppBabbageUtxoPredFailure (AlonzoInBabbageUtxoPredFailure AlonzoUtxoPredFailure era
x) = forall era. Reflect era => AlonzoUtxoPredFailure era -> PDoc
ppAlonzoUtxoPredFailure AlonzoUtxoPredFailure era
x
ppBabbageUtxoPredFailure (IncorrectTotalCollateralField DeltaCoin
c1 Coin
c2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"IncorrectTotalCollateralField"
    [(Text
"collateral provided", forall t. PrettyA t => t -> PDoc
prettyA DeltaCoin
c1), (Text
"collateral declared", forall t. PrettyA t => t -> PDoc
prettyA Coin
c2)]
ppBabbageUtxoPredFailure (BabbageOutputTooSmallUTxO [(TxOut era, Coin)]
xs) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"BabbageOutputTooSmallUTxO" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) Coin -> PDoc
pcCoin) [(TxOut era, Coin)]
xs]
ppBabbageUtxoPredFailure (BabbageNonDisjointRefInputs NonEmpty (TxIn (EraCrypto era))
xs) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"BabbageNonDisjointRefInputs" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall c. TxIn c -> PDoc
pcTxIn (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (TxIn (EraCrypto era))
xs)]

instance Reflect era => PrettyA (BabbageUtxoPredFailure era) where
  prettyA :: BabbageUtxoPredFailure era -> PDoc
prettyA = forall era. Reflect era => BabbageUtxoPredFailure era -> PDoc
ppBabbageUtxoPredFailure

ppShelleyLedgersPredFailure :: Reflect era => Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure :: forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p (LedgerFailure PredicateFailure (EraRule "LEDGER" era)
x) = forall era.
Reflect era =>
Proof era -> PredicateFailure (EraRule "LEDGER" era) -> PDoc
ppLEDGER Proof era
p PredicateFailure (EraRule "LEDGER" era)
x

instance Reflect era => PrettyA (ShelleyLedgersPredFailure era) where
  prettyA :: ShelleyLedgersPredFailure era -> PDoc
prettyA = forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure forall era. Reflect era => Proof era
reify

ppConwayLedgerPredFailure :: Reflect era => Proof era -> ConwayLedgerPredFailure era -> PDoc
ppConwayLedgerPredFailure :: forall era.
Reflect era =>
Proof era -> ConwayLedgerPredFailure era -> PDoc
ppConwayLedgerPredFailure Proof era
proof ConwayLedgerPredFailure era
x = case ConwayLedgerPredFailure era
x of
  ConwayWdrlNotDelegatedToDRep NonEmpty (KeyHash 'Staking (EraCrypto era))
s -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayWdrlNotDelegatedToDRep" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (KeyHash 'Staking (EraCrypto era))
s]
  ConwayTreasuryValueMismatch Coin
c1 Coin
c2 -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayTreasuryValueMismatch" [Coin -> PDoc
pcCoin Coin
c1, Coin -> PDoc
pcCoin Coin
c2]
  ConwayGovFailure PredicateFailure (EraRule "GOV" era)
y -> case Proof era
proof of
    Proof era
Conway -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayGovFailure" [forall era. ConwayGovPredFailure era -> PDoc
ppConwayGovPredFailure PredicateFailure (EraRule "GOV" era)
y]
    Proof era
_ ->
      forall a. HasCallStack => [Char] -> a
error
        ([Char]
"Only the ConwayEra has a (PredicateFailure (EraRule \"GOV\" era)). This Era is " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Proof era
proof)
  ConwayUtxowFailure PredicateFailure (EraRule "UTXOW" era)
y -> forall era.
Reflect era =>
Proof era -> PredicateFailure (EraRule "UTXOW" era) -> PDoc
ppUTXOW Proof era
proof PredicateFailure (EraRule "UTXOW" era)
y
  ConwayCertsFailure PredicateFailure (EraRule "CERTS" era)
pf -> case Proof era
proof of
    Proof era
Conway -> forall era. Proof era -> ConwayCertsPredFailure era -> PDoc
ppConwayCertsPredFailure Proof era
proof PredicateFailure (EraRule "CERTS" era)
pf
    Proof era
_ ->
      forall a. HasCallStack => [Char] -> a
error
        ([Char]
"Only the ConwayEra has a (PredicateFailure (EraRule \"CERTS\" era)). This Era is " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Proof era
proof)
  ConwayTxRefScriptsSizeTooBig Int
s1 Int
s2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ConwayTxRefScriptsSizeTooBig"
      [ (Text
"Computed sum of reference script size", forall a. Int -> Doc a
ppInt Int
s1)
      , (Text
"Maximum allowed total reference script size", forall a. Int -> Doc a
ppInt Int
s2)
      ]
  ConwayMempoolFailure Text
t ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayMempoolFailure" [forall ann. Text -> Doc ann
text Text
t]

instance Reflect era => PrettyA (ConwayLedgerPredFailure era) where
  prettyA :: ConwayLedgerPredFailure era -> PDoc
prettyA = forall era.
Reflect era =>
Proof era -> ConwayLedgerPredFailure era -> PDoc
ppConwayLedgerPredFailure forall era. Reflect era => Proof era
reify

ppConwayCertPredFailure :: Proof era -> ConwayRules.ConwayCertPredFailure era -> PDoc
ppConwayCertPredFailure :: forall era. Proof era -> ConwayCertPredFailure era -> PDoc
ppConwayCertPredFailure Proof era
proof ConwayCertPredFailure era
x = case ConwayCertPredFailure era
x of
  ConwayRules.DelegFailure PredicateFailure (EraRule "DELEG" era)
pf -> Text -> [PDoc] -> PDoc
ppSexp Text
"DelegFailure" [forall era.
Proof era -> PredicateFailure (EraRule "DELEG" era) -> PDoc
ppDELEG Proof era
proof PredicateFailure (EraRule "DELEG" era)
pf] -- (PredicateFailure (EraRule "DELEG" era))
  ConwayRules.PoolFailure PredicateFailure (EraRule "POOL" era)
pf -> Text -> [PDoc] -> PDoc
ppSexp Text
".PoolFailure" [forall era.
Proof era -> PredicateFailure (EraRule "POOL" era) -> PDoc
ppPOOL Proof era
proof PredicateFailure (EraRule "POOL" era)
pf] -- (PredicateFailure (EraRule "POOL" era))
  ConwayRules.GovCertFailure PredicateFailure (EraRule "GOVCERT" era)
pf -> case Proof era
proof of
    Proof era
Conway -> Text -> [PDoc] -> PDoc
ppSexp Text
"GovCertFailure" [forall era. ConwayGovCertPredFailure era -> PDoc
ppConwayGovCertPredFailure PredicateFailure (EraRule "GOVCERT" era)
pf] -- (PredicateFailure (EraRule "GOVCERT" era))
    Proof era
_ ->
      forall a. HasCallStack => [Char] -> a
error
        ([Char]
"Only the ConwayEra has a (PredicateFailure (EraRule \"GOVCERT\" era)). This Era is " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Proof era
proof)

instance Reflect era => PrettyA (ConwayRules.ConwayCertPredFailure era) where
  prettyA :: ConwayCertPredFailure era -> PDoc
prettyA = forall era. Proof era -> ConwayCertPredFailure era -> PDoc
ppConwayCertPredFailure forall era. Reflect era => Proof era
reify

ppConwayGovCertPredFailure :: ConwayGovCertPredFailure era -> PDoc
ppConwayGovCertPredFailure :: forall era. ConwayGovCertPredFailure era -> PDoc
ppConwayGovCertPredFailure ConwayGovCertPredFailure era
z = case ConwayGovCertPredFailure era
z of
  ConwayDRepAlreadyRegistered Credential 'DRepRole (EraCrypto era)
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayDRepAlreadyRegistered" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'DRepRole (EraCrypto era)
x]
  ConwayDRepNotRegistered Credential 'DRepRole (EraCrypto era)
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayDRepNotRegistered" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'DRepRole (EraCrypto era)
x]
  ConwayDRepIncorrectDeposit Coin
c1 Coin
c2 -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayDRepIncorrectDeposit" [Coin -> PDoc
pcCoin Coin
c1, Coin -> PDoc
pcCoin Coin
c2]
  ConwayCommitteeHasPreviouslyResigned Credential 'ColdCommitteeRole (EraCrypto era)
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayCommitteeHasPreviouslyResigned" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'ColdCommitteeRole (EraCrypto era)
x]
  ConwayDRepIncorrectRefund Coin
c1 Coin
c2 -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayDRepIncorrectRefund" [Coin -> PDoc
pcCoin Coin
c1, Coin -> PDoc
pcCoin Coin
c2]
  ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole (EraCrypto era)
c -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayCommitteeIsUnknown" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'ColdCommitteeRole (EraCrypto era)
c]

instance PrettyA (ConwayGovCertPredFailure era) where
  prettyA :: ConwayGovCertPredFailure era -> PDoc
prettyA = forall era. ConwayGovCertPredFailure era -> PDoc
ppConwayGovCertPredFailure

ppConwayCertsPredFailure :: Proof era -> ConwayCertsPredFailure era -> PDoc
ppConwayCertsPredFailure :: forall era. Proof era -> ConwayCertsPredFailure era -> PDoc
ppConwayCertsPredFailure Proof era
proof ConwayCertsPredFailure era
x = case ConwayCertsPredFailure era
x of
  WithdrawalsNotInRewardsCERTS Map (RewardAccount (EraCrypto era)) Coin
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"WithdrawalsNotInRewardsCERTS" [forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. RewardAccount c -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map (RewardAccount (EraCrypto era)) Coin
m]
  CertFailure PredicateFailure (EraRule "CERT" era)
pf -> case Proof era
proof of
    Proof era
Conway -> Text -> [PDoc] -> PDoc
ppSexp Text
" CertFailure" [forall era. Proof era -> ConwayCertPredFailure era -> PDoc
ppConwayCertPredFailure Proof era
proof PredicateFailure (EraRule "CERT" era)
pf] -- !(PredicateFailure (EraRule "CERT" era))
    Proof era
_ ->
      forall a. HasCallStack => [Char] -> a
error
        ([Char]
"Only the ConwayEra has a (PredicateFailure (EraRule \"CERT\" era)). This Era is " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Proof era
proof)

instance Reflect era => PrettyA (ConwayCertsPredFailure era) where
  prettyA :: ConwayCertsPredFailure era -> PDoc
prettyA = forall era. Proof era -> ConwayCertsPredFailure era -> PDoc
ppConwayCertsPredFailure forall era. Reflect era => Proof era
reify

ppConwayGovPredFailure :: ConwayGovPredFailure era -> PDoc
ppConwayGovPredFailure :: forall era. ConwayGovPredFailure era -> PDoc
ppConwayGovPredFailure ConwayGovPredFailure era
x = case ConwayGovPredFailure era
x of
  GovActionsDoNotExist NonEmpty (GovActionId (EraCrypto era))
c -> Text -> [PDoc] -> PDoc
ppSexp Text
"GovActionsDoNotExist" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (GovActionId (EraCrypto era))
c]
  MalformedProposal GovAction era
ga -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedProposal" [forall era. GovAction era -> PDoc
pcGovAction GovAction era
ga]
  ProposalProcedureNetworkIdMismatch RewardAccount (EraCrypto era)
racnt Network
nw ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ProposalProcedureNetworkIdMismatch" [forall c. RewardAccount c -> PDoc
pcRewardAccount RewardAccount (EraCrypto era)
racnt, Network -> PDoc
pcNetwork Network
nw]
  TreasuryWithdrawalsNetworkIdMismatch Set (RewardAccount (EraCrypto era))
sr Network
nw ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"TreasuryWithdrawalsNetworkIdMismatch" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. RewardAccount c -> PDoc
pcRewardAccount Set (RewardAccount (EraCrypto era))
sr, Network -> PDoc
pcNetwork Network
nw]
  ProposalDepositIncorrect Coin
c1 Coin
c2 -> Text -> [PDoc] -> PDoc
ppSexp Text
"ProposalDepositIncorrect" [Coin -> PDoc
pcCoin Coin
c1, Coin -> PDoc
pcCoin Coin
c2]
  DisallowedVoters NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"DisallowedVoters" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
m]
  ConflictingCommitteeUpdate Set (Credential 'ColdCommitteeRole (EraCrypto era))
s ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ConflictingCommitteeUpdate" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Set (Credential 'ColdCommitteeRole (EraCrypto era))
s]
  ExpirationEpochTooSmall Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"ExpirationEpochTooSmall" [forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall ann. EpochNo -> Doc ann
ppEpochNo Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
m]
  InvalidPrevGovActionId ProposalProcedure era
p -> Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidPrevGovActionId" [forall era. ProposalProcedure era -> PDoc
pcProposalProcedure ProposalProcedure era
p]
  VotingOnExpiredGovAction NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"VotingOnExpiredGovAction" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
m]
  ProposalCantFollow StrictMaybe (GovPurposeId 'HardForkPurpose era)
s1 ProtVer
p1 ProtVer
p2 ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ProposalCantFollow" [forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'HardForkPurpose era)
s1, ProtVer -> PDoc
ppProtVer ProtVer
p1, ProtVer -> PDoc
ppProtVer ProtVer
p2]
  InvalidPolicyHash StrictMaybe (ScriptHash (EraCrypto era))
a StrictMaybe (ScriptHash (EraCrypto era))
b ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidPolicyHash" [forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall t. PrettyA t => t -> PDoc
prettyA StrictMaybe (ScriptHash (EraCrypto era))
a, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall t. PrettyA t => t -> PDoc
prettyA StrictMaybe (ScriptHash (EraCrypto era))
b]
  DisallowedProposalDuringBootstrap ProposalProcedure era
p ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"DisallowedProposalDuringBootstrap" [forall era. ProposalProcedure era -> PDoc
pcProposalProcedure ProposalProcedure era
p]
  DisallowedVotesDuringBootstrap NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"DisallowedVotesDuringBootstrap" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
m]
  VotersDoNotExist NonEmpty (Voter (EraCrypto era))
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"VotersDoNotExist" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (Voter (EraCrypto era))
m]
  ZeroTreasuryWithdrawals GovAction era
ga -> Text -> [PDoc] -> PDoc
ppSexp Text
"ZeroTreasuryWithdrawals" [forall era. GovAction era -> PDoc
pcGovAction GovAction era
ga]
  ProposalReturnAccountDoesNotExist RewardAccount (EraCrypto era)
a -> Text -> [PDoc] -> PDoc
ppSexp Text
"ProposalReturnAccountDoesNotExist" [forall t. PrettyA t => t -> PDoc
prettyA RewardAccount (EraCrypto era)
a]
  TreasuryWithdrawalReturnAccountsDoNotExist NonEmpty (RewardAccount (EraCrypto era))
a -> Text -> [PDoc] -> PDoc
ppSexp Text
"TreasuryWithdrawalReturnAccountsDoNotExist" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (RewardAccount (EraCrypto era))
a]

instance PrettyA (ConwayGovPredFailure era) where
  prettyA :: ConwayGovPredFailure era -> PDoc
prettyA = forall era. ConwayGovPredFailure era -> PDoc
ppConwayGovPredFailure

-- Note there is both: ppShelleyLedgerPredFailure and ppShelleyLedgersPredFailure (Ledger vs Ledgers)
ppShelleyLedgerPredFailure :: Reflect era => Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure :: forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
proof (UtxowFailure PredicateFailure (EraRule "UTXOW" era)
x) = forall era.
Reflect era =>
Proof era -> PredicateFailure (EraRule "UTXOW" era) -> PDoc
ppUTXOW Proof era
proof PredicateFailure (EraRule "UTXOW" era)
x
ppShelleyLedgerPredFailure Proof era
proof (DelegsFailure PredicateFailure (EraRule "DELEGS" era)
x) = forall era.
Proof era -> PredicateFailure (EraRule "DELEGS" era) -> PDoc
ppDELEGS Proof era
proof PredicateFailure (EraRule "DELEGS" era)
x

instance Reflect era => PrettyA (ShelleyLedgerPredFailure era) where
  prettyA :: ShelleyLedgerPredFailure era -> PDoc
prettyA = forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure forall era. Reflect era => Proof era
reify

ppConwayUtxowPredFailure ::
  Reflect era =>
  Proof era ->
  ConwayRules.ConwayUtxowPredFailure era ->
  PDoc
ppConwayUtxowPredFailure :: forall era.
Reflect era =>
Proof era -> ConwayUtxowPredFailure era -> PDoc
ppConwayUtxowPredFailure Proof era
proof = \case
  ConwayRules.UtxoFailure PredicateFailure (EraRule "UTXO" era)
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"UtxoFailure" [forall era.
Proof era -> PredicateFailure (EraRule "UTXO" era) -> PDoc
ppUTXO Proof era
proof PredicateFailure (EraRule "UTXO" era)
x]
  ConwayRules.InvalidWitnessesUTXOW [VKey 'Witness (EraCrypto era)]
vkeyws ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall c (r :: KeyRole). Crypto c => VKey r c -> PDoc
ppVKey [VKey 'Witness (EraCrypto era)]
vkeyws]
  ConwayRules.MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness (EraCrypto era))
whs ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"MissingVKeyWitnessesUTXOW" [forall c. Set (KeyHash 'Witness c) -> PDoc
ppWitHashes Set (KeyHash 'Witness (EraCrypto era))
whs]
  ConwayRules.MissingScriptWitnessesUTXOW Set (ScriptHash (EraCrypto era))
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"MissingScriptWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto era))
m]
  ConwayRules.ScriptWitnessNotValidatingUTXOW Set (ScriptHash (EraCrypto era))
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptWitnessNotValidatingUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto era))
m]
  ConwayRules.MissingTxBodyMetadataHash AuxiliaryDataHash (EraCrypto era)
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
" MissingTxMetadata" [forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash AuxiliaryDataHash (EraCrypto era)
m]
  ConwayRules.MissingTxMetadata AuxiliaryDataHash (EraCrypto era)
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
" MissingTxMetadata" [forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash AuxiliaryDataHash (EraCrypto era)
m]
  ConwayRules.ConflictingMetadataHash AuxiliaryDataHash (EraCrypto era)
h1 AuxiliaryDataHash (EraCrypto era)
h2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ConflictingMetadataHash"
      [(Text
"Hash in the body", forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash AuxiliaryDataHash (EraCrypto era)
h1), (Text
"Hash of full metadata", forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash AuxiliaryDataHash (EraCrypto era)
h2)]
  ConwayUtxowPredFailure era
ConwayRules.InvalidMetadata ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidMetadata" []
  ConwayRules.ExtraneousScriptWitnessesUTXOW Set (ScriptHash (EraCrypto era))
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ExtraneousScriptWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto era))
m]
  ConwayRules.MissingRedeemers [(PlutusPurpose AsItem era, ScriptHash (EraCrypto era))]
xs ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"MissingRedeemers" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair forall era. Reflect era => PlutusPurpose AsItem era -> PDoc
ppPlutusPurposeAsItem forall t. PrettyA t => t -> PDoc
prettyA) [(PlutusPurpose AsItem era, ScriptHash (EraCrypto era))]
xs]
  ConwayRules.MissingRequiredDatums Set (DataHash (EraCrypto era))
s1 Set (DataHash (EraCrypto era))
s2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"MissingRequiredDatums"
      [ (Text
"missing data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c index. SafeHash c index -> PDoc
ppSafeHash Set (DataHash (EraCrypto era))
s1)
      , (Text
"received data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c index. SafeHash c index -> PDoc
ppSafeHash Set (DataHash (EraCrypto era))
s2)
      ]
  ConwayRules.NotAllowedSupplementalDatums Set (DataHash (EraCrypto era))
s1 Set (DataHash (EraCrypto era))
s2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"NotAllowedSupplementalDatums"
      [ (Text
"unallowed data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c index. SafeHash c index -> PDoc
ppSafeHash Set (DataHash (EraCrypto era))
s1)
      , (Text
"acceptable data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c index. SafeHash c index -> PDoc
ppSafeHash Set (DataHash (EraCrypto era))
s2)
      ]
  ConwayRules.PPViewHashesDontMatch StrictMaybe (ScriptIntegrityHash (EraCrypto era))
h1 StrictMaybe (ScriptIntegrityHash (EraCrypto era))
h2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"PPViewHashesDontMatch"
      [ (Text
"PPHash in the TxBody", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c index. SafeHash c index -> PDoc
ppSafeHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
h1)
      , (Text
"PPHash Computed from the current Protocol Parameters", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c index. SafeHash c index -> PDoc
ppSafeHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
h2)
      ]
  ConwayRules.UnspendableUTxONoDatumHash Set (TxIn (EraCrypto era))
x ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"UnspendableUTxONoDatumHash" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. TxIn c -> PDoc
pcTxIn Set (TxIn (EraCrypto era))
x]
  ConwayRules.ExtraRedeemers [PlutusPurpose AsIx era]
x ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ExtraRedeemers" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall era. Reflect era => PlutusPurpose AsIx era -> PDoc
ppPlutusPurposeAsIx [PlutusPurpose AsIx era]
x]
  ConwayRules.MalformedScriptWitnesses Set (ScriptHash (EraCrypto era))
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedScriptWitnesses" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto era))
x]
  ConwayRules.MalformedReferenceScripts Set (ScriptHash (EraCrypto era))
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedReferenceScripts" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto era))
x] -- !(Set (ScriptHash (EraCrypto era)))

instance
  Reflect era =>
  PrettyA (ConwayRules.ConwayUtxowPredFailure era)
  where
  prettyA :: ConwayUtxowPredFailure era -> PDoc
prettyA = forall era.
Reflect era =>
Proof era -> ConwayUtxowPredFailure era -> PDoc
ppConwayUtxowPredFailure forall era. Reflect era => Proof era
reify

ppBabbageUtxowPredFailure ::
  Reflect era =>
  Proof era ->
  BabbageUtxowPredFailure era ->
  PDoc
ppBabbageUtxowPredFailure :: forall era.
Reflect era =>
Proof era -> BabbageUtxowPredFailure era -> PDoc
ppBabbageUtxowPredFailure Proof era
proof BabbageUtxowPredFailure era
failure = case BabbageUtxowPredFailure era
failure of
  AlonzoInBabbageUtxowPredFailure AlonzoUtxowPredFailure era
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoInBabbageUtxowPredFailure" [forall era. Reflect era => AlonzoUtxowPredFailure era -> PDoc
ppAlonzoUtxowPredFailure AlonzoUtxowPredFailure era
x]
  Cardano.Ledger.Babbage.Rules.UtxoFailure PredicateFailure (EraRule "UTXO" era)
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"UtxoFailure" [forall era.
Proof era -> PredicateFailure (EraRule "UTXO" era) -> PDoc
ppUTXO Proof era
proof PredicateFailure (EraRule "UTXO" era)
x]
  MalformedScriptWitnesses Set (ScriptHash (EraCrypto era))
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedScriptWitnesses" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto era))
x]
  MalformedReferenceScripts Set (ScriptHash (EraCrypto era))
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedReferenceScripts" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto era))
x] -- !(Set (ScriptHash (EraCrypto era)))

instance
  Reflect era =>
  PrettyA (BabbageUtxowPredFailure era)
  where
  prettyA :: BabbageUtxowPredFailure era -> PDoc
prettyA = forall era.
Reflect era =>
Proof era -> BabbageUtxowPredFailure era -> PDoc
ppBabbageUtxowPredFailure forall era. Reflect era => Proof era
reify

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

ppBbodyPredicateFailure :: forall era. Reflect era => ShelleyBbodyPredFailure era -> PDoc
ppBbodyPredicateFailure :: forall era. Reflect era => ShelleyBbodyPredFailure era -> PDoc
ppBbodyPredicateFailure (WrongBlockBodySizeBBODY (Mismatch Int
supplied Int
expected)) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"WrongBlockBodySizeBBODY"
    [ (Text
"actual computed BBody size", forall a. Int -> Doc a
ppInt Int
supplied)
    , (Text
"claimed BBody Size in Header", forall a. Int -> Doc a
ppInt Int
expected)
    ]
ppBbodyPredicateFailure (InvalidBodyHashBBODY (Mismatch Hash (EraCrypto era) EraIndependentBlockBody
supplied Hash (EraCrypto era) EraIndependentBlockBody
expected)) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"(InvalidBodyHashBBODY"
    [ (Text
"actual hash", forall a b. Hash a b -> PDoc
ppHash Hash (EraCrypto era) EraIndependentBlockBody
supplied)
    , (Text
"claimed hash", forall a b. Hash a b -> PDoc
ppHash Hash (EraCrypto era) EraIndependentBlockBody
expected)
    ]
ppBbodyPredicateFailure (LedgersFailure PredicateFailure (EraRule "LEDGERS" era)
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"LedgersFailure" [forall era.
Proof era -> PredicateFailure (EraRule "LEDGERS" era) -> PDoc
ppLEDGERS @era forall era. Reflect era => Proof era
reify PredicateFailure (EraRule "LEDGERS" era)
x]

instance Reflect era => PrettyA (ShelleyBbodyPredFailure era) where
  prettyA :: ShelleyBbodyPredFailure era -> PDoc
prettyA = forall era. Reflect era => ShelleyBbodyPredFailure era -> PDoc
ppBbodyPredicateFailure

-- ================
ppConwayBbodyPredFail :: forall era. Reflect era => ConwayBbodyPredFailure era -> PDoc
ppConwayBbodyPredFail :: forall era. Reflect era => ConwayBbodyPredFailure era -> PDoc
ppConwayBbodyPredFail (ConwayRules.BodyRefScriptsSizeTooBig Int
s1 Int
s2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"BodyRefScriptsSizeTooBig"
    [ (Text
"Computed sum of reference script size", forall a. Int -> Doc a
ppInt Int
s1)
    , (Text
"Maximum allowed total reference script size", forall a. Int -> Doc a
ppInt Int
s2)
    ]
ppConwayBbodyPredFail (ConwayRules.TooManyExUnits ExUnits
e1 ExUnits
e2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"TooManyExUnits"
    [ (Text
"Computed Sum of ExUnits for all plutus scripts", ExUnits -> PDoc
pcExUnits ExUnits
e1)
    , (Text
"Maximum allowed by protocal parameters", ExUnits -> PDoc
pcExUnits ExUnits
e2)
    ]
ppConwayBbodyPredFail (ConwayRules.WrongBlockBodySizeBBODY Int
x Int
y) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"WrongBlockBodySizeBBODY"
    [ (Text
"actual computed BBody size", forall a. Int -> Doc a
ppInt Int
x)
    , (Text
"claimed BBody Size in Header", forall a. Int -> Doc a
ppInt Int
y)
    ]
ppConwayBbodyPredFail (ConwayRules.InvalidBodyHashBBODY Hash (EraCrypto era) EraIndependentBlockBody
h1 Hash (EraCrypto era) EraIndependentBlockBody
h2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"(InvalidBodyHashBBODY"
    [ (Text
"actual hash", forall a b. Hash a b -> PDoc
ppHash Hash (EraCrypto era) EraIndependentBlockBody
h1)
    , (Text
"claimed hash", forall a b. Hash a b -> PDoc
ppHash Hash (EraCrypto era) EraIndependentBlockBody
h2)
    ]
ppConwayBbodyPredFail (ConwayRules.LedgersFailure PredicateFailure (EraRule "LEDGERS" era)
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"LedgersFailure" [forall era.
Proof era -> PredicateFailure (EraRule "LEDGERS" era) -> PDoc
ppLEDGERS @era forall era. Reflect era => Proof era
reify PredicateFailure (EraRule "LEDGERS" era)
x]

instance Reflect era => PrettyA (ConwayBbodyPredFailure era) where
  prettyA :: ConwayBbodyPredFailure era -> PDoc
prettyA = forall era. Reflect era => ConwayBbodyPredFailure era -> PDoc
ppConwayBbodyPredFail

ppAlonzoBbodyPredFail :: Reflect era => AlonzoBbodyPredFailure era -> PDoc
ppAlonzoBbodyPredFail :: forall era. Reflect era => AlonzoBbodyPredFailure era -> PDoc
ppAlonzoBbodyPredFail (ShelleyInAlonzoBbodyPredFailure ShelleyBbodyPredFailure era
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ShelleyInAlonzoPredFail" [forall era. Reflect era => ShelleyBbodyPredFailure era -> PDoc
ppBbodyPredicateFailure ShelleyBbodyPredFailure era
x]
ppAlonzoBbodyPredFail (TooManyExUnits ExUnits
e1 ExUnits
e2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"TooManyExUnits"
    [ (Text
"Computed Sum of ExUnits for all plutus scripts", ExUnits -> PDoc
pcExUnits ExUnits
e1)
    , (Text
"Maximum allowed by protocal parameters", ExUnits -> PDoc
pcExUnits ExUnits
e2)
    ]

instance Reflect era => PrettyA (AlonzoBbodyPredFailure era) where
  prettyA :: AlonzoBbodyPredFailure era -> PDoc
prettyA = forall era. Reflect era => AlonzoBbodyPredFailure era -> PDoc
ppAlonzoBbodyPredFail

-- ===============
ppTickPredicateFailure ::
  forall era.
  Reflect era =>
  ShelleyTickPredFailure era ->
  PDoc
ppTickPredicateFailure :: forall era. Reflect era => ShelleyTickPredFailure era -> PDoc
ppTickPredicateFailure (NewEpochFailure PredicateFailure (EraRule "NEWEPOCH" era)
x) = forall era.
Proof era -> PredicateFailure (EraRule "NEWEPOCH" era) -> PDoc
ppNEWEPOCH @era forall era. Reflect era => Proof era
reify PredicateFailure (EraRule "NEWEPOCH" era)
x
ppTickPredicateFailure (RupdFailure PredicateFailure (EraRule "RUPD" era)
_) =
  forall a. [Char] -> Doc a
ppString [Char]
"RupdPredicateFailure has no constructors"

instance Reflect era => PrettyA (ShelleyTickPredFailure era) where
  prettyA :: ShelleyTickPredFailure era -> PDoc
prettyA = forall era. Reflect era => ShelleyTickPredFailure era -> PDoc
ppTickPredicateFailure

ppShelleyNewEpochPredicateFailure ::
  forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure :: forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure (EpochFailure PredicateFailure (EraRule "EPOCH" era)
x) = forall era.
Proof era -> PredicateFailure (EraRule "EPOCH" era) -> PDoc
ppEPOCH @era forall era. Reflect era => Proof era
reify PredicateFailure (EraRule "EPOCH" era)
x
ppShelleyNewEpochPredicateFailure (CorruptRewardUpdate RewardUpdate (EraCrypto era)
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"CorruptRewardUpdate" [forall c. RewardUpdate c -> PDoc
ppRewardUpdate RewardUpdate (EraCrypto era)
x]
ppShelleyNewEpochPredicateFailure (MirFailure PredicateFailure (EraRule "MIR" era)
_) =
  forall a. HasCallStack => [Char] -> a
error [Char]
"In the Conway era, there is no (EraRule MIR) type instance."

instance Reflect era => PrettyA (ShelleyNewEpochPredFailure era) where
  prettyA :: ShelleyNewEpochPredFailure era -> PDoc
prettyA = forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure

ppConwayNewEpochPredFailure :: ConwayNewEpochPredFailure era -> PDoc
ppConwayNewEpochPredFailure :: forall era. ConwayNewEpochPredFailure era -> PDoc
ppConwayNewEpochPredFailure (ConwayRules.CorruptRewardUpdate RewardUpdate (EraCrypto era)
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"CorruptRewardUpdate" [forall c. RewardUpdate c -> PDoc
ppRewardUpdate RewardUpdate (EraCrypto era)
x]

instance PrettyA (ConwayNewEpochPredFailure era) where
  prettyA :: ConwayNewEpochPredFailure era -> PDoc
prettyA = forall era. ConwayNewEpochPredFailure era -> PDoc
ppConwayNewEpochPredFailure

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

ppShelleyEpochPredFailure :: forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure :: forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure (PoolReapFailure PredicateFailure (EraRule "POOLREAP" era)
_) =
  forall a. [Char] -> Doc a
ppString [Char]
"PoolreapPredicateFailure has no constructors"
ppShelleyEpochPredFailure (SnapFailure PredicateFailure (EraRule "SNAP" era)
_) =
  forall a. [Char] -> Doc a
ppString [Char]
"SnapPredicateFailure has no constructors"
ppShelleyEpochPredFailure (UpecFailure UpecPredFailure era
_) =
  forall a. [Char] -> Doc a
ppString [Char]
"UpecPredicateFailure has no constructors"

instance Reflect era => PrettyA (ShelleyEpochPredFailure era) where
  prettyA :: ShelleyEpochPredFailure era -> PDoc
prettyA = forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure

-- This type has no constructors, so the show instance is fine.
instance PrettyA (ShelleyPoolreapPredFailure era) where
  prettyA :: ShelleyPoolreapPredFailure era -> PDoc
prettyA = forall a ann. Show a => a -> Doc ann
viaShow

-- This type has no constructors, so the show instance is fine.
instance PrettyA (ShelleySnapPredFailure era) where
  prettyA :: ShelleySnapPredFailure era -> PDoc
prettyA = forall a ann. Show a => a -> Doc ann
viaShow

-- =========================================
-- Predicate Failure for Alonzo UTXOW

ppAlonzoUtxowPredFailure ::
  Reflect era =>
  AlonzoUtxowPredFailure era ->
  PDoc
ppAlonzoUtxowPredFailure :: forall era. Reflect era => AlonzoUtxowPredFailure era -> PDoc
ppAlonzoUtxowPredFailure (ShelleyInAlonzoUtxowPredFailure ShelleyUtxowPredFailure era
x) = forall t. PrettyA t => t -> PDoc
prettyA ShelleyUtxowPredFailure era
x
ppAlonzoUtxowPredFailure (MissingRedeemers [(PlutusPurpose AsItem era, ScriptHash (EraCrypto era))]
xs) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MissingRedeemers" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair forall era. Reflect era => PlutusPurpose AsItem era -> PDoc
ppPlutusPurposeAsItem forall t. PrettyA t => t -> PDoc
prettyA) [(PlutusPurpose AsItem era, ScriptHash (EraCrypto era))]
xs]
ppAlonzoUtxowPredFailure (MissingRequiredDatums Set (DataHash (EraCrypto era))
s1 Set (DataHash (EraCrypto era))
s2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"MissingRequiredDatums"
    [ (Text
"missing data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c index. SafeHash c index -> PDoc
ppSafeHash Set (DataHash (EraCrypto era))
s1)
    , (Text
"received data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c index. SafeHash c index -> PDoc
ppSafeHash Set (DataHash (EraCrypto era))
s2)
    ]
ppAlonzoUtxowPredFailure (NotAllowedSupplementalDatums Set (DataHash (EraCrypto era))
s1 Set (DataHash (EraCrypto era))
s2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"NotAllowedSupplementalDatums"
    [ (Text
"unallowed data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c index. SafeHash c index -> PDoc
ppSafeHash Set (DataHash (EraCrypto era))
s1)
    , (Text
"acceptable data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c index. SafeHash c index -> PDoc
ppSafeHash Set (DataHash (EraCrypto era))
s2)
    ]
ppAlonzoUtxowPredFailure (PPViewHashesDontMatch StrictMaybe (ScriptIntegrityHash (EraCrypto era))
h1 StrictMaybe (ScriptIntegrityHash (EraCrypto era))
h2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PPViewHashesDontMatch"
    [ (Text
"PPHash in the TxBody", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c index. SafeHash c index -> PDoc
ppSafeHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
h1)
    , (Text
"PPHash Computed from the current Protocol Parameters", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c index. SafeHash c index -> PDoc
ppSafeHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
h2)
    ]
ppAlonzoUtxowPredFailure (MissingRequiredSigners Set (KeyHash 'Witness (EraCrypto era))
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MissingRequiredSigners" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash Set (KeyHash 'Witness (EraCrypto era))
x]
ppAlonzoUtxowPredFailure (UnspendableUTxONoDatumHash Set (TxIn (EraCrypto era))
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"UnspendableUTxONoDatumHash" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. TxIn c -> PDoc
pcTxIn Set (TxIn (EraCrypto era))
x]
ppAlonzoUtxowPredFailure (ExtraRedeemers [PlutusPurpose AsIx era]
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ExtraRedeemers" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall era. Reflect era => PlutusPurpose AsIx era -> PDoc
ppPlutusPurposeAsIx [PlutusPurpose AsIx era]
x]

instance
  Reflect era =>
  PrettyA (AlonzoUtxowPredFailure era)
  where
  prettyA :: AlonzoUtxowPredFailure era -> PDoc
prettyA = forall era. Reflect era => AlonzoUtxowPredFailure era -> PDoc
ppAlonzoUtxowPredFailure

-- ====================================================
-- Predicate Failure for Shelley UTXOW

ppShelleyUtxowPredFailure :: forall era. Reflect era => ShelleyUtxowPredFailure era -> PDoc
ppShelleyUtxowPredFailure :: forall era. Reflect era => ShelleyUtxowPredFailure era -> PDoc
ppShelleyUtxowPredFailure (InvalidWitnessesUTXOW [VKey 'Witness (EraCrypto era)]
vkeyws) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall c (r :: KeyRole). Crypto c => VKey r c -> PDoc
ppVKey [VKey 'Witness (EraCrypto era)]
vkeyws]
ppShelleyUtxowPredFailure (MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness (EraCrypto era))
whs) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MissingVKeyWitnessesUTXOW" [forall c. Set (KeyHash 'Witness c) -> PDoc
ppWitHashes Set (KeyHash 'Witness (EraCrypto era))
whs]
ppShelleyUtxowPredFailure (MissingScriptWitnessesUTXOW Set (ScriptHash (EraCrypto era))
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MissingScriptWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto era))
m]
ppShelleyUtxowPredFailure (ScriptWitnessNotValidatingUTXOW Set (ScriptHash (EraCrypto era))
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptWitnessNotValidatingUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto era))
m]
ppShelleyUtxowPredFailure (Shelley.UtxoFailure PredicateFailure (EraRule "UTXO" era)
m) = Text -> [PDoc] -> PDoc
ppSexp Text
"UtxoFailure" [forall era.
Proof era -> PredicateFailure (EraRule "UTXO" era) -> PDoc
ppUTXO (forall era. Reflect era => Proof era
reify @era) PredicateFailure (EraRule "UTXO" era)
m]
ppShelleyUtxowPredFailure (MIRInsufficientGenesisSigsUTXOW Set (KeyHash 'Witness (EraCrypto era))
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MIRInsufficientGenesisSigsUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash Set (KeyHash 'Witness (EraCrypto era))
m]
ppShelleyUtxowPredFailure (MissingTxBodyMetadataHash AuxiliaryDataHash (EraCrypto era)
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
" MissingTxMetadata" [forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash AuxiliaryDataHash (EraCrypto era)
m]
ppShelleyUtxowPredFailure (MissingTxMetadata AuxiliaryDataHash (EraCrypto era)
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
" MissingTxMetadata" [forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash AuxiliaryDataHash (EraCrypto era)
m]
ppShelleyUtxowPredFailure (ConflictingMetadataHash (Mismatch AuxiliaryDataHash (EraCrypto era)
supplied AuxiliaryDataHash (EraCrypto era)
expected)) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ConflictingMetadataHash"
    [ (Text
"Hash in the body", forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash AuxiliaryDataHash (EraCrypto era)
supplied)
    , (Text
"Hash of full metadata", forall c. AuxiliaryDataHash c -> PDoc
ppAuxiliaryDataHash AuxiliaryDataHash (EraCrypto era)
expected)
    ]
ppShelleyUtxowPredFailure ShelleyUtxowPredFailure era
InvalidMetadata =
  Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidMetadata" []
ppShelleyUtxowPredFailure (ExtraneousScriptWitnessesUTXOW Set (ScriptHash (EraCrypto era))
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ExtraneousScriptWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto era))
m]

instance Reflect era => PrettyA (ShelleyUtxowPredFailure era) where
  prettyA :: ShelleyUtxowPredFailure era -> PDoc
prettyA = forall era. Reflect era => ShelleyUtxowPredFailure era -> PDoc
ppShelleyUtxowPredFailure

-- ========================================================
-- Predicate Failure for Alonzo UTXO

ppAlonzoUtxoPredFailure :: forall era. Reflect era => AlonzoUtxoPredFailure era -> PDoc
ppAlonzoUtxoPredFailure :: forall era. Reflect era => AlonzoUtxoPredFailure era -> PDoc
ppAlonzoUtxoPredFailure AlonzoUtxoPredFailure era
x = case AlonzoUtxoPredFailure era
x of
  Alonzo.BadInputsUTxO Set (TxIn (EraCrypto era))
txins -> Text -> [PDoc] -> PDoc
ppSexp Text
"BadInputsUTxO" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. TxIn c -> PDoc
pcTxIn Set (TxIn (EraCrypto era))
txins]
  Alonzo.OutsideValidityIntervalUTxO ValidityInterval
vi SlotNo
slot ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"OutsideValidityIntervalUTxO"
      [ (Text
"provided interval", ValidityInterval -> PDoc
ppValidityInterval ValidityInterval
vi)
      , (Text
"current slot", SlotNo -> PDoc
pcSlotNo SlotNo
slot)
      ]
  Alonzo.MaxTxSizeUTxO Integer
actual Integer
maxs ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"MaxTxSizeUTxO" [(Text
"Actual", forall a. Integer -> Doc a
ppInteger Integer
actual), (Text
"max transaction size", forall a. Integer -> Doc a
ppInteger Integer
maxs)]
  AlonzoUtxoPredFailure era
Alonzo.InputSetEmptyUTxO -> forall a. [Char] -> Doc a
ppString [Char]
"InputSetEmptyUTxO"
  Alonzo.FeeTooSmallUTxO Coin
computed Coin
supplied ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"FeeTooSmallUTxO"
      [ (Text
"min fee for this transaction", Coin -> PDoc
pcCoin Coin
computed)
      , (Text
"fee supplied by this transaction", Coin -> PDoc
pcCoin Coin
supplied)
      ]
  Alonzo.ValueNotConservedUTxO Value era
consumed Value era
produced ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ValueNotConservedUTxO"
      [(Text
"coin consumed", forall era. Proof era -> Value era -> PDoc
pcVal @era forall era. Reflect era => Proof era
reify Value era
consumed), (Text
"coin produced", forall era. Proof era -> Value era -> PDoc
pcVal @era forall era. Reflect era => Proof era
reify Value era
produced)]
  Alonzo.WrongNetwork Network
n Set (Addr (EraCrypto era))
add ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"WrongNetwork"
      [ (Text
"expected network id", Network -> PDoc
ppNetwork Network
n)
      , (Text
"set of addresses with wrong network id", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. Addr c -> PDoc
pcAddr Set (Addr (EraCrypto era))
add)
      ]
  Alonzo.WrongNetworkWithdrawal Network
n Set (RewardAccount (EraCrypto era))
accnt ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"WrongNetworkWithdrawal"
      [ (Text
"expected network id", Network -> PDoc
ppNetwork Network
n)
      , (Text
"set reward address with wrong network id", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. RewardAccount c -> PDoc
pcRewardAccount Set (RewardAccount (EraCrypto era))
accnt)
      ]
  Alonzo.OutputTooSmallUTxO [TxOut era]
xs ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"OutputTooSmallUTxO"
      [(Text
"list of supplied transaction outputs that are too small", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
  Alonzo.UtxosFailure PredicateFailure (EraRule "UTXOS" era)
yy -> Text -> [PDoc] -> PDoc
ppSexp Text
"UtxosFailure" [forall era.
Proof era -> PredicateFailure (EraRule "UTXOS" era) -> PDoc
ppUTXOS @era forall era. Reflect era => Proof era
reify PredicateFailure (EraRule "UTXOS" era)
yy]
  Alonzo.OutputBootAddrAttrsTooBig [TxOut era]
xs ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"OutputBootAddrAttrsTooBig"
      [(Text
"list of supplied bad transaction outputs", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
  AlonzoUtxoPredFailure era
Alonzo.TriesToForgeADA -> forall a. [Char] -> Doc a
ppString [Char]
"TriesToForgeADA"
  Alonzo.OutputTooBigUTxO [(Integer, Integer, TxOut era)]
xs ->
    Text -> [PDoc] -> PDoc
ppSexp
      Text
"OutputTooBigUTxO"
      [ forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList
          ( \(Integer
a, Integer
b, TxOut era
c) ->
              PDoc -> [(Text, PDoc)] -> PDoc
ppRecord'
                PDoc
""
                [(Text
"actual size", forall a. Integer -> Doc a
ppInteger Integer
a), (Text
"PParam max value", forall a. Integer -> Doc a
ppInteger Integer
b), (Text
"TxOut", forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify TxOut era
c)]
          )
          [(Integer, Integer, TxOut era)]
xs
      ]
  InsufficientCollateral DeltaCoin
c1 Coin
c2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"InsufficientCollateral"
      [ (Text
"balance computed", forall t. PrettyA t => t -> PDoc
prettyA DeltaCoin
c1)
      , (Text
"the required collateral for the given fee", Coin -> PDoc
pcCoin Coin
c2)
      ]
  ScriptsNotPaidUTxO UTxO era
u -> Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNotPaidUTxO" [forall era. Proof era -> UTxO era -> PDoc
pcUTxO forall era. Reflect era => Proof era
reify UTxO era
u]
  ExUnitsTooBigUTxO ExUnits
e1 ExUnits
e2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ExUnitsTooBigUTxO"
      [ (Text
"Max EXUnits from the protocol parameters", ExUnits -> PDoc
pcExUnits ExUnits
e1)
      , (Text
"EXUnits supplied", ExUnits -> PDoc
pcExUnits ExUnits
e2)
      ]
  CollateralContainsNonADA Value era
v -> Text -> [PDoc] -> PDoc
ppSexp Text
"CollateralContainsNonADA" [forall era. Proof era -> Value era -> PDoc
pcVal (forall era. Reflect era => Proof era
reify @era) Value era
v]
  WrongNetworkInTxBody Network
n1 Network
n2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"WrongNetworkInTxBody"
      [ (Text
"Actual Network ID", Network -> PDoc
ppNetwork Network
n1)
      , (Text
"Network ID in transaction body", Network -> PDoc
ppNetwork Network
n2)
      ]
  OutsideForecast SlotNo
slot -> Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"OutsideForecast" [(Text
"slot number outside consensus forecast range", SlotNo -> PDoc
pcSlotNo SlotNo
slot)]
  TooManyCollateralInputs Natural
n1 Natural
n2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"TooManyCollateralInputs"
      [ (Text
"Max allowed collateral inputs", forall a. Natural -> Doc a
ppNatural Natural
n1)
      , (Text
"Number of collateral inputs", forall a. Natural -> Doc a
ppNatural Natural
n2)
      ]
  AlonzoUtxoPredFailure era
NoCollateralInputs -> Text -> [PDoc] -> PDoc
ppSexp Text
" NoCollateralInputs" []

instance Reflect era => PrettyA (AlonzoUtxoPredFailure era) where
  prettyA :: AlonzoUtxoPredFailure era -> PDoc
prettyA = forall era. Reflect era => AlonzoUtxoPredFailure era -> PDoc
ppAlonzoUtxoPredFailure

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

ppShelleyDelegPredFailure :: ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure :: forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure ShelleyDelegPredFailure era
x = case ShelleyDelegPredFailure era
x of
  StakeKeyAlreadyRegisteredDELEG Credential 'Staking (EraCrypto era)
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyAlreadyRegisteredDELEG" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'Staking (EraCrypto era)
cred]
  StakeKeyInRewardsDELEG Credential 'Staking (EraCrypto era)
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyInRewardsDELEG" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'Staking (EraCrypto era)
cred]
  Shelley.StakeKeyNotRegisteredDELEG Credential 'Staking (EraCrypto era)
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyNotRegisteredDELEG" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'Staking (EraCrypto era)
cred]
  StakeKeyNonZeroAccountBalanceDELEG Maybe Coin
mcoin -> Text -> [PDoc] -> PDoc
ppSexp Text
" StakeKeyNonZeroAccountBalanceDELEG" [forall x ann. (x -> Doc ann) -> Maybe x -> Doc ann
ppMaybe Coin -> PDoc
pcCoin Maybe Coin
mcoin]
  StakeDelegationImpossibleDELEG Credential 'Staking (EraCrypto era)
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeDelegationImpossibleDELEG" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'Staking (EraCrypto era)
cred]
  ShelleyDelegPredFailure era
WrongCertificateTypeDELEG -> Text -> [PDoc] -> PDoc
ppSexp Text
"WrongCertificateTypeDELEG" []
  GenesisKeyNotInMappingDELEG KeyHash 'Genesis (EraCrypto era)
kh -> Text -> [PDoc] -> PDoc
ppSexp Text
"GenesisKeyNotInMappingDELEG" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'Genesis (EraCrypto era)
kh]
  DuplicateGenesisDelegateDELEG KeyHash 'GenesisDelegate (EraCrypto era)
kh -> Text -> [PDoc] -> PDoc
ppSexp Text
"DuplicateGenesisDelegateDELEG" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'GenesisDelegate (EraCrypto era)
kh]
  InsufficientForInstantaneousRewardsDELEG MIRPot
pot Coin
c1 Coin
c2 ->
    Text -> [PDoc] -> PDoc
ppSexp
      Text
"InsufficientForInstantaneousRewardsDELEG"
      [forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show MIRPot
pot), Coin -> PDoc
pcCoin Coin
c1, Coin -> PDoc
pcCoin Coin
c2]
  MIRCertificateTooLateinEpochDELEG SlotNo
s1 SlotNo
s2 ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"MIRCertificateTooLateinEpochDELEG" [SlotNo -> PDoc
pcSlotNo SlotNo
s1, SlotNo -> PDoc
pcSlotNo SlotNo
s2]
  DuplicateGenesisVRFDELEG Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
hash -> Text -> [PDoc] -> PDoc
ppSexp Text
"DuplicateGenesisVRFDELEG" [forall a b. Hash a b -> PDoc
ppHash Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
hash]
  ShelleyDelegPredFailure era
MIRTransferNotCurrentlyAllowed -> forall a. [Char] -> Doc a
ppString [Char]
"MIRTransferNotCurrentlyAllowed"
  ShelleyDelegPredFailure era
MIRNegativesNotCurrentlyAllowed -> forall a. [Char] -> Doc a
ppString [Char]
" MIRNegativesNotCurrentlyAllowed"
  InsufficientForTransferDELEG MIRPot
pot Coin
c1 Coin
c2 ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"InsufficientForTransferDELEG" [forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show MIRPot
pot), Coin -> PDoc
pcCoin Coin
c1, Coin -> PDoc
pcCoin Coin
c2]
  ShelleyDelegPredFailure era
MIRProducesNegativeUpdate -> forall a. [Char] -> Doc a
ppString [Char]
"MIRProducesNegativeUpdate"
  MIRNegativeTransfer MIRPot
pot Coin
c1 -> Text -> [PDoc] -> PDoc
ppSexp Text
" MIRNegativeTransfer" [forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show MIRPot
pot), Coin -> PDoc
pcCoin Coin
c1]

instance PrettyA (ShelleyDelegPredFailure era) where
  prettyA :: ShelleyDelegPredFailure era -> PDoc
prettyA = forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure

ppShelleyDelplPredFailure :: Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure :: forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p (PoolFailure PredicateFailure (EraRule "POOL" era)
x) = forall era.
Proof era -> PredicateFailure (EraRule "POOL" era) -> PDoc
ppPOOL Proof era
p PredicateFailure (EraRule "POOL" era)
x
ppShelleyDelplPredFailure Proof era
p (DelegFailure PredicateFailure (EraRule "DELEG" era)
x) = forall era.
Proof era -> PredicateFailure (EraRule "DELEG" era) -> PDoc
ppDELEG Proof era
p PredicateFailure (EraRule "DELEG" era)
x

instance Reflect era => PrettyA (ShelleyDelplPredFailure era) where
  prettyA :: ShelleyDelplPredFailure era -> PDoc
prettyA = forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure forall era. Reflect era => Proof era
reify

ppConwayDelegPredFailure :: ConwayDelegPredFailure era -> PDoc
ppConwayDelegPredFailure :: forall era. ConwayDelegPredFailure era -> PDoc
ppConwayDelegPredFailure ConwayDelegPredFailure era
x = case ConwayDelegPredFailure era
x of
  IncorrectDepositDELEG Coin
c -> Text -> [PDoc] -> PDoc
ppSexp Text
"IncorrectDepositDELEG" [Coin -> PDoc
pcCoin Coin
c]
  StakeKeyRegisteredDELEG Credential 'Staking (EraCrypto era)
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyRegisteredDELEG" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'Staking (EraCrypto era)
cred]
  ConwayRules.StakeKeyNotRegisteredDELEG Credential 'Staking (EraCrypto era)
cred ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyNotRegisteredDELEG" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'Staking (EraCrypto era)
cred]
  StakeKeyHasNonZeroRewardAccountBalanceDELEG Coin
c ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyHasNonZeroRewardAccountBalanceDELEG" [Coin -> PDoc
pcCoin Coin
c]
  ConwayRules.DelegateeDRepNotRegisteredDELEG Credential 'DRepRole (EraCrypto era)
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"DelegateeDRepNotRegisteredDELEG" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'DRepRole (EraCrypto era)
cred]
  ConwayRules.DelegateeStakePoolNotRegisteredDELEG KeyHash 'StakePool (EraCrypto era)
kh -> Text -> [PDoc] -> PDoc
ppSexp Text
"DelegateeStakePoolNotRegisteredDELEG" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool (EraCrypto era)
kh]

instance PrettyA (ConwayDelegPredFailure era) where
  prettyA :: ConwayDelegPredFailure era -> PDoc
prettyA = forall era. ConwayDelegPredFailure era -> PDoc
ppConwayDelegPredFailure

ppShelleyPoolPredFailure :: ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure :: forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure (StakePoolNotRegisteredOnKeyPOOL KeyHash 'StakePool (EraCrypto era)
kh) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"StakePoolNotRegisteredOnKeyPOOL"
    [ (Text
"KeyHash", forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool (EraCrypto era)
kh)
    ]
ppShelleyPoolPredFailure
  ( StakePoolRetirementWrongEpochPOOL
      (Mismatch {mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = EpochNo
curEpoch})
      (Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = EpochNo
poolRetEpoch, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = EpochNo
firstTooFarEpoch})
    ) =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"StakePoolRetirementWrongEpochPOOL"
      [ (Text
"Current Epoch", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
curEpoch)
      , (Text
"Pool Retirement Epoch", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
poolRetEpoch)
      , (Text
"First Epoch Too Far", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
firstTooFarEpoch)
      ]
ppShelleyPoolPredFailure
  ( StakePoolCostTooLowPOOL
      (Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Coin
prcStakePoolCost, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = Coin
ppStakePoolCost})
    ) =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"StakePoolCostTooLowPOOL"
      [ (Text
"PRC Stake Pool Cost", Coin -> PDoc
pcCoin Coin
prcStakePoolCost)
      , (Text
"PP Stake Pool Cost", Coin -> PDoc
pcCoin Coin
ppStakePoolCost)
      ]
ppShelleyPoolPredFailure
  ( WrongNetworkPOOL
      (Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Network
nwId, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = Network
regCertNwId})
      KeyHash 'StakePool (EraCrypto era)
stakePoolId
    ) =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"WrongNetworkPOOL"
      [ (Text
"Network ID", Network -> PDoc
ppNetwork Network
nwId)
      , (Text
"Registration Certificate Network ID", Network -> PDoc
ppNetwork Network
regCertNwId)
      , (Text
"Stake Pool ID", forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool (EraCrypto era)
stakePoolId)
      ]
ppShelleyPoolPredFailure
  ( PoolMedataHashTooBig
      KeyHash 'StakePool (EraCrypto era)
stakePoolId
      Int
metadataHashSize
    ) =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"PoolMedataHashTooBig"
      [ (Text
"Stake Pool ID", forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool (EraCrypto era)
stakePoolId)
      , (Text
"Metadata Hash Size", forall a. Int -> Doc a
ppInt Int
metadataHashSize)
      ]

instance PrettyA (ShelleyPoolPredFailure era) where
  prettyA :: ShelleyPoolPredFailure era -> PDoc
prettyA = forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure

-- =========================================
-- Predicate Failure for Alonzo UTXOS

ppUtxosPredicateFailure ::
  forall era.
  Reflect era =>
  AlonzoUtxosPredFailure era ->
  PDoc
ppUtxosPredicateFailure :: forall era. Reflect era => AlonzoUtxosPredFailure era -> PDoc
ppUtxosPredicateFailure (ValidationTagMismatch IsValid
isvalid TagMismatchDescription
tag) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ValidationTagMismatch"
    [ (Text
"isValid tag", IsValid -> PDoc
ppIsValid IsValid
isvalid)
    , (Text
"mismatch description", TagMismatchDescription -> PDoc
ppTagMismatchDescription TagMismatchDescription
tag)
    ]
ppUtxosPredicateFailure (CollectErrors [CollectError era]
es) =
  PDoc -> [(Text, PDoc)] -> PDoc
ppRecord'
    forall a. Monoid a => a
mempty
    [
      ( Text
"When collecting inputs for twophase scripts, these went wrong."
      , forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall era. Reflect era => CollectError era -> PDoc
ppCollectError [CollectError era]
es
      )
    ]
ppUtxosPredicateFailure (Alonzo.UpdateFailure EraRuleFailure "PPUP" era
p) = forall a. a -> PDoc
ppPPUPPredFailure EraRuleFailure "PPUP" era
p

instance Reflect era => PrettyA (AlonzoUtxosPredFailure era) where
  prettyA :: AlonzoUtxosPredFailure era -> PDoc
prettyA = forall era. Reflect era => AlonzoUtxosPredFailure era -> PDoc
ppUtxosPredicateFailure

instance Reflect era => PrettyA (ConwayUtxosPredFailure era) where
  prettyA :: ConwayUtxosPredFailure era -> PDoc
prettyA = \case
    ConwayRules.ValidationTagMismatch IsValid
isvalid TagMismatchDescription
tag ->
      Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"ValidationTagMismatch"
        [ (Text
"isValid tag", IsValid -> PDoc
ppIsValid IsValid
isvalid)
        , (Text
"mismatch description", TagMismatchDescription -> PDoc
ppTagMismatchDescription TagMismatchDescription
tag)
        ]
    ConwayRules.CollectErrors [CollectError era]
es ->
      PDoc -> [(Text, PDoc)] -> PDoc
ppRecord'
        forall a. Monoid a => a
mempty
        [
          ( Text
"When collecting inputs for twophase scripts, these went wrong."
          , forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall era. Reflect era => CollectError era -> PDoc
ppCollectError [CollectError era]
es
          )
        ]

ppCollectError ::
  Reflect era =>
  CollectError era ->
  PDoc
ppCollectError :: forall era. Reflect era => CollectError era -> PDoc
ppCollectError (NoRedeemer PlutusPurpose AsItem era
sp) = Text -> [PDoc] -> PDoc
ppSexp Text
"NoRedeemer" [forall era. Reflect era => PlutusPurpose AsItem era -> PDoc
ppPlutusPurposeAsItem PlutusPurpose AsItem era
sp]
ppCollectError (NoWitness ScriptHash (EraCrypto era)
sh) = Text -> [PDoc] -> PDoc
ppSexp Text
"NoWitness" [forall t. PrettyA t => t -> PDoc
prettyA ScriptHash (EraCrypto era)
sh]
ppCollectError (NoCostModel Language
l) = Text -> [PDoc] -> PDoc
ppSexp Text
"NoCostModel" [Language -> PDoc
ppLanguage Language
l]
ppCollectError (BadTranslation ContextError era
x) = Text -> [PDoc] -> PDoc
ppSexp Text
"BadTranslation" [forall era. Reflect era => ContextError era -> PDoc
ppContextError ContextError era
x]

ppContextError :: forall era. Reflect era => ContextError era -> PDoc
ppContextError :: forall era. Reflect era => ContextError era -> PDoc
ppContextError ContextError era
e =
  case forall era. Reflect era => Proof era
reify @era of
    Proof era
Shelley -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Allegra -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Mary -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Alonzo -> forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show ContextError era
e)
    Proof era
Babbage -> forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show ContextError era
e)
    Proof era
Conway -> forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show ContextError era
e)

ppPlutusPurposeAsIx :: Reflect era => PlutusPurpose AsIx era -> PDoc
ppPlutusPurposeAsIx :: forall era. Reflect era => PlutusPurpose AsIx era -> PDoc
ppPlutusPurposeAsIx = forall (f :: * -> * -> *) era.
(Reflect era,
 forall ix it. (PrettyA ix, PrettyA it) => PrettyA (f ix it)) =>
PlutusPurpose f era -> PDoc
ppPlutusPurpose @AsIx

ppPlutusPurposeAsItem :: Reflect era => PlutusPurpose AsItem era -> PDoc
ppPlutusPurposeAsItem :: forall era. Reflect era => PlutusPurpose AsItem era -> PDoc
ppPlutusPurposeAsItem = forall (f :: * -> * -> *) era.
(Reflect era,
 forall ix it. (PrettyA ix, PrettyA it) => PrettyA (f ix it)) =>
PlutusPurpose f era -> PDoc
ppPlutusPurpose @AsItem

ppPlutusPurposeAsIxItem :: Reflect era => PlutusPurpose AsIxItem era -> PDoc
ppPlutusPurposeAsIxItem :: forall era. Reflect era => PlutusPurpose AsIxItem era -> PDoc
ppPlutusPurposeAsIxItem = forall (f :: * -> * -> *) era.
(Reflect era,
 forall ix it. (PrettyA ix, PrettyA it) => PrettyA (f ix it)) =>
PlutusPurpose f era -> PDoc
ppPlutusPurpose @AsIxItem

ppPlutusPurpose ::
  forall f era.
  (Reflect era, forall ix it. (PrettyA ix, PrettyA it) => PrettyA (f ix it)) =>
  PlutusPurpose f era ->
  PDoc
ppPlutusPurpose :: forall (f :: * -> * -> *) era.
(Reflect era,
 forall ix it. (PrettyA ix, PrettyA it) => PrettyA (f ix it)) =>
PlutusPurpose f era -> PDoc
ppPlutusPurpose PlutusPurpose f era
p =
  case forall era. Reflect era => Proof era
reify @era of
    Proof era
Shelley -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Allegra -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Mary -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Alonzo -> forall t. PrettyA t => t -> PDoc
prettyA PlutusPurpose f era
p
    Proof era
Babbage -> forall t. PrettyA t => t -> PDoc
prettyA PlutusPurpose f era
p
    Proof era
Conway -> forall t. PrettyA t => t -> PDoc
prettyA PlutusPurpose f era
p

instance Reflect era => PrettyA (CollectError era) where
  prettyA :: CollectError era -> PDoc
prettyA = forall era. Reflect era => CollectError era -> PDoc
ppCollectError

ppTagMismatchDescription :: TagMismatchDescription -> PDoc
ppTagMismatchDescription :: TagMismatchDescription -> PDoc
ppTagMismatchDescription TagMismatchDescription
PassedUnexpectedly = Text -> [PDoc] -> PDoc
ppSexp Text
"PassedUnexpectedly" []
ppTagMismatchDescription (FailedUnexpectedly NonEmpty FailureDescription
xs) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"FailedUnexpectedly" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList FailureDescription -> PDoc
ppFailureDescription (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty FailureDescription
xs)]

instance PrettyA TagMismatchDescription where
  prettyA :: TagMismatchDescription -> PDoc
prettyA = TagMismatchDescription -> PDoc
ppTagMismatchDescription

ppFailureDescription :: FailureDescription -> PDoc
ppFailureDescription :: FailureDescription -> PDoc
ppFailureDescription (PlutusFailure Text
txt ByteString
bytes) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"PlutusFailure" [(Text
"reason", forall ann. Text -> Doc ann
text Text
txt), (Text
"script", ByteString -> PDoc
ppLong ByteString
bytes)]

instance PrettyA FailureDescription where
  prettyA :: FailureDescription -> PDoc
prettyA = FailureDescription -> PDoc
ppFailureDescription

-- =======================================
-- Predicate Failure for Shelley UTxO

ppShelleyUtxoPredFailure :: forall era. Reflect era => ShelleyUtxoPredFailure era -> PDoc
ppShelleyUtxoPredFailure :: forall era. Reflect era => ShelleyUtxoPredFailure era -> PDoc
ppShelleyUtxoPredFailure (Shelley.BadInputsUTxO Set (TxIn (EraCrypto era))
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"BadInputsUTxO" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. TxIn c -> PDoc
pcTxIn Set (TxIn (EraCrypto era))
x]
ppShelleyUtxoPredFailure (Shelley.ExpiredUTxO SlotNo
ttl SlotNo
slot) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"ExpiredUTxO" [(Text
"transaction time to live", SlotNo -> PDoc
pcSlotNo SlotNo
ttl), (Text
"current slot", SlotNo -> PDoc
pcSlotNo SlotNo
slot)]
ppShelleyUtxoPredFailure (Shelley.MaxTxSizeUTxO (Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Integer
actual, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = Integer
maxs})) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"MaxTxSizeUTxO"
    [ (Text
"Actual", forall a. Integer -> Doc a
ppInteger Integer
actual)
    , (Text
"max transaction size", forall a. Integer -> Doc a
ppInteger Integer
maxs)
    ]
ppShelleyUtxoPredFailure (ShelleyUtxoPredFailure era
Shelley.InputSetEmptyUTxO) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"InputSetEmptyUTxO" []
ppShelleyUtxoPredFailure (Shelley.FeeTooSmallUTxO (Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Coin
supplied, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = Coin
computed})) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"FeeTooSmallUTxO"
    [ (Text
"min fee for this transaction", Coin -> PDoc
pcCoin Coin
computed)
    , (Text
"fee supplied by this transaction", Coin -> PDoc
pcCoin Coin
supplied)
    ]
ppShelleyUtxoPredFailure (Shelley.ValueNotConservedUTxO Value era
consumed Value era
produced) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ValueNotConservedUTxO"
    [ (Text
"coin consumed", forall era. Proof era -> Value era -> PDoc
pcVal @era forall era. Reflect era => Proof era
reify Value era
consumed)
    , (Text
"coin produced", forall era. Proof era -> Value era -> PDoc
pcVal @era forall era. Reflect era => Proof era
reify Value era
produced)
    ]
ppShelleyUtxoPredFailure (Shelley.WrongNetwork Network
n Set (Addr (EraCrypto era))
add) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"WrongNetwork"
    [ (Text
"expected network id", Network -> PDoc
ppNetwork Network
n)
    , (Text
"set of addresses with wrong network id", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. Addr c -> PDoc
pcAddr Set (Addr (EraCrypto era))
add)
    ]
ppShelleyUtxoPredFailure (Shelley.WrongNetworkWithdrawal Network
n Set (RewardAccount (EraCrypto era))
accnt) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"WrongNetworkWithdrawal"
    [ (Text
"expected network id", Network -> PDoc
ppNetwork Network
n)
    , (Text
"set of reward address with wrong network id", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. RewardAccount c -> PDoc
pcRewardAccount Set (RewardAccount (EraCrypto era))
accnt)
    ]
ppShelleyUtxoPredFailure (Shelley.OutputTooSmallUTxO [TxOut era]
xs) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"OutputTooSmallUTxO"
    [(Text
"list of supplied transaction outputs that are too small", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
ppShelleyUtxoPredFailure (Shelley.UpdateFailure EraRuleFailure "PPUP" era
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"UpdateFailure" [forall a. a -> PDoc
ppPPUPPredFailure EraRuleFailure "PPUP" era
x]
ppShelleyUtxoPredFailure (Shelley.OutputBootAddrAttrsTooBig [TxOut era]
xs) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"OutputBootAddrAttrsTooBig"
    [(Text
"list of supplied bad transaction outputs", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]

instance Reflect era => PrettyA (ShelleyUtxoPredFailure era) where
  prettyA :: ShelleyUtxoPredFailure era -> PDoc
prettyA = forall era. Reflect era => ShelleyUtxoPredFailure era -> PDoc
ppShelleyUtxoPredFailure

-- =======================================
-- Predicate Failure for Shelley PPUP

ppPpupPredicateFailure :: ShelleyPpupPredFailure era -> PDoc
ppPpupPredicateFailure :: forall era. ShelleyPpupPredFailure era -> PDoc
ppPpupPredicateFailure (NonGenesisUpdatePPUP (Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Set (KeyHash 'Genesis (EraCrypto era))
x, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = Set (KeyHash 'Genesis (EraCrypto era))
y})) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"NonGenesisUpdatePPUP"
    [ (Text
"KeyHashes which are voting", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash Set (KeyHash 'Genesis (EraCrypto era))
x)
    , (Text
"KeyHashes which should be voting", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash Set (KeyHash 'Genesis (EraCrypto era))
y)
    ]
ppPpupPredicateFailure (PPUpdateWrongEpoch EpochNo
x EpochNo
y VotingPeriod
z) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PPUpdateWrongEpoch"
    [ (Text
"current epoch", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
x)
    , (Text
"intended epoch of update", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
y)
    , (Text
"voting period within the epoch", forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show VotingPeriod
z))
    ]
ppPpupPredicateFailure (PVCannotFollowPPUP ProtVer
x) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"PVCannotFollowPPUP" [(Text
"the first bad protocol version", ProtVer -> PDoc
ppProtVer ProtVer
x)]

instance PrettyA (ShelleyPpupPredFailure era) where
  prettyA :: ShelleyPpupPredFailure era -> PDoc
prettyA = forall era. ShelleyPpupPredFailure era -> PDoc
ppPpupPredicateFailure

-- =====================================================
-- Predicate failure for Mary UTXO

ppPPUPPredFailure :: a -> PDoc
ppPPUPPredFailure :: forall a. a -> PDoc
ppPPUPPredFailure a
_ = forall a. [Char] -> Doc a
ppString [Char]
"PPUPPredFailure" -- TODO FIXME

ppAllegraUtxoPredFailure ::
  forall era.
  Reflect era =>
  AllegraUtxoPredFailure era ->
  PDoc
ppAllegraUtxoPredFailure :: forall era. Reflect era => AllegraUtxoPredFailure era -> PDoc
ppAllegraUtxoPredFailure (Allegra.BadInputsUTxO Set (TxIn (EraCrypto era))
txins) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"BadInputsUTxO" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. TxIn c -> PDoc
pcTxIn Set (TxIn (EraCrypto era))
txins]
ppAllegraUtxoPredFailure (Allegra.OutsideValidityIntervalUTxO ValidityInterval
vi SlotNo
slot) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"OutsideValidityIntervalUTxO"
    [ (Text
"provided interval", ValidityInterval -> PDoc
ppValidityInterval ValidityInterval
vi)
    , (Text
"current slot", SlotNo -> PDoc
pcSlotNo SlotNo
slot)
    ]
ppAllegraUtxoPredFailure (Allegra.MaxTxSizeUTxO Integer
actual Integer
maxs) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"MaxTxSizeUTxO"
    [ (Text
"Actual", forall a. Integer -> Doc a
ppInteger Integer
actual)
    , (Text
"max transaction size", forall a. Integer -> Doc a
ppInteger Integer
maxs)
    ]
ppAllegraUtxoPredFailure (AllegraUtxoPredFailure era
Allegra.InputSetEmptyUTxO) = Text -> [PDoc] -> PDoc
ppSexp Text
"InputSetEmptyUTxO" []
ppAllegraUtxoPredFailure (Allegra.FeeTooSmallUTxO Coin
computed Coin
supplied) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"FeeTooSmallUTxO"
    [ (Text
"min fee for this transaction", Coin -> PDoc
pcCoin Coin
computed)
    , (Text
"fee supplied by this transaction", Coin -> PDoc
pcCoin Coin
supplied)
    ]
ppAllegraUtxoPredFailure (Allegra.ValueNotConservedUTxO Value era
consumed Value era
produced) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ValueNotConservedUTxO"
    [ (Text
"coin consumed", forall era. Proof era -> Value era -> PDoc
pcVal @era forall era. Reflect era => Proof era
reify Value era
consumed)
    , (Text
"coin produced", forall era. Proof era -> Value era -> PDoc
pcVal @era forall era. Reflect era => Proof era
reify Value era
produced)
    ]
ppAllegraUtxoPredFailure (Allegra.WrongNetwork Network
n Set (Addr (EraCrypto era))
add) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"WrongNetwork"
    [ (Text
"expected network id", Network -> PDoc
ppNetwork Network
n)
    , (Text
"set of addresses with wrong network id", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. Addr c -> PDoc
pcAddr Set (Addr (EraCrypto era))
add)
    ]
ppAllegraUtxoPredFailure (Allegra.WrongNetworkWithdrawal Network
n Set (RewardAccount (EraCrypto era))
accnt) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"WrongNetworkWithdrawal"
    [ (Text
"expected network id", Network -> PDoc
ppNetwork Network
n)
    , (Text
"set reward address with wrong network id", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. RewardAccount c -> PDoc
pcRewardAccount Set (RewardAccount (EraCrypto era))
accnt)
    ]
ppAllegraUtxoPredFailure (Allegra.OutputTooSmallUTxO [TxOut era]
xs) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"OutputTooSmallUTxO"
    [(Text
"list of supplied transaction outputs that are too small", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
ppAllegraUtxoPredFailure (Allegra.UpdateFailure EraRuleFailure "PPUP" era
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"UpdateFailure" [forall a. a -> PDoc
ppPPUPPredFailure EraRuleFailure "PPUP" era
x]
ppAllegraUtxoPredFailure (Allegra.OutputBootAddrAttrsTooBig [TxOut era]
xs) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"OutputBootAddrAttrsTooBig"
    [(Text
"list of supplied bad transaction outputs", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
ppAllegraUtxoPredFailure (AllegraUtxoPredFailure era
Allegra.TriesToForgeADA) = Text -> [PDoc] -> PDoc
ppSexp Text
"TriesToForgeADA" []
ppAllegraUtxoPredFailure (Allegra.OutputTooBigUTxO [TxOut era]
outs) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"OutputTooBigUTxO" [(Text
"list of TxOuts which are too big", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut forall era. Reflect era => Proof era
reify) [TxOut era]
outs)]

instance Reflect era => PrettyA (AllegraUtxoPredFailure era) where
  prettyA :: AllegraUtxoPredFailure era -> PDoc
prettyA = forall era. Reflect era => AllegraUtxoPredFailure era -> PDoc
ppAllegraUtxoPredFailure

-- ==========================================
-- LedgerState objects
-- ==========================================

ppBbodyState :: forall era. Reflect era => ShelleyBbodyState era -> PDoc
ppBbodyState :: forall era. Reflect era => ShelleyBbodyState era -> PDoc
ppBbodyState (BbodyState State (EraRule "LEDGERS" era)
ls (BlocksMade Map (KeyHash 'StakePool (EraCrypto era)) Natural
mp)) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"BbodyState"
    [ (Text
"ledger state", forall era. Proof era -> State (EraRule "LEDGERS" era) -> PDoc
ppStateLEDGERS @era forall era. Reflect era => Proof era
reify State (EraRule "LEDGERS" era)
ls)
    , (Text
"blocks made", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool (EraCrypto era)) Natural
mp)
    ]

instance Reflect era => PrettyA (ShelleyBbodyState era) where
  prettyA :: ShelleyBbodyState era -> PDoc
prettyA = forall era. Reflect era => ShelleyBbodyState era -> PDoc
ppBbodyState

-- =======================================================
-- Summaries. A Summary prints just some information
-- For examplle, just the size of a Map or List.

txBodyFieldSummary :: EraTxBody era => TxBodyField era -> [(Text, PDoc)]
txBodyFieldSummary :: forall era. EraTxBody era => TxBodyField era -> [(Text, PDoc)]
txBodyFieldSummary TxBodyField era
txb = case TxBodyField era
txb of
  (Inputs Set (TxIn (EraCrypto era))
s) -> [(Text
"Inputs", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set (TxIn (EraCrypto era))
s))]
  (Collateral Set (TxIn (EraCrypto era))
s) -> [(Text
"Collateral", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set (TxIn (EraCrypto era))
s))]
  (RefInputs Set (TxIn (EraCrypto era))
s) -> [(Text
"RefInputs", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set (TxIn (EraCrypto era))
s))]
  (Outputs StrictSeq (TxOut era)
xs) -> [(Text
"Outputs", forall a. Int -> Doc a
ppInt (forall (t :: * -> *) a. Foldable t => t a -> Int
length StrictSeq (TxOut era)
xs))]
  (CollateralReturn (SJust TxOut era
_)) -> [(Text
"Collateral Return", forall a. [Char] -> Doc a
ppString [Char]
"?")]
  (TotalCol (SJust Coin
c)) -> [(Text
"TotalCollateral", Coin -> PDoc
pcCoin Coin
c)]
  (Certs StrictSeq (TxCert era)
xs) -> [(Text
"Certs", forall a. Int -> Doc a
ppInt (forall (t :: * -> *) a. Foldable t => t a -> Int
length StrictSeq (TxCert era)
xs))]
  (Withdrawals' Withdrawals (EraCrypto era)
x) -> [(Text
"Withdrawals", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size (forall c. Withdrawals c -> Map (RewardAcnt c) Coin
unWithdrawals Withdrawals (EraCrypto era)
x)))]
  (Vldt ValidityInterval
x) -> [(Text
"Validity interval", ValidityInterval -> PDoc
ppValidityInterval ValidityInterval
x)]
  (Txfee Coin
c) -> [(Text
"Fee", Coin -> PDoc
pcCoin Coin
c)]
  (Update (SJust Update era
_)) -> [(Text
"Collateral Return", forall a. [Char] -> Doc a
ppString [Char]
"?")]
  (ReqSignerHashes Set (KeyHash 'Witness (EraCrypto era))
x) -> [(Text
"Required Signer hashes", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set (KeyHash 'Witness (EraCrypto era))
x))]
  (Fields.Mint MultiAsset (EraCrypto era)
ma) -> [(Text
"Mint", forall a. Integer -> Doc a
ppInteger (forall t. Val t => t -> Integer
Val.size (forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue forall a. Monoid a => a
mempty MultiAsset (EraCrypto era)
ma)) forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> Doc a
ppString [Char]
" bytes")]
  (WppHash (SJust ScriptIntegrityHash (EraCrypto era)
_)) -> [(Text
"WppHash", forall a. [Char] -> Doc a
ppString [Char]
"?")]
  (AdHash (SJust AuxiliaryDataHash (EraCrypto era)
_)) -> [(Text
"AdHash", forall a. [Char] -> Doc a
ppString [Char]
"?")]
  (Txnetworkid (SJust Network
x)) -> [(Text
"Network id", Network -> PDoc
ppNetwork Network
x)]
  TxBodyField era
_ -> []

bodySummary :: EraTxBody era => Proof era -> TxBody era -> PDoc
bodySummary :: forall era. EraTxBody era => Proof era -> TxBody era -> PDoc
bodySummary Proof era
proof TxBody era
txbody =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"TxBody"
    (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map forall era. EraTxBody era => TxBodyField era -> [(Text, PDoc)]
txBodyFieldSummary (forall era. Proof era -> TxBody era -> [TxBodyField era]
abstractTxBody Proof era
proof TxBody era
txbody)))

witnessFieldSummary :: WitnessesField era -> (Text, PDoc)
witnessFieldSummary :: forall era. WitnessesField era -> (Text, PDoc)
witnessFieldSummary WitnessesField era
wit = case WitnessesField era
wit of
  (AddrWits Set (WitVKey 'Witness (EraCrypto era))
s) -> (Text
"Address Witnesses", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set (WitVKey 'Witness (EraCrypto era))
s))
  (BootWits Set (BootstrapWitness (EraCrypto era))
s) -> (Text
"BootStrap Witnesses", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set (BootstrapWitness (EraCrypto era))
s))
  (ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
s) -> (Text
"Script Witnesses", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (ScriptHash (EraCrypto era)) (Script era)
s))
  (DataWits TxDats era
m) -> (Text
"Data Witnesses", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size (forall era. TxDats era -> Map (DataHash (EraCrypto era)) (Data era)
unTxDats TxDats era
m)))
  (RdmrWits Redeemers era
redeemers) -> (Text
"Redeemer Witnesses", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size (forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers Redeemers era
redeemers)))

witnessSummary :: Proof era -> TxWits era -> PDoc
witnessSummary :: forall era. Proof era -> TxWits era -> PDoc
witnessSummary Proof era
proof TxWits era
txwits =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Witnesses"
    (forall a b. (a -> b) -> [a] -> [b]
map forall era. WitnessesField era -> (Text, PDoc)
witnessFieldSummary (forall era. Proof era -> TxWits era -> [WitnessesField era]
abstractWitnesses Proof era
proof TxWits era
txwits))

txFieldSummary :: EraTxBody era => Proof era -> TxField era -> [PDoc]
txFieldSummary :: forall era. EraTxBody era => Proof era -> TxField era -> [PDoc]
txFieldSummary Proof era
proof TxField era
tx = case TxField era
tx of
  (Body TxBody era
b) -> [forall era. EraTxBody era => Proof era -> TxBody era -> PDoc
bodySummary Proof era
proof TxBody era
b]
  (BodyI [TxBodyField era]
xs) -> [Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"TxBody" (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map forall era. EraTxBody era => TxBodyField era -> [(Text, PDoc)]
txBodyFieldSummary [TxBodyField era]
xs))]
  (TxWits TxWits era
ws) -> [forall era. Proof era -> TxWits era -> PDoc
witnessSummary Proof era
proof TxWits era
ws]
  (WitnessesI [WitnessesField era]
ws) -> [Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"Witnesses" (forall a b. (a -> b) -> [a] -> [b]
map forall era. WitnessesField era -> (Text, PDoc)
witnessFieldSummary [WitnessesField era]
ws)]
  (AuxData (SJust TxAuxData era
_)) -> [Text -> [PDoc] -> PDoc
ppSexp Text
"AuxData" [forall a. [Char] -> Doc a
ppString [Char]
"?"]]
  (Valid (IsValid Bool
b)) -> [Text -> [PDoc] -> PDoc
ppSexp Text
"IsValid" [forall a. Bool -> Doc a
ppBool Bool
b]]
  TxField era
_ -> []

txSummary :: EraTx era => Proof era -> Tx era -> PDoc
txSummary :: forall era. EraTx era => Proof era -> Tx era -> PDoc
txSummary Proof era
proof Tx era
tx =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Tx" (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map (forall era. EraTxBody era => Proof era -> TxField era -> [PDoc]
txFieldSummary Proof era
proof) (forall era. Proof era -> Tx era -> [TxField era]
abstractTx Proof era
proof Tx era
tx)))

-- =================================
-- Summary version of UTxO

txInSummary :: TxIn era -> PDoc
txInSummary :: forall c. TxIn c -> PDoc
txInSummary (TxIn (TxId SafeHash era EraIndependentTxBody
h) TxIx
n) = Text -> [PDoc] -> PDoc
ppSexp Text
"TxIn" [PDoc -> PDoc
trim (forall c index. SafeHash c index -> PDoc
ppSafeHash SafeHash era EraIndependentTxBody
h), forall a. Int -> Doc a
ppInt (TxIx -> Int
txIxToInt TxIx
n)]

txOutSummary :: Proof era -> TxOut era -> PDoc
txOutSummary :: forall era. Proof era -> TxOut era -> PDoc
txOutSummary p :: Proof era
p@Proof era
Conway (BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
addr Value (ConwayEra StandardCrypto)
v Datum (ConwayEra StandardCrypto)
d StrictMaybe (Script (ConwayEra StandardCrypto))
s) =
  Text -> [PDoc] -> PDoc
ppSexp
    Text
"TxOut"
    [forall c. Addr c -> PDoc
addrSummary Addr (EraCrypto (ConwayEra StandardCrypto))
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value (ConwayEra StandardCrypto)
v, forall era. Era era => Datum era -> PDoc
datumSummary Datum (ConwayEra StandardCrypto)
d, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (forall era. Proof era -> Script era -> PDoc
scriptSummary Proof era
p) StrictMaybe (Script (ConwayEra StandardCrypto))
s]
txOutSummary p :: Proof era
p@Proof era
Babbage (BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
addr Value (BabbageEra StandardCrypto)
v Datum (BabbageEra StandardCrypto)
d StrictMaybe (Script (BabbageEra StandardCrypto))
s) =
  Text -> [PDoc] -> PDoc
ppSexp
    Text
"TxOut"
    [forall c. Addr c -> PDoc
addrSummary Addr (EraCrypto (BabbageEra StandardCrypto))
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value (BabbageEra StandardCrypto)
v, forall era. Era era => Datum era -> PDoc
datumSummary Datum (BabbageEra StandardCrypto)
d, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (forall era. Proof era -> Script era -> PDoc
scriptSummary Proof era
p) StrictMaybe (Script (BabbageEra StandardCrypto))
s]
txOutSummary p :: Proof era
p@Proof era
Alonzo (AlonzoTxOut Addr (EraCrypto (AlonzoEra StandardCrypto))
addr Value (AlonzoEra StandardCrypto)
v StrictMaybe (DataHash (EraCrypto (AlonzoEra StandardCrypto)))
md) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [forall c. Addr c -> PDoc
addrSummary Addr (EraCrypto (AlonzoEra StandardCrypto))
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value (AlonzoEra StandardCrypto)
v, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall era. DataHash era -> PDoc
dataHashSummary StrictMaybe (DataHash (EraCrypto (AlonzoEra StandardCrypto)))
md]
txOutSummary p :: Proof era
p@Proof era
Mary (ShelleyTxOut Addr (EraCrypto (MaryEra StandardCrypto))
addr Value (MaryEra StandardCrypto)
v) = Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [forall c. Addr c -> PDoc
addrSummary Addr (EraCrypto (MaryEra StandardCrypto))
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value (MaryEra StandardCrypto)
v]
txOutSummary p :: Proof era
p@Proof era
Allegra (ShelleyTxOut Addr (EraCrypto (AllegraEra StandardCrypto))
addr Value (AllegraEra StandardCrypto)
v) = Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [forall c. Addr c -> PDoc
addrSummary Addr (EraCrypto (AllegraEra StandardCrypto))
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value (AllegraEra StandardCrypto)
v]
txOutSummary p :: Proof era
p@Proof era
Shelley (ShelleyTxOut Addr (EraCrypto (ShelleyEra StandardCrypto))
addr Value (ShelleyEra StandardCrypto)
v) = Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [forall c. Addr c -> PDoc
addrSummary Addr (EraCrypto (ShelleyEra StandardCrypto))
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value (ShelleyEra StandardCrypto)
v]

datumSummary :: Era era => Datum era -> PDoc
datumSummary :: forall era. Era era => Datum era -> PDoc
datumSummary Datum era
NoDatum = forall a. [Char] -> Doc a
ppString [Char]
"NoDatum"
datumSummary (DatumHash DataHash (EraCrypto era)
h) = Text -> [PDoc] -> PDoc
ppSexp Text
"DHash" [PDoc -> PDoc
trim (forall c index. SafeHash c index -> PDoc
ppSafeHash DataHash (EraCrypto era)
h)]
datumSummary (Datum BinaryData era
b) = forall era. Era era => Data era -> PDoc
dataSummary (forall era. Era era => BinaryData era -> Data era
binaryDataToData BinaryData era
b)

dataSummary :: Era era => Data era -> PDoc
dataSummary :: forall era. Era era => Data era -> PDoc
dataSummary (Data Data
x) = Data -> PDoc
plutusDataSummary Data
x

plutusDataSummary :: PV1.Data -> PDoc
plutusDataSummary :: Data -> PDoc
plutusDataSummary (PV1.Constr Integer
n [Data]
ds) = (forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show Integer
n)) forall a. Semigroup a => a -> a -> a
<> forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList Data -> PDoc
plutusDataSummary [Data]
ds
plutusDataSummary (PV1.Map [(Data, Data)]
ds) = forall a. [Char] -> Doc a
ppString [Char]
"Map" forall a. Semigroup a => a -> a -> a
<> forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair Data -> PDoc
plutusDataSummary Data -> PDoc
plutusDataSummary) [(Data, Data)]
ds
plutusDataSummary (PV1.List [Data]
xs) = forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList Data -> PDoc
plutusDataSummary [Data]
xs
plutusDataSummary (PV1.I Integer
n) = forall a. Integer -> Doc a
ppInteger Integer
n
plutusDataSummary (PV1.B ByteString
bs) = PDoc -> PDoc
trim (ByteString -> PDoc
ppLong ByteString
bs)

multiAssetSummary :: MultiAsset c -> PDoc
multiAssetSummary :: forall c. MultiAsset c -> PDoc
multiAssetSummary (MultiAsset Map (PolicyID c) (Map AssetName Integer)
m) = forall a. [Char] -> Doc a
ppString ([Char]
"num tokens = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall k a. Map k a -> Int
Map.size Map (PolicyID c) (Map AssetName Integer)
m))

vSummary :: MaryValue c -> PDoc
vSummary :: forall c. MaryValue c -> PDoc
vSummary (MaryValue Coin
n MultiAsset c
ma) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Value" [Coin -> PDoc
pcCoin Coin
n, forall c. MultiAsset c -> PDoc
multiAssetSummary MultiAsset c
ma]

scriptSummary :: forall era. Proof era -> Script era -> PDoc
scriptSummary :: forall era. Proof era -> Script era -> PDoc
scriptSummary p :: Proof era
p@Proof era
Conway Script era
script = forall era. Proof era -> AlonzoScript era -> PDoc
plutusSummary Proof era
p Script era
script
scriptSummary p :: Proof era
p@Proof era
Babbage Script era
script = forall era. Proof era -> AlonzoScript era -> PDoc
plutusSummary Proof era
p Script era
script
scriptSummary p :: Proof era
p@Proof era
Alonzo Script era
script = forall era. Proof era -> AlonzoScript era -> PDoc
plutusSummary Proof era
p Script era
script
scriptSummary Proof era
Mary Script era
script = forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary Script era
script
scriptSummary Proof era
Allegra Script era
script = forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary Script era
script
scriptSummary Proof era
Shelley Script era
script = forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> PDoc
multiSigSummary Script era
script

networkSummary :: Network -> PDoc
networkSummary :: Network -> PDoc
networkSummary Network
Testnet = forall a. [Char] -> Doc a
ppString [Char]
"Test"
networkSummary Network
Mainnet = forall a. [Char] -> Doc a
ppString [Char]
"Main"

addrSummary :: Addr c -> PDoc
addrSummary :: forall c. Addr c -> PDoc
addrSummary (Addr Network
nw PaymentCredential c
pay StakeReference c
stk) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Addr" [Network -> PDoc
networkSummary Network
nw, forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
credSummary PaymentCredential c
pay, forall c. StakeReference c -> PDoc
stakeSummary StakeReference c
stk]
addrSummary (AddrBootstrap BootstrapAddress c
_) = forall a. [Char] -> Doc a
ppString [Char]
"Bootstrap"

credSummary :: Credential keyrole c -> PDoc
credSummary :: forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
credSummary (ScriptHashObj (ScriptHash Hash (ADDRHASH c) EraIndependentScript
h)) = Text -> [PDoc] -> PDoc
ppSexp Text
"Script" [PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash Hash (ADDRHASH c) EraIndependentScript
h)]
credSummary (KeyHashObj (KeyHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
kh)) = Text -> [PDoc] -> PDoc
ppSexp Text
"Key" [PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
kh)]

stakeSummary :: StakeReference c -> PDoc
stakeSummary :: forall c. StakeReference c -> PDoc
stakeSummary StakeReference c
StakeRefNull = forall a. [Char] -> Doc a
ppString [Char]
"Null"
stakeSummary (StakeRefPtr Ptr
_) = forall a. [Char] -> Doc a
ppString [Char]
"Ptr"
stakeSummary (StakeRefBase StakeCredential c
x) = Text -> [PDoc] -> PDoc
ppSexp Text
"Stake" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
credSummary (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole StakeCredential c
x)]

utxoSummary :: Proof era -> UTxO era -> PDoc
utxoSummary :: forall era. Proof era -> UTxO era -> PDoc
utxoSummary Proof era
proof = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. TxIn c -> PDoc
txInSummary (forall era. Proof era -> TxOut era -> PDoc
txOutSummary Proof era
proof) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO

utxoString :: Proof era -> UTxO era -> String
utxoString :: forall era. Proof era -> UTxO era -> [Char]
utxoString Proof era
proof = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. TxIn c -> PDoc
txInSummary (forall era. Proof era -> TxOut era -> PDoc
txOutSummary Proof era
proof) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO

scriptHashSummary :: ScriptHash c -> PDoc
scriptHashSummary :: forall era. ScriptHash era -> PDoc
scriptHashSummary (ScriptHash Hash (ADDRHASH c) EraIndependentScript
h) = PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash Hash (ADDRHASH c) EraIndependentScript
h)

keyHashSummary :: KeyHash keyrole c -> PDoc
keyHashSummary :: forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
keyHashSummary (KeyHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
h) = PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
h)

dataHashSummary :: DataHash era -> PDoc
dataHashSummary :: forall era. DataHash era -> PDoc
dataHashSummary DataHash era
dh = PDoc -> PDoc
trim (forall c index. SafeHash c index -> PDoc
ppSafeHash DataHash era
dh)

keyPairSummary :: Crypto c => KeyPair r c -> PDoc
keyPairSummary :: forall c (r :: KeyRole). Crypto c => KeyPair r c -> PDoc
keyPairSummary (KeyPair VKey r c
x SignKeyDSIGN (DSIGN c)
y) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"KeyPair" [(Text
"vKey", forall c (r :: KeyRole). Crypto c => VKey r c -> PDoc
vKeySummary VKey r c
x), (Text
"sKey", forall a ann. Show a => a -> Doc ann
viaShow SignKeyDSIGN (DSIGN c)
y)]

vKeySummary :: Crypto c => VKey r c -> PDoc
vKeySummary :: forall c (r :: KeyRole). Crypto c => VKey r c -> PDoc
vKeySummary vk :: VKey r c
vk@(VKey VerKeyDSIGN (DSIGN c)
x) = forall a ann. Show a => a -> Doc ann
viaShow VerKeyDSIGN (DSIGN c)
x forall a. Semigroup a => a -> a -> a
<> PDoc
" (hash " forall a. Semigroup a => a -> a -> a
<> forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
keyHashSummary (forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey VKey r c
vk) forall a. Semigroup a => a -> a -> a
<> PDoc
")"

timelockSummary :: (AllegraEraScript era, NativeScript era ~ Timelock era) => Timelock era -> PDoc
timelockSummary :: forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary (RequireSignature KeyHash 'Witness (EraCrypto era)
akh) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Signature" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
keyHashSummary KeyHash 'Witness (EraCrypto era)
akh]
timelockSummary (RequireAllOf StrictSeq (NativeScript era)
ms) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"AllOf" (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] (forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript era)
ms))
timelockSummary (RequireAnyOf StrictSeq (NativeScript era)
ms) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"AnyOf" (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] (forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript era)
ms))
timelockSummary (RequireMOf Int
m StrictSeq (NativeScript era)
ms) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MOfN" (forall a. Integer -> Doc a
ppInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] (forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript era)
ms))
timelockSummary (RequireTimeExpire SlotNo
mslot) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Expires" [SlotNo -> PDoc
pcSlotNo SlotNo
mslot]
timelockSummary (RequireTimeStart SlotNo
mslot) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Starts" [SlotNo -> PDoc
pcSlotNo SlotNo
mslot]

multiSigSummary ::
  (ShelleyEraScript era, NativeScript era ~ MultiSig era) => MultiSig era -> PDoc
multiSigSummary :: forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> PDoc
multiSigSummary (RequireSignature KeyHash 'Witness (EraCrypto era)
hk) = Text -> [PDoc] -> PDoc
ppSexp Text
"ReqSig" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
keyHashSummary KeyHash 'Witness (EraCrypto era)
hk]
multiSigSummary (RequireAllOf StrictSeq (NativeScript era)
ps) = Text -> [PDoc] -> PDoc
ppSexp Text
"AllOf" (forall a b. (a -> b) -> [a] -> [b]
map forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> PDoc
multiSigSummary (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
ps))
multiSigSummary (RequireAnyOf StrictSeq (NativeScript era)
ps) = Text -> [PDoc] -> PDoc
ppSexp Text
"AnyOf" (forall a b. (a -> b) -> [a] -> [b]
map forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> PDoc
multiSigSummary (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
ps))
multiSigSummary (RequireMOf Int
m StrictSeq (NativeScript era)
ps) = Text -> [PDoc] -> PDoc
ppSexp Text
"MOf" (forall a. Int -> Doc a
ppInt Int
m forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> PDoc
multiSigSummary (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
ps))
multiSigSummary MultiSig era
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: All NativeScripts should have been accounted for"

plutusSummary :: forall era. Proof era -> AlonzoScript era -> PDoc
plutusSummary :: forall era. Proof era -> AlonzoScript era -> PDoc
plutusSummary Proof era
Conway s :: AlonzoScript era
s@(PlutusScript PlutusScript era
plutusScript) =
  forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show (forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript) forall a. [a] -> [a] -> [a]
++ [Char]
" ") forall a. Semigroup a => a -> a -> a
<> forall era. ScriptHash era -> PDoc
scriptHashSummary (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era AlonzoScript era
s)
plutusSummary Proof era
Conway (TimelockScript Timelock era
x) = forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary Timelock era
x
plutusSummary Proof era
Babbage s :: AlonzoScript era
s@(PlutusScript PlutusScript era
plutusScript) =
  forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show (forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript) forall a. [a] -> [a] -> [a]
++ [Char]
" ") forall a. Semigroup a => a -> a -> a
<> forall era. ScriptHash era -> PDoc
scriptHashSummary (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era AlonzoScript era
s)
plutusSummary Proof era
Babbage (TimelockScript Timelock era
x) = forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary Timelock era
x
plutusSummary Proof era
Alonzo s :: AlonzoScript era
s@(PlutusScript PlutusScript era
plutusScript) =
  forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show (forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript) forall a. [a] -> [a] -> [a]
++ [Char]
" ") forall a. Semigroup a => a -> a -> a
<> forall era. ScriptHash era -> PDoc
scriptHashSummary (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era AlonzoScript era
s)
plutusSummary Proof era
Alonzo (TimelockScript Timelock era
x) = forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary Timelock era
x
plutusSummary Proof era
other AlonzoScript era
_ = forall a. [Char] -> Doc a
ppString ([Char]
"Plutus script in era " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Proof era
other forall a. [a] -> [a] -> [a]
++ [Char]
"???")

dStateSummary :: DState c -> PDoc
dStateSummary :: forall c. DState c -> PDoc
dStateSummary (DState UMap (EraCrypto c)
umap Map (FutureGenDeleg (EraCrypto c)) (GenDelegPair (EraCrypto c))
future (GenDelegs Map (KeyHash 'Genesis (EraCrypto c)) (GenDelegPair (EraCrypto c))
current) InstantaneousRewards (EraCrypto c)
irwd) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"DState"
    [ (Text
"Unified Reward Map", forall c. UMap c -> PDoc
uMapSummary UMap (EraCrypto c)
umap)
    , (Text
"Future genesis key delegations", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (FutureGenDeleg (EraCrypto c)) (GenDelegPair (EraCrypto c))
future))
    , (Text
"Genesis key delegations", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (KeyHash 'Genesis (EraCrypto c)) (GenDelegPair (EraCrypto c))
current))
    , (Text
"Instantaneous Rewards", forall c. InstantaneousRewards c -> PDoc
instantSummary InstantaneousRewards (EraCrypto c)
irwd)
    ]

instantSummary :: InstantaneousRewards c -> PDoc
instantSummary :: forall c. InstantaneousRewards c -> PDoc
instantSummary (InstantaneousRewards Map (Credential 'Staking c) Coin
reserves Map (Credential 'Staking c) Coin
treasury DeltaCoin
dreserves DeltaCoin
dtreasury) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"InstantaneousRewards"
    [ (Text
"Rewards from reserves", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (Credential 'Staking c) Coin
reserves))
    , (Text
"Rewards from treasury", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (Credential 'Staking c) Coin
treasury))
    , (Text
"Treasury to reserves", DeltaCoin -> PDoc
pcDeltaCoin DeltaCoin
dreserves)
    , (Text
"Reserves to treasury", DeltaCoin -> PDoc
pcDeltaCoin DeltaCoin
dtreasury)
    ]

uMapSummary :: UM.UMap c -> PDoc
uMapSummary :: forall c. UMap c -> PDoc
uMapSummary UMap c
umap =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"UMap"
    [ (Text
"Reward-Deposit Map", forall a. Int -> Doc a
ppInt (forall c k v. UView c k v -> Int
UM.size (forall c. UMap c -> UView c (Credential 'Staking c) RDPair
UM.RewDepUView UMap c
umap)))
    , (Text
"Ptrs Map", forall a. Int -> Doc a
ppInt (forall c k v. UView c k v -> Int
UM.size (forall c. UMap c -> UView c Ptr (Credential 'Staking c)
UM.PtrUView UMap c
umap)))
    , (Text
"SPoolUView Map", forall a. Int -> Doc a
ppInt (forall c k v. UView c k v -> Int
UM.size (forall c.
UMap c -> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
UM.SPoolUView UMap c
umap)))
    , (Text
"DRepUView Map", forall a. Int -> Doc a
ppInt (forall c k v. UView c k v -> Int
UM.size (forall c. UMap c -> UView c (Credential 'Staking c) (DRep c)
UM.DRepUView UMap c
umap)))
    ]

pStateSummary :: PState c -> PDoc
pStateSummary :: forall c. PState c -> PDoc
pStateSummary (PState Map (KeyHash 'StakePool (EraCrypto c)) (PoolParams (EraCrypto c))
pp Map (KeyHash 'StakePool (EraCrypto c)) (PoolParams (EraCrypto c))
fpp Map (KeyHash 'StakePool (EraCrypto c)) EpochNo
retire Map (KeyHash 'StakePool (EraCrypto c)) Coin
deposit) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PState"
    [ (Text
"Pool parameters", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool (EraCrypto c)) (PoolParams (EraCrypto c))
pp))
    , (Text
"Future pool parameters", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool (EraCrypto c)) (PoolParams (EraCrypto c))
fpp))
    , (Text
"Retiring stake pools", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool (EraCrypto c)) EpochNo
retire))
    , (Text
"Deposits", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool (EraCrypto c)) Coin
deposit))
    ]

dpStateSummary :: CertState era -> PDoc
dpStateSummary :: forall era. CertState era -> PDoc
dpStateSummary (CertState VState era
v PState era
p DState era
d) = forall ann. [Doc ann] -> Doc ann
vsep [forall era. VState era -> PDoc
pcVState VState era
v, forall c. PState c -> PDoc
pStateSummary PState era
p, forall c. DState c -> PDoc
dStateSummary DState era
d]

-- =============================================
-- Pretty printers for more Ledger specific types

pcTxId :: TxId c -> PDoc
pcTxId :: forall c. TxId c -> PDoc
pcTxId (TxId SafeHash c EraIndependentTxBody
safehash) = PDoc -> PDoc
trim (forall c index. SafeHash c index -> PDoc
ppSafeHash SafeHash c EraIndependentTxBody
safehash)

instance PrettyA (TxId c) where prettyA :: TxId c -> PDoc
prettyA = forall c. TxId c -> PDoc
pcTxId

pcTxIn :: TxIn c -> PDoc
pcTxIn :: forall c. TxIn c -> PDoc
pcTxIn (TxIn (TxId SafeHash c EraIndependentTxBody
h) (TxIx Word64
i)) = forall ann. Doc ann -> Doc ann
parens (forall ann. [Doc ann] -> Doc ann
hsep [forall a. [Char] -> Doc a
ppString [Char]
"TxIn", PDoc -> PDoc
trim (forall c index. SafeHash c index -> PDoc
ppSafeHash SafeHash c EraIndependentTxBody
h), forall a. Word64 -> Doc a
ppWord64 Word64
i])

instance PrettyA (TxIn c) where prettyA :: TxIn c -> PDoc
prettyA = forall c. TxIn c -> PDoc
pcTxIn

pcNetwork :: Network -> PDoc
pcNetwork :: Network -> PDoc
pcNetwork Network
Testnet = forall a. [Char] -> Doc a
ppString [Char]
"TestNet"
pcNetwork Network
Mainnet = forall a. [Char] -> Doc a
ppString [Char]
"Mainnet"

instance PrettyA Network where prettyA :: Network -> PDoc
prettyA = Network -> PDoc
pcNetwork

pcKeyHash :: KeyHash discriminator c -> PDoc
pcKeyHash :: forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash (KeyHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
h) = PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
h)

instance PrettyA (KeyHash d c) where prettyA :: KeyHash d c -> PDoc
prettyA = forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash

pcCredential :: Credential keyrole c -> PDoc
pcCredential :: forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential (ScriptHashObj (ScriptHash Hash (ADDRHASH c) EraIndependentScript
h)) = forall ann. [Doc ann] -> Doc ann
hsep [forall a. [Char] -> Doc a
ppString [Char]
"(Script", PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash Hash (ADDRHASH c) EraIndependentScript
h) forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> Doc a
ppString [Char]
")"]
pcCredential (KeyHashObj (KeyHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
h)) = forall ann. [Doc ann] -> Doc ann
hsep [forall a. [Char] -> Doc a
ppString [Char]
"(Key", PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
h) forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> Doc a
ppString [Char]
")"]

instance PrettyA (Credential keyrole c) where prettyA :: Credential keyrole c -> PDoc
prettyA = forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential

pcStakeReference :: StakeReference c -> PDoc
pcStakeReference :: forall c. StakeReference c -> PDoc
pcStakeReference StakeReference c
StakeRefNull = forall a. [Char] -> Doc a
ppString [Char]
"Null"
pcStakeReference (StakeRefBase StakeCredential c
cred) = forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential StakeCredential c
cred
pcStakeReference (StakeRefPtr Ptr
_) = forall a. [Char] -> Doc a
ppString [Char]
"Ptr"

instance PrettyA (StakeReference c) where prettyA :: StakeReference c -> PDoc
prettyA = forall c. StakeReference c -> PDoc
pcStakeReference

pcAddr :: Addr c -> PDoc
pcAddr :: forall c. Addr c -> PDoc
pcAddr (Addr Network
nw PaymentCredential c
pay StakeReference c
stk) =
  forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$
    forall ann. [Doc ann] -> Doc ann
hsep
      [ forall a. [Char] -> Doc a
ppString [Char]
"Addr"
      , Network -> PDoc
pcNetwork Network
nw
      , forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential PaymentCredential c
pay
      , forall c. StakeReference c -> PDoc
pcStakeReference StakeReference c
stk
      ]
pcAddr (AddrBootstrap BootstrapAddress c
_) = forall a. [Char] -> Doc a
ppString [Char]
"Bootstrap"

instance PrettyA (Addr c) where prettyA :: Addr c -> PDoc
prettyA = forall c. Addr c -> PDoc
pcAddr

-- | Value is a type family, so it has no PrettyA instance.
pcCoreValue :: Proof era -> Value era -> PDoc
pcCoreValue :: forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
Conway Value era
v = forall c. MaryValue c -> PDoc
vSummary Value era
v
pcCoreValue Proof era
Babbage Value era
v = forall c. MaryValue c -> PDoc
vSummary Value era
v
pcCoreValue Proof era
Alonzo Value era
v = forall c. MaryValue c -> PDoc
vSummary Value era
v
pcCoreValue Proof era
Mary Value era
v = forall c. MaryValue c -> PDoc
vSummary Value era
v
pcCoreValue Proof era
Allegra (Coin Integer
n) = forall ann. [Doc ann] -> Doc ann
hsep [forall a. [Char] -> Doc a
ppString [Char]
"₳", forall a. Integer -> Doc a
ppInteger Integer
n]
pcCoreValue Proof era
Shelley (Coin Integer
n) = forall ann. [Doc ann] -> Doc ann
hsep [forall a. [Char] -> Doc a
ppString [Char]
"₳", forall a. Integer -> Doc a
ppInteger Integer
n]

pcCoin :: Coin -> PDoc
pcCoin :: Coin -> PDoc
pcCoin (Coin Integer
n) = forall ann. [Doc ann] -> Doc ann
hsep [forall a. [Char] -> Doc a
ppString [Char]
"₳", forall a. Integer -> Doc a
ppInteger Integer
n]

instance PrettyA Coin where prettyA :: Coin -> PDoc
prettyA = Coin -> PDoc
pcCoin

pcValue :: MaryValue c -> PDoc
pcValue :: forall c. MaryValue c -> PDoc
pcValue (MaryValue Coin
n (MultiAsset Map (PolicyID c) (Map AssetName Integer)
m)) =
  Text -> [PDoc] -> PDoc
ppSexp
    Text
"Value"
    [ Coin -> PDoc
pcCoin Coin
n
    , -- , ppString ("num tokens = " ++ show (Map.size m))
      forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. PolicyID c -> PDoc
pcPolicyID (forall k a. Map k a -> Set k
Map.keysSet Map (PolicyID c) (Map AssetName Integer)
m)
    ]

instance PrettyA (MaryValue c) where
  prettyA :: MaryValue c -> PDoc
prettyA = forall c. MaryValue c -> PDoc
pcValue

pcVal :: Proof era -> Value era -> PDoc
pcVal :: forall era. Proof era -> Value era -> PDoc
pcVal Proof era
Shelley Value era
v = Coin -> PDoc
pcCoin Value era
v
pcVal Proof era
Allegra Value era
v = Coin -> PDoc
pcCoin Value era
v
pcVal Proof era
Mary Value era
v = forall c. MaryValue c -> PDoc
pcValue Value era
v
pcVal Proof era
Alonzo Value era
v = forall c. MaryValue c -> PDoc
pcValue Value era
v
pcVal Proof era
Babbage Value era
v = forall c. MaryValue c -> PDoc
pcValue Value era
v
pcVal Proof era
Conway Value era
v = forall c. MaryValue c -> PDoc
pcValue Value era
v

pcDatum :: Era era => Datum era -> PDoc
pcDatum :: forall era. Era era => Datum era -> PDoc
pcDatum Datum era
NoDatum = forall a. [Char] -> Doc a
ppString [Char]
"NoDatum"
pcDatum (DatumHash DataHash (EraCrypto era)
h) = Text -> [PDoc] -> PDoc
ppSexp Text
"DHash" [PDoc -> PDoc
trim (forall c index. SafeHash c index -> PDoc
ppSafeHash DataHash (EraCrypto era)
h)]
pcDatum (Datum BinaryData era
b) = forall era. Era era => Data era -> PDoc
pcData (forall era. Era era => BinaryData era -> Data era
binaryDataToData BinaryData era
b)

instance Era era => PrettyA (Datum era) where prettyA :: Datum era -> PDoc
prettyA = forall era. Era era => Datum era -> PDoc
pcDatum

pcData :: forall era. Era era => Data era -> PDoc
pcData :: forall era. Era era => Data era -> PDoc
pcData d :: Data era
d@(Data (PV1.Constr Integer
n [Data]
_)) =
  Text -> [PDoc] -> PDoc
ppSexp ([Char] -> Text
pack ([Char]
"Constr" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Integer
n)) [forall a. [Char] -> Doc a
ppString [Char]
"Hash", PDoc -> PDoc
trim forall a b. (a -> b) -> a -> b
$ forall c index. SafeHash c index -> PDoc
ppSafeHash (forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData Data era
d)]
pcData d :: Data era
d@(Data (PV1.Map [(Data, Data)]
_)) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Map" [forall a. [Char] -> Doc a
ppString [Char]
"Hash", PDoc -> PDoc
trim forall a b. (a -> b) -> a -> b
$ forall c index. SafeHash c index -> PDoc
ppSafeHash (forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData Data era
d)]
pcData d :: Data era
d@(Data (PV1.List [Data]
_)) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"List" [forall a. [Char] -> Doc a
ppString [Char]
"Hash", PDoc -> PDoc
trim forall a b. (a -> b) -> a -> b
$ forall c index. SafeHash c index -> PDoc
ppSafeHash (forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData Data era
d)]
pcData d :: Data era
d@(Data (PV1.I Integer
n)) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"I" [forall a. Integer -> Doc a
ppInteger Integer
n, forall a. [Char] -> Doc a
ppString [Char]
"Hash", PDoc -> PDoc
trim forall a b. (a -> b) -> a -> b
$ forall c index. SafeHash c index -> PDoc
ppSafeHash (forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData Data era
d)]
pcData d :: Data era
d@(Data (PV1.B ByteString
bytes)) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"B" [PDoc -> PDoc
trim (forall a ann. Show a => a -> Doc ann
viaShow ByteString
bytes), forall a. [Char] -> Doc a
ppString [Char]
"Hash", PDoc -> PDoc
trim forall a b. (a -> b) -> a -> b
$ forall c index. SafeHash c index -> PDoc
ppSafeHash (forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData Data era
d)]

instance Era era => PrettyA (Data era) where prettyA :: Data era -> PDoc
prettyA = forall era. Era era => Data era -> PDoc
pcData

pcTimelock ::
  forall era.
  (AllegraEraScript era, Reflect era, NativeScript era ~ Timelock era) =>
  Timelock era ->
  PDoc
pcTimelock :: forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock (RequireSignature KeyHash 'Witness (EraCrypto era)
akh) = Text -> [PDoc] -> PDoc
ppSexp Text
"Sign" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'Witness (EraCrypto era)
akh]
pcTimelock (RequireAllOf StrictSeq (NativeScript era)
ts) = Text -> [PDoc] -> PDoc
ppSexp Text
"AllOf" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
ts)]
pcTimelock (RequireAnyOf StrictSeq (NativeScript era)
ts) = Text -> [PDoc] -> PDoc
ppSexp Text
"AnyOf" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
ts)]
pcTimelock (RequireMOf Int
m StrictSeq (NativeScript era)
ts) = Text -> [PDoc] -> PDoc
ppSexp Text
"MOfN" (forall a. Integer -> Doc a
ppInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) forall a. a -> [a] -> [a]
: [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
ts)])
pcTimelock (RequireTimeExpire SlotNo
mslot) = Text -> [PDoc] -> PDoc
ppSexp Text
"Expires" [SlotNo -> PDoc
pcSlotNo SlotNo
mslot]
pcTimelock (RequireTimeStart SlotNo
mslot) = Text -> [PDoc] -> PDoc
ppSexp Text
"Starts" [SlotNo -> PDoc
pcSlotNo SlotNo
mslot]

instance
  ( AllegraEraScript era
  , Reflect era
  , NativeScript era ~ Timelock era
  ) =>
  PrettyA (Timelock era)
  where
  prettyA :: Timelock era -> PDoc
prettyA = forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock

pcMultiSig ::
  (ShelleyEraScript era, Reflect era, NativeScript era ~ MultiSig era) =>
  PDoc ->
  MultiSig era ->
  PDoc
pcMultiSig :: forall era.
(ShelleyEraScript era, Reflect era,
 NativeScript era ~ MultiSig era) =>
PDoc -> MultiSig era -> PDoc
pcMultiSig PDoc
h (RequireSignature KeyHash 'Witness (EraCrypto era)
hk) = Text -> [PDoc] -> PDoc
ppSexp Text
"ReqSig" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
keyHashSummary KeyHash 'Witness (EraCrypto era)
hk, PDoc
h]
pcMultiSig PDoc
h (RequireAllOf StrictSeq (NativeScript era)
_) = Text -> [PDoc] -> PDoc
ppSexp Text
"AllOf" [PDoc
h]
pcMultiSig PDoc
h (RequireAnyOf StrictSeq (NativeScript era)
_) = Text -> [PDoc] -> PDoc
ppSexp Text
"AnyOf" [PDoc
h]
pcMultiSig PDoc
h (RequireMOf Int
m StrictSeq (NativeScript era)
_) = Text -> [PDoc] -> PDoc
ppSexp Text
"MOf" [forall a. Int -> Doc a
ppInt Int
m, PDoc
h]
pcMultiSig PDoc
_ MultiSig era
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: All NativeScripts should have been accounted for"

instance
  ( AllegraEraScript era
  , Reflect era
  , NativeScript era ~ MultiSig era
  ) =>
  PrettyA (MultiSig era)
  where
  prettyA :: MultiSig era -> PDoc
prettyA = forall era.
(ShelleyEraScript era, Reflect era,
 NativeScript era ~ MultiSig era) =>
PDoc -> MultiSig era -> PDoc
pcMultiSig forall a. Monoid a => a
mempty

pcScriptHash :: ScriptHash era -> PDoc
pcScriptHash :: forall era. ScriptHash era -> PDoc
pcScriptHash (ScriptHash Hash (ADDRHASH era) EraIndependentScript
h) = PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash Hash (ADDRHASH era) EraIndependentScript
h)

instance PrettyA (ScriptHash era) where
  prettyA :: ScriptHash era -> PDoc
prettyA = forall era. ScriptHash era -> PDoc
pcScriptHash

pcHashScript :: forall era. Reflect era => Proof era -> Script era -> PDoc
pcHashScript :: forall era. Reflect era => Proof era -> Script era -> PDoc
pcHashScript Proof era
Conway Script era
s = forall a. [Char] -> Doc a
ppString [Char]
"Hash " forall a. Semigroup a => a -> a -> a
<> forall era. ScriptHash era -> PDoc
pcScriptHash (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era Script era
s)
pcHashScript Proof era
Babbage Script era
s = forall a. [Char] -> Doc a
ppString [Char]
"Hash " forall a. Semigroup a => a -> a -> a
<> forall era. ScriptHash era -> PDoc
pcScriptHash (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era Script era
s)
pcHashScript Proof era
Alonzo Script era
s = forall a. [Char] -> Doc a
ppString [Char]
"Hash " forall a. Semigroup a => a -> a -> a
<> forall era. ScriptHash era -> PDoc
pcScriptHash (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era Script era
s)
pcHashScript Proof era
Mary Script era
s = forall a. [Char] -> Doc a
ppString [Char]
"Hash " forall a. Semigroup a => a -> a -> a
<> forall era. ScriptHash era -> PDoc
pcScriptHash (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era Script era
s)
pcHashScript Proof era
Allegra Script era
s = forall a. [Char] -> Doc a
ppString [Char]
"Hash " forall a. Semigroup a => a -> a -> a
<> forall era. ScriptHash era -> PDoc
pcScriptHash (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era Script era
s)
pcHashScript Proof era
Shelley Script era
s = forall a. [Char] -> Doc a
ppString [Char]
"Hash " forall a. Semigroup a => a -> a -> a
<> forall era. ScriptHash era -> PDoc
pcScriptHash (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era Script era
s)

instance (Script era ~ AlonzoScript era, Reflect era) => PrettyA (AlonzoScript era) where
  prettyA :: AlonzoScript era -> PDoc
prettyA = forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript forall era. Reflect era => Proof era
reify

pcDataHash :: DataHash era -> PDoc
pcDataHash :: forall era. DataHash era -> PDoc
pcDataHash DataHash era
dh = PDoc -> PDoc
trim (forall c index. SafeHash c index -> PDoc
ppSafeHash DataHash era
dh)

instance PrettyA (DataHash era) where
  prettyA :: DataHash era -> PDoc
prettyA = forall era. DataHash era -> PDoc
pcDataHash

pcUTxO :: Proof era -> UTxO era -> PDoc
pcUTxO :: forall era. Proof era -> UTxO era -> PDoc
pcUTxO Proof era
proof = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. TxIn c -> PDoc
pcTxIn (forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO

instance Reflect era => PrettyA (UTxO era) where prettyA :: UTxO era -> PDoc
prettyA = forall era. Proof era -> UTxO era -> PDoc
pcUTxO forall era. Reflect era => Proof era
reify

pcPoolParams :: PoolParams era -> PDoc
pcPoolParams :: forall era. PoolParams era -> PDoc
pcPoolParams PoolParams era
x =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PoolParams"
    [ (Text
"Id", forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
keyHashSummary (forall c. PoolParams c -> KeyHash 'StakePool c
ppId PoolParams era
x))
    , (Text
"reward accnt", forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential (forall c. RewardAccount c -> Credential 'Staking c
raCredential (forall c. PoolParams c -> RewardAccount c
ppRewardAccount PoolParams era
x)))
    ]

instance PrettyA (PoolParams era) where prettyA :: PoolParams era -> PDoc
prettyA = forall era. PoolParams era -> PDoc
pcPoolParams

pcDelegCert :: ShelleyDelegCert c -> PDoc
pcDelegCert :: forall c. ShelleyDelegCert c -> PDoc
pcDelegCert (ShelleyRegCert StakeCredential c
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"ShelleyRegCert" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential StakeCredential c
cred]
pcDelegCert (ShelleyUnRegCert StakeCredential c
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"ShelleyUnRegCert" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential StakeCredential c
cred]
pcDelegCert (ShelleyDelegCert StakeCredential c
x KeyHash 'StakePool c
y) = Text -> [PDoc] -> PDoc
ppSexp Text
"ShelleyDelegCert" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential StakeCredential c
x, forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool c
y]

instance PrettyA (ShelleyDelegCert c) where prettyA :: ShelleyDelegCert c -> PDoc
prettyA = forall c. ShelleyDelegCert c -> PDoc
pcDelegCert

pcPoolCert :: PoolCert c -> PDoc
pcPoolCert :: forall c. PoolCert c -> PDoc
pcPoolCert (RegPool PoolParams c
poolp) = Text -> [PDoc] -> PDoc
ppSexp Text
"RegPool" [forall era. PoolParams era -> PDoc
pcPoolParams PoolParams c
poolp]
pcPoolCert (RetirePool KeyHash 'StakePool c
keyhash EpochNo
epoch) = Text -> [PDoc] -> PDoc
ppSexp Text
"RetirePool" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool c
keyhash, forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
epoch]

instance PrettyA (PoolCert c) where
  prettyA :: PoolCert c -> PDoc
prettyA = forall c. PoolCert c -> PDoc
pcPoolCert

pcShelleyTxCert :: ShelleyTxCert c -> PDoc
pcShelleyTxCert :: forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert (ShelleyTxCertDelegCert ShelleyDelegCert (EraCrypto c)
x) = forall c. ShelleyDelegCert c -> PDoc
pcDelegCert ShelleyDelegCert (EraCrypto c)
x
pcShelleyTxCert (ShelleyTxCertPool PoolCert (EraCrypto c)
x) = forall c. PoolCert c -> PDoc
pcPoolCert PoolCert (EraCrypto c)
x
pcShelleyTxCert (ShelleyTxCertGenesisDeleg GenesisDelegCert (EraCrypto c)
_) = forall a. [Char] -> Doc a
ppString [Char]
"GenesisCert"
pcShelleyTxCert (ShelleyTxCertMir (MIRCert MIRPot
x (StakeAddressesMIR Map (Credential 'Staking (EraCrypto c)) DeltaCoin
m))) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"MIRStakeAdresses"
    [ (Text
"pot", forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show MIRPot
x))
    , (Text
"Addresses", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential DeltaCoin -> PDoc
pcDeltaCoin Map (Credential 'Staking (EraCrypto c)) DeltaCoin
m)
    ]
pcShelleyTxCert (ShelleyTxCertMir (MIRCert MIRPot
x (SendToOppositePotMIR Coin
c))) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"MIROppositePot"
    [ (Text
"pot", forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show MIRPot
x))
    , (Text
"Amount", Coin -> PDoc
pcCoin Coin
c)
    ]

instance PrettyA (ShelleyTxCert c) where
  prettyA :: ShelleyTxCert c -> PDoc
prettyA = forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert

pcConwayTxCert :: ConwayTxCert c -> PDoc
pcConwayTxCert :: forall c. ConwayTxCert c -> PDoc
pcConwayTxCert (ConwayTxCertDeleg ConwayDelegCert (EraCrypto c)
dc) = forall c. ConwayDelegCert c -> PDoc
pcConwayDelegCert ConwayDelegCert (EraCrypto c)
dc
pcConwayTxCert (ConwayTxCertPool PoolCert (EraCrypto c)
poolc) = forall c. PoolCert c -> PDoc
pcPoolCert PoolCert (EraCrypto c)
poolc
pcConwayTxCert (ConwayTxCertGov ConwayGovCert (EraCrypto c)
x) = forall c. ConwayGovCert c -> PDoc
pcConwayGovCert ConwayGovCert (EraCrypto c)
x

instance PrettyA (ConwayTxCert c) where
  prettyA :: ConwayTxCert c -> PDoc
prettyA = forall c. ConwayTxCert c -> PDoc
pcConwayTxCert

pcConwayGovCert :: ConwayGovCert c -> PDoc
pcConwayGovCert :: forall c. ConwayGovCert c -> PDoc
pcConwayGovCert (ConwayRegDRep Credential 'DRepRole c
cred Coin
c StrictMaybe (Anchor c)
smA) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayRegDRep" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'DRepRole c
cred, Coin -> PDoc
pcCoin Coin
c, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c. Anchor c -> PDoc
pcAnchor StrictMaybe (Anchor c)
smA]
pcConwayGovCert (ConwayUnRegDRep Credential 'DRepRole c
cred Coin
c) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayUnRegDRep" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'DRepRole c
cred, Coin -> PDoc
pcCoin Coin
c]
pcConwayGovCert (ConwayUpdateDRep Credential 'DRepRole c
cred StrictMaybe (Anchor c)
smA) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayUpdateDRep" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'DRepRole c
cred, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c. Anchor c -> PDoc
pcAnchor StrictMaybe (Anchor c)
smA]
pcConwayGovCert (ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole c
cred1 Credential 'HotCommitteeRole c
cred2) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayAuthCommitteeHotKey" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'ColdCommitteeRole c
cred1, forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'HotCommitteeRole c
cred2]
pcConwayGovCert (ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole c
cred StrictMaybe (Anchor c)
anch) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ConwayResignCommitteeColdKey"
    [(Text
"cred", forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'ColdCommitteeRole c
cred), (Text
"anchor", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c. Anchor c -> PDoc
pcAnchor StrictMaybe (Anchor c)
anch)]

instance PrettyA (ConwayGovCert c) where
  prettyA :: ConwayGovCert c -> PDoc
prettyA = forall c. ConwayGovCert c -> PDoc
pcConwayGovCert

pcConwayDelegCert :: ConwayDelegCert c -> PDoc
pcConwayDelegCert :: forall c. ConwayDelegCert c -> PDoc
pcConwayDelegCert (ConwayRegCert StakeCredential c
cred StrictMaybe Coin
mcoin) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"RegCert" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential StakeCredential c
cred, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Coin -> PDoc
pcCoin StrictMaybe Coin
mcoin]
pcConwayDelegCert (ConwayUnRegCert StakeCredential c
cred StrictMaybe Coin
mcoin) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"UnRegCert" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential StakeCredential c
cred, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Coin -> PDoc
pcCoin StrictMaybe Coin
mcoin]
pcConwayDelegCert (ConwayDelegCert StakeCredential c
cred Delegatee c
d) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"DelegCert" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential StakeCredential c
cred, forall c. Delegatee c -> PDoc
pcDelegatee Delegatee c
d]
pcConwayDelegCert (ConwayRegDelegCert StakeCredential c
cred Delegatee c
d Coin
c) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"RegDelegCert" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential StakeCredential c
cred, forall c. Delegatee c -> PDoc
pcDelegatee Delegatee c
d, Coin -> PDoc
pcCoin Coin
c]

instance PrettyA (ConwayDelegCert c) where
  prettyA :: ConwayDelegCert c -> PDoc
prettyA = forall c. ConwayDelegCert c -> PDoc
pcConwayDelegCert

instance Reflect era => PrettyA (ConwayDelegEnv era) where
  prettyA :: ConwayDelegEnv era -> PDoc
prettyA ConwayDelegEnv {Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
PParams era
cdePParams :: forall era. ConwayDelegEnv era -> PParams era
cdePools :: forall era.
ConwayDelegEnv era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
cdePools :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
cdePParams :: PParams era
..} =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ConwayDelegEnv"
      [ (Text
"cdePParams", forall t. PrettyA t => t -> PDoc
prettyA PParams era
cdePParams)
      , (Text
"cdePools", forall t. PrettyA t => t -> PDoc
prettyA Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
cdePools)
      ]

pcDelegatee :: Delegatee c -> PDoc
pcDelegatee :: forall c. Delegatee c -> PDoc
pcDelegatee (DelegStake KeyHash 'StakePool c
kh) = Text -> [PDoc] -> PDoc
ppSexp Text
"DelegStake" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool c
kh]
pcDelegatee (DelegVote DRep c
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"DelegVote" [forall c. DRep c -> PDoc
pcDRep DRep c
cred]
pcDelegatee (DelegStakeVote KeyHash 'StakePool c
kh DRep c
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"DelegStakeVote" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool c
kh, forall c. DRep c -> PDoc
pcDRep DRep c
cred]

instance PrettyA (Delegatee c) where
  prettyA :: Delegatee c -> PDoc
prettyA = forall c. Delegatee c -> PDoc
pcDelegatee

pcTxCert :: Proof era -> TxCert era -> PDoc
pcTxCert :: forall era. Proof era -> TxCert era -> PDoc
pcTxCert Proof era
Shelley TxCert era
x = forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert TxCert era
x
pcTxCert Proof era
Allegra TxCert era
x = forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert TxCert era
x
pcTxCert Proof era
Mary TxCert era
x = forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert TxCert era
x
pcTxCert Proof era
Alonzo TxCert era
x = forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert TxCert era
x
pcTxCert Proof era
Babbage TxCert era
x = forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert TxCert era
x
pcTxCert Proof era
Conway TxCert era
x = forall c. ConwayTxCert c -> PDoc
pcConwayTxCert TxCert era
x

pcGovSignal :: forall era. Reflect era => GovSignal era -> PDoc
pcGovSignal :: forall era. Reflect era => GovSignal era -> PDoc
pcGovSignal (GovSignal VotingProcedures era
vote OSet (ProposalProcedure era)
proposal StrictSeq (TxCert era)
certs) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"GovProcedure"
    [ (Text
"voting", forall era. VotingProcedures era -> PDoc
pcVotingProcedures VotingProcedures era
vote)
    , (Text
"proposal", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall era. ProposalProcedure era -> PDoc
pcProposalProcedure (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OSet (ProposalProcedure era)
proposal))
    , (Text
"certificates", forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall era. Proof era -> TxCert era -> PDoc
pcTxCert (forall era. Reflect era => Proof era
reify @era)) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxCert era)
certs))
    ]

instance Reflect era => PrettyA (GovSignal era) where
  prettyA :: GovSignal era -> PDoc
prettyA = forall era. Reflect era => GovSignal era -> PDoc
pcGovSignal

pcVotingProcedures :: VotingProcedures era -> PDoc
pcVotingProcedures :: forall era. VotingProcedures era -> PDoc
pcVotingProcedures (VotingProcedures Map
  (Voter (EraCrypto era))
  (Map (GovActionId (EraCrypto era)) (VotingProcedure era))
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"VotingProcedures" [forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. Voter c -> PDoc
pcVoter (forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. GovActionId c -> PDoc
pcGovActionId forall era. VotingProcedure era -> PDoc
pcVotingProcedure) Map
  (Voter (EraCrypto era))
  (Map (GovActionId (EraCrypto era)) (VotingProcedure era))
m]

instance PrettyA (VotingProcedures era) where
  prettyA :: VotingProcedures era -> PDoc
prettyA = forall era. VotingProcedures era -> PDoc
pcVotingProcedures

pcProposalProcedure :: ProposalProcedure era -> PDoc
pcProposalProcedure :: forall era. ProposalProcedure era -> PDoc
pcProposalProcedure (ProposalProcedure Coin
c RewardAccount (EraCrypto era)
rewacnt GovAction era
govact Anchor (EraCrypto era)
anch) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ProposalProcedure"
    [ (Text
"Deposit", Coin -> PDoc
pcCoin Coin
c)
    , (Text
"ReturnAddr", forall c. RewardAccount c -> PDoc
pcRewardAccount RewardAccount (EraCrypto era)
rewacnt)
    , (Text
"GovAction", forall era. GovAction era -> PDoc
pcGovAction GovAction era
govact)
    , (Text
"Anchor", forall c. Anchor c -> PDoc
pcAnchor Anchor (EraCrypto era)
anch)
    ]

instance PrettyA (ProposalProcedure era) where
  prettyA :: ProposalProcedure era -> PDoc
prettyA = forall era. ProposalProcedure era -> PDoc
pcProposalProcedure

pcVoter :: Voter c -> PDoc
pcVoter :: forall c. Voter c -> PDoc
pcVoter (CommitteeVoter Credential 'HotCommitteeRole c
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"CommitteeVoter" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'HotCommitteeRole c
cred]
pcVoter (DRepVoter Credential 'DRepRole c
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"DRepVoter" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'DRepRole c
cred]
pcVoter (StakePoolVoter KeyHash 'StakePool c
keyhash) = Text -> [PDoc] -> PDoc
ppSexp Text
"StakePoolVoter" [forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool c
keyhash]

instance PrettyA (Voter c) where
  prettyA :: Voter c -> PDoc
prettyA = forall c. Voter c -> PDoc
pcVoter

pcVotingProcedure :: VotingProcedure era -> PDoc
pcVotingProcedure :: forall era. VotingProcedure era -> PDoc
pcVotingProcedure (VotingProcedure Vote
v StrictMaybe (Anchor (EraCrypto era))
smA) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"VotingProcedure" [(Text
"vote", Vote -> PDoc
pcVote Vote
v), (Text
"anchor", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c. Anchor c -> PDoc
pcAnchor StrictMaybe (Anchor (EraCrypto era))
smA)]

instance PrettyA (VotingProcedure era) where
  prettyA :: VotingProcedure era -> PDoc
prettyA = forall era. VotingProcedure era -> PDoc
pcVotingProcedure

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

pcRewardAccount :: RewardAccount c -> PDoc
pcRewardAccount :: forall c. RewardAccount c -> PDoc
pcRewardAccount (RewardAccount Network
net Credential 'Staking c
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"RewardAccount" [Network -> PDoc
pcNetwork Network
net, forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'Staking c
cred]

instance PrettyA (RewardAccount c) where prettyA :: RewardAccount c -> PDoc
prettyA = forall c. RewardAccount c -> PDoc
pcRewardAccount

pcExUnits :: ExUnits -> PDoc
pcExUnits :: ExUnits -> PDoc
pcExUnits (ExUnits Natural
mem Natural
step) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ExUnits" [forall a. Natural -> Doc a
ppNatural Natural
mem, forall a. Natural -> Doc a
ppNatural Natural
step]

instance PrettyA ExUnits where prettyA :: ExUnits -> PDoc
prettyA = ExUnits -> PDoc
pcExUnits

pcPair :: (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
pcPair :: forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
pcPair t1 -> PDoc
pp1 t2 -> PDoc
pp2 (t1
x, t2
y) = forall ann. Doc ann -> Doc ann
parens (forall ann. [Doc ann] -> Doc ann
hsep [t1 -> PDoc
pp1 t1
x, forall a. [Char] -> Doc a
ppString [Char]
",", t2 -> PDoc
pp2 t2
y])

pcWitVKey ::
  forall era keyrole.
  (Reflect era, Typeable keyrole) =>
  Proof era ->
  WitVKey keyrole (EraCrypto era) ->
  PDoc
pcWitVKey :: forall era (keyrole :: KeyRole).
(Reflect era, Typeable keyrole) =>
Proof era -> WitVKey keyrole (EraCrypto era) -> PDoc
pcWitVKey Proof era
_p (WitVKey vk :: VKey keyrole StandardCrypto
vk@(VKey VerKeyDSIGN (DSIGN StandardCrypto)
x) SignedDSIGN
  StandardCrypto (Hash StandardCrypto EraIndependentTxBody)
sig) =
  Text -> [PDoc] -> PDoc
ppSexp
    Text
"WitVKey"
    [ forall a. [Char] -> Doc a
ppString ([Char]
" VerKey=" forall a. [a] -> [a] -> [a]
++ (forall a. Int -> [a] -> [a]
take Int
10 (forall a. Int -> [a] -> [a]
drop Int
19 [Char]
keystring)))
    , forall a. [Char] -> Doc a
ppString ([Char]
" SignKey=" forall a. [a] -> [a] -> [a]
++ (forall a. Int -> [a] -> [a]
take Int
10 (forall a. Int -> [a] -> [a]
drop Int
29 [Char]
sigstring)))
    , PDoc
" VerKeyHash=" forall a. Semigroup a => a -> a -> a
<> PDoc
hash
    ]
  where
    keystring :: [Char]
keystring = forall a. Show a => a -> [Char]
show VerKeyDSIGN (DSIGN StandardCrypto)
x
    hash :: PDoc
hash = forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash (forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey VKey keyrole StandardCrypto
vk)
    sigstring :: [Char]
sigstring = forall a. Show a => a -> [Char]
show SignedDSIGN
  StandardCrypto (Hash StandardCrypto EraIndependentTxBody)
sig

instance
  forall era c keyrole.
  ( Reflect era
  , c ~ EraCrypto era
  , Typeable keyrole
  ) =>
  PrettyA (WitVKey keyrole c)
  where
  prettyA :: WitVKey keyrole c -> PDoc
prettyA = forall era (keyrole :: KeyRole).
(Reflect era, Typeable keyrole) =>
Proof era -> WitVKey keyrole (EraCrypto era) -> PDoc
pcWitVKey @era forall era. Reflect era => Proof era
reify

-- =====================================
-- Governance Actions etc

-- | GovState is a type family, No PrettyA instance
pcGovState :: Proof era -> GovState era -> PDoc
pcGovState :: forall era. Proof era -> GovState era -> PDoc
pcGovState Proof era
p GovState era
x = case forall era. Proof era -> GovStateWit era
whichGovState Proof era
p of
  (GovStateWit era
GovStateShelleyToBabbage) -> forall era. Proof era -> ShelleyGovState era -> PDoc
pcShelleyGovState Proof era
p GovState era
x
  (GovStateWit era
GovStateConwayToConway) -> forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era. Reflect era => Proof era -> ConwayGovState era -> PDoc
pcConwayGovState Proof era
p GovState era
x

pcShelleyGovState :: Proof era -> ShelleyGovState era -> PDoc
pcShelleyGovState :: forall era. Proof era -> ShelleyGovState era -> PDoc
pcShelleyGovState Proof era
p (ShelleyGovState ProposedPPUpdates era
_proposal ProposedPPUpdates era
_futproposal PParams era
pp PParams era
prevpp FuturePParams era
futurepp) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ShelleyGovState"
    forall a b. (a -> b) -> a -> b
$ [ (Text
"proposals", forall a. [Char] -> Doc a
ppString [Char]
"(Proposals ...)")
      , (Text
"futureProposals", forall a. [Char] -> Doc a
ppString [Char]
"(Proposals ...)")
      , (Text
"pparams", forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p PParams era
pp)
      , (Text
"prevParams", forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p PParams era
prevpp)
      , (Text
"futureParams", forall era. Proof era -> FuturePParams era -> PDoc
pcFuturePParams Proof era
p FuturePParams era
futurepp)
      ]

pcFuturePParams :: Proof era -> FuturePParams era -> PDoc
pcFuturePParams :: forall era. Proof era -> FuturePParams era -> PDoc
pcFuturePParams Proof era
p = \case
  FuturePParams era
NoPParamsUpdate -> Text -> [PDoc] -> PDoc
ppSexp Text
"NoPParamsUpdate" []
  PotentialPParamsUpdate Maybe (PParams era)
mpp -> Text -> [PDoc] -> PDoc
ppSexp Text
"PotentialPParamsUpdate" [forall x ann. (x -> Doc ann) -> Maybe x -> Doc ann
ppMaybe (forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p) Maybe (PParams era)
mpp]
  DefinitePParamsUpdate PParams era
pp -> Text -> [PDoc] -> PDoc
ppSexp Text
"DefinitePParamsUpdate" [forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p PParams era
pp]

instance Reflect era => PrettyA (ShelleyGovState era) where
  prettyA :: ShelleyGovState era -> PDoc
prettyA = forall era. Proof era -> ShelleyGovState era -> PDoc
pcShelleyGovState forall era. Reflect era => Proof era
reify

pcEnactState :: Proof era -> EnactState era -> PDoc
pcEnactState :: forall era. Proof era -> EnactState era -> PDoc
pcEnactState Proof era
p ens :: EnactState era
ens@(EnactState StrictMaybe (Committee era)
_ Constitution era
_ PParams era
_ PParams era
_ Coin
_ Map (Credential 'Staking (EraCrypto era)) Coin
_ GovRelation StrictMaybe era
_) =
  let EnactState {Map (Credential 'Staking (EraCrypto era)) Coin
PParams era
StrictMaybe (Committee era)
Coin
Constitution era
GovRelation StrictMaybe era
ensPrevGovActionIds :: forall era. EnactState era -> GovRelation StrictMaybe era
ensWithdrawals :: forall era.
EnactState era -> Map (Credential 'Staking (EraCrypto era)) Coin
ensTreasury :: forall era. EnactState era -> Coin
ensPrevPParams :: forall era. EnactState era -> PParams era
ensCurPParams :: forall era. EnactState era -> PParams era
ensConstitution :: forall era. EnactState era -> Constitution era
ensCommittee :: forall era. EnactState era -> StrictMaybe (Committee era)
ensPrevGovActionIds :: GovRelation StrictMaybe era
ensWithdrawals :: Map (Credential 'Staking (EraCrypto era)) Coin
ensTreasury :: Coin
ensPrevPParams :: PParams era
ensCurPParams :: PParams era
ensConstitution :: Constitution era
ensCommittee :: StrictMaybe (Committee era)
..} = EnactState era
ens
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"EnactState"
        [ (Text
"Constitutional Committee", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall era. Committee era -> PDoc
pcCommittee StrictMaybe (Committee era)
ensCommittee)
        , (Text
"Constitution", forall c. Constitution c -> PDoc
pcConstitution Constitution era
ensConstitution)
        , (Text
"CurPParams", forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p PParams era
ensCurPParams)
        , (Text
"PrevPParams", forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p PParams era
ensPrevPParams)
        , (Text
"Treasury", Coin -> PDoc
pcCoin Coin
ensTreasury)
        , (Text
"Withdrawals", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Coin -> PDoc
pcCoin Map (Credential 'Staking (EraCrypto era)) Coin
ensWithdrawals)
        , (Text
"PrevGovActionIds", forall era. GovRelation StrictMaybe era -> PDoc
pcPrevGovActionIds GovRelation StrictMaybe era
ensPrevGovActionIds)
        ]

instance Reflect era => PrettyA (EnactState era) where
  prettyA :: EnactState era -> PDoc
prettyA = forall era. Proof era -> EnactState era -> PDoc
pcEnactState forall era. Reflect era => Proof era
reify

pcGovActionId :: GovActionId c -> PDoc
pcGovActionId :: forall c. GovActionId c -> PDoc
pcGovActionId (GovActionId TxId c
txid (GovActionIx Word16
a)) = Text -> [PDoc] -> PDoc
ppSexp Text
"GovActId" [forall c. TxId c -> PDoc
pcTxId TxId c
txid, forall a. Word16 -> Doc a
ppWord16 Word16
a]

instance PrettyA (GovActionId c) where
  prettyA :: GovActionId c -> PDoc
prettyA = forall c. GovActionId c -> PDoc
pcGovActionId

pcGovPurposeId :: GovPurposeId p era -> PDoc
pcGovPurposeId :: forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId (GovPurposeId GovActionId (EraCrypto era)
x) = forall c. GovActionId c -> PDoc
pcGovActionId GovActionId (EraCrypto era)
x

pcPrevGovActionIds :: GovRelation StrictMaybe era -> PDoc
pcPrevGovActionIds :: forall era. GovRelation StrictMaybe era -> PDoc
pcPrevGovActionIds GovRelation {StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate :: StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate, StrictMaybe (GovPurposeId 'HardForkPurpose era)
grHardFork :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
grHardFork :: StrictMaybe (GovPurposeId 'HardForkPurpose era)
grHardFork, StrictMaybe (GovPurposeId 'CommitteePurpose era)
grCommittee :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
grCommittee :: StrictMaybe (GovPurposeId 'CommitteePurpose era)
grCommittee, StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
grConstitution :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
grConstitution :: StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
grConstitution} =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PrevGovActionIds"
    [ (Text
"LastPParamUpdate", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate)
    , (Text
"LastHardFork", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'HardForkPurpose era)
grHardFork)
    , (Text
"LastCommittee", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'CommitteePurpose era)
grCommittee)
    , (Text
"LastConstitution", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
grConstitution)
    ]

instance PrettyA (GovRelation StrictMaybe era) where
  prettyA :: GovRelation StrictMaybe era -> PDoc
prettyA = forall era. GovRelation StrictMaybe era -> PDoc
pcPrevGovActionIds

pcConwayGovState :: Reflect era => Proof era -> ConwayGovState era -> PDoc
pcConwayGovState :: forall era. Reflect era => Proof era -> ConwayGovState era -> PDoc
pcConwayGovState Proof era
p (ConwayGovState Proposals era
ss StrictMaybe (Committee era)
cmt Constitution era
con PParams era
cpp PParams era
ppp FuturePParams era
fpp DRepPulsingState era
dr) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ConwayGovState"
    [ (Text
"proposals", forall era. Proposals era -> PDoc
pcProposals Proposals era
ss)
    , (Text
"committee", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall t. PrettyA t => t -> PDoc
prettyA StrictMaybe (Committee era)
cmt)
    , (Text
"constitution", forall t. PrettyA t => t -> PDoc
prettyA Constitution era
con)
    , (Text
"currentPParams", forall t. PrettyA t => t -> PDoc
prettyA PParams era
cpp)
    , (Text
"prevPParams", forall t. PrettyA t => t -> PDoc
prettyA PParams era
ppp)
    , (Text
"futurePParams", forall era. Proof era -> FuturePParams era -> PDoc
pcFuturePParams Proof era
p FuturePParams era
fpp)
    , (Text
"drepPulsingState", forall era. Proof era -> DRepPulsingState era -> PDoc
pcDRepPulsingState Proof era
p DRepPulsingState era
dr)
    ]

instance Reflect era => PrettyA (ConwayGovState era) where
  prettyA :: ConwayGovState era -> PDoc
prettyA = forall era. Reflect era => Proof era -> ConwayGovState era -> PDoc
pcConwayGovState forall era. Reflect era => Proof era
reify

pcPulsingSnapshot :: PulsingSnapshot era -> PDoc
pcPulsingSnapshot :: forall era. PulsingSnapshot era -> PDoc
pcPulsingSnapshot (PulsingSnapshot StrictSeq (GovActionState era)
ps Map (DRep (EraCrypto era)) (CompactForm Coin)
dd Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
ds Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
pd) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Snapshot"
    [ (Text
"proposals", forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq forall era. GovActionState era -> PDoc
pcGovActionState StrictSeq (GovActionState era)
ps)
    , (Text
"drepDistr", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. DRep c -> PDoc
pcDRep (Coin -> PDoc
pcCoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Compactible a => CompactForm a -> a
fromCompact) Map (DRep (EraCrypto era)) (CompactForm Coin)
dd)
    , (Text
"drepState", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall c. DRepState c -> PDoc
pcDRepState Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
ds)
    , (Text
"poolDistr", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash (Coin -> PDoc
pcCoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Compactible a => CompactForm a -> a
fromCompact) Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
pd)
    ]

instance PrettyA (PulsingSnapshot era) where
  prettyA :: PulsingSnapshot era -> PDoc
prettyA = forall era. PulsingSnapshot era -> PDoc
pcPulsingSnapshot

pcDRepPulsingState :: Proof era -> DRepPulsingState era -> PDoc
pcDRepPulsingState :: forall era. Proof era -> DRepPulsingState era -> PDoc
pcDRepPulsingState Proof era
p (DRComplete PulsingSnapshot era
x RatifyState era
y) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"DRComplete"
    [ (Text
"pulsingSnapshot", forall era. PulsingSnapshot era -> PDoc
pcPulsingSnapshot PulsingSnapshot era
x)
    , (Text
"ratifyState", forall era. Proof era -> RatifyState era -> PDoc
pcRatifyState Proof era
p RatifyState era
y)
    ]
pcDRepPulsingState Proof era
_ (DRPulsing DRepPulser era Identity (RatifyState era)
x) = Text -> [PDoc] -> PDoc
ppSexp Text
"DRPulsing" [forall era. DRepPulser era Identity (RatifyState era) -> PDoc
pcDRepPulser DRepPulser era Identity (RatifyState era)
x]

instance Reflect era => PrettyA (DRepPulsingState era) where
  prettyA :: DRepPulsingState era -> PDoc
prettyA = forall era. Proof era -> DRepPulsingState era -> PDoc
pcDRepPulsingState forall era. Reflect era => Proof era
reify

pcRatifyState :: Proof era -> RatifyState era -> PDoc
pcRatifyState :: forall era. Proof era -> RatifyState era -> PDoc
pcRatifyState Proof era
p (RatifyState EnactState era
enactedState Seq (GovActionState era)
enactedPs Set (GovActionId (EraCrypto era))
expiredPs Bool
delayedPs) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"RatifyState"
    [ (Text
"enactstate", forall era. Proof era -> EnactState era -> PDoc
pcEnactState Proof era
p EnactState era
enactedState)
    , (Text
"enacted", forall a ann. (a -> Doc ann) -> Seq a -> Doc ann
ppSeq forall era. GovActionState era -> PDoc
pcGovActionState Seq (GovActionState era)
enactedPs)
    , (Text
"expired", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall c. GovActionId c -> PDoc
pcGovActionId Set (GovActionId (EraCrypto era))
expiredPs)
    , (Text
"delayed", forall a. Bool -> Doc a
ppBool Bool
delayedPs)
    ]

instance Reflect era => PrettyA (RatifyState era) where
  prettyA :: RatifyState era -> PDoc
prettyA = forall era. Proof era -> RatifyState era -> PDoc
pcRatifyState forall era. Reflect era => Proof era
reify

pcProposals :: Proposals era -> PDoc
pcProposals :: forall era. Proposals era -> PDoc
pcProposals Proposals era
p =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Proposals"
    [ (Text
"pProps", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. GovActionId c -> PDoc
pcGovActionId forall era. GovActionState era -> PDoc
pcGovActionState (forall era.
Proposals era
-> Map (GovActionId (EraCrypto era)) (GovActionState era)
proposalsActionsMap Proposals era
p))
    , (Text
"pRoots", forall era. GovRelation StrictMaybe era -> PDoc
pcPrevGovActionIds (forall era. GovRelation PRoot era -> GovRelation StrictMaybe era
toPrevGovActionIds (Proposals era
p forall s a. s -> Getting a s a -> a
^. forall era. Lens' (Proposals era) (GovRelation PRoot era)
pRootsL)))
    , (Text
"pGraph", forall era. GovRelation PGraph era -> PDoc
pcForest (Proposals era
p forall s a. s -> Getting a s a -> a
^. forall era. Lens' (Proposals era) (GovRelation PGraph era)
pGraphL))
    ]

pcPEdges :: PEdges (GovPurposeId purpose era) -> PDoc
pcPEdges :: forall (purpose :: GovActionPurpose) era.
PEdges (GovPurposeId purpose era) -> PDoc
pcPEdges (PEdges StrictMaybe (GovPurposeId purpose era)
x Set (GovPurposeId purpose era)
y) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PEdges"
    [ (Text
"parent edge", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId purpose era)
x)
    , (Text
"children", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId Set (GovPurposeId purpose era)
y)
    ]

pcForest :: GovRelation PGraph era -> PDoc
pcForest :: forall era. GovRelation PGraph era -> PDoc
pcForest (GovRelation PGraph (GovPurposeId 'PParamUpdatePurpose era)
a PGraph (GovPurposeId 'HardForkPurpose era)
b PGraph (GovPurposeId 'CommitteePurpose era)
c PGraph (GovPurposeId 'ConstitutionPurpose era)
d) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Forest PGraph"
    [ (Text
"pparamupdate", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId forall (purpose :: GovActionPurpose) era.
PEdges (GovPurposeId purpose era) -> PDoc
pcPEdges (forall a. PGraph a -> Map a (PEdges a)
unPGraph PGraph (GovPurposeId 'PParamUpdatePurpose era)
a))
    , (Text
"hardfork", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId forall (purpose :: GovActionPurpose) era.
PEdges (GovPurposeId purpose era) -> PDoc
pcPEdges (forall a. PGraph a -> Map a (PEdges a)
unPGraph PGraph (GovPurposeId 'HardForkPurpose era)
b))
    , (Text
"committee", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId forall (purpose :: GovActionPurpose) era.
PEdges (GovPurposeId purpose era) -> PDoc
pcPEdges (forall a. PGraph a -> Map a (PEdges a)
unPGraph PGraph (GovPurposeId 'CommitteePurpose era)
c))
    , (Text
"constitution", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId forall (purpose :: GovActionPurpose) era.
PEdges (GovPurposeId purpose era) -> PDoc
pcPEdges (forall a. PGraph a -> Map a (PEdges a)
unPGraph PGraph (GovPurposeId 'ConstitutionPurpose era)
d))
    ]

instance Reflect era => PrettyA (Proposals era) where
  prettyA :: Proposals era -> PDoc
prettyA = forall era. Proposals era -> PDoc
pcProposals

pcGovActionState :: GovActionState era -> PDoc
pcGovActionState :: forall era. GovActionState era -> PDoc
pcGovActionState gas :: GovActionState era
gas@(GovActionState GovActionId (EraCrypto era)
_ Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
_ Map (Credential 'DRepRole (EraCrypto era)) Vote
_ Map (KeyHash 'StakePool (EraCrypto era)) Vote
_ ProposalProcedure era
_ EpochNo
_ EpochNo
_) =
  let GovActionState {Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
Map (Credential 'DRepRole (EraCrypto era)) Vote
Map (KeyHash 'StakePool (EraCrypto era)) Vote
ProposalProcedure era
GovActionId (EraCrypto era)
EpochNo
gasExpiresAfter :: forall era. GovActionState era -> EpochNo
gasProposedIn :: forall era. GovActionState era -> EpochNo
gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasStakePoolVotes :: forall era.
GovActionState era -> Map (KeyHash 'StakePool (EraCrypto era)) Vote
gasDRepVotes :: forall era.
GovActionState era
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
gasCommitteeVotes :: forall era.
GovActionState era
-> Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
gasId :: forall era. GovActionState era -> GovActionId (EraCrypto era)
gasExpiresAfter :: EpochNo
gasProposedIn :: EpochNo
gasProposalProcedure :: ProposalProcedure era
gasStakePoolVotes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
gasDRepVotes :: Map (Credential 'DRepRole (EraCrypto era)) Vote
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
gasId :: GovActionId (EraCrypto era)
..} = GovActionState era
gas
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"GovActionState"
        [ (Text
"Id", forall c. GovActionId c -> PDoc
pcGovActionId GovActionId (EraCrypto era)
gasId)
        , (Text
"CommitteVotes", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Vote -> PDoc
pcVote Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
gasCommitteeVotes)
        , (Text
"DRepVotes", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Vote -> PDoc
pcVote Map (Credential 'DRepRole (EraCrypto era)) Vote
gasDRepVotes)
        , (Text
"StakePoolVotes", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash Vote -> PDoc
pcVote Map (KeyHash 'StakePool (EraCrypto era)) Vote
gasStakePoolVotes)
        , (Text
"Procedure", forall era. ProposalProcedure era -> PDoc
pcProposalProcedure ProposalProcedure era
gasProposalProcedure)
        , (Text
"Proposed In", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
gasProposedIn)
        , (Text
"Expires After", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
gasExpiresAfter)
        ]

instance PrettyA (GovActionState era) where
  prettyA :: GovActionState era -> PDoc
prettyA = forall era. GovActionState era -> PDoc
pcGovActionState

pcVote :: Vote -> PDoc
pcVote :: Vote -> PDoc
pcVote Vote
x = forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show Vote
x)

instance PrettyA Vote where
  prettyA :: Vote -> PDoc
prettyA = Vote -> PDoc
pcVote

pcCommittee :: Committee era -> PDoc
pcCommittee :: forall era. Committee era -> PDoc
pcCommittee (Committee Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
mem UnitInterval
quor) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Committee"
    [ (Text
"members", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall ann. EpochNo -> Doc ann
ppEpochNo Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
mem)
    , (Text
"quorum", UnitInterval -> PDoc
ppUnitInterval UnitInterval
quor)
    ]

instance PrettyA (Committee era) where
  prettyA :: Committee era -> PDoc
prettyA = forall era. Committee era -> PDoc
pcCommittee

pcGovAction :: GovAction era -> PDoc
pcGovAction :: forall era. GovAction era -> PDoc
pcGovAction GovAction era
x = case GovAction era
x of
  (ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
pgaid PParamsUpdate era
_ppup StrictMaybe (ScriptHash (EraCrypto era))
policy) ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ParameterChange"
      [ (Text
"PrevGovActId", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
pgaid)
      , (Text
"PPUpdate", forall a. [Char] -> Doc a
ppString [Char]
"(PParamsUpdate ...)")
      , (Text
"Policy", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall t. PrettyA t => t -> PDoc
prettyA StrictMaybe (ScriptHash (EraCrypto era))
policy)
      ]
  (HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
pgaid ProtVer
pv) ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"HardForkInitiation"
      [ (Text
"PrevGovActId", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'HardForkPurpose era)
pgaid)
      , (Text
"ProtVer", forall a. [Char] -> Doc a
ppString (ProtVer -> [Char]
showProtver ProtVer
pv))
      ]
  (TreasuryWithdrawals Map (RewardAccount (EraCrypto era)) Coin
ws StrictMaybe (ScriptHash (EraCrypto era))
policy) ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"TreasuryWithdrawals"
      [ (Text
"Withdrawals", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. RewardAccount c -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map (RewardAccount (EraCrypto era)) Coin
ws)
      , (Text
"Policy", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall t. PrettyA t => t -> PDoc
prettyA StrictMaybe (ScriptHash (EraCrypto era))
policy)
      ]
  (NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
pgaid) ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"NoConfidence" [(Text
"PrevGovActId", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'CommitteePurpose era)
pgaid)]
  (UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
pgaid Set (Credential 'ColdCommitteeRole (EraCrypto era))
toRemove Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
toAdd UnitInterval
quor) ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"NewCommittee"
      [ (Text
"PrevGovActId", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'CommitteePurpose era)
pgaid)
      , (Text
"membersToRemove", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Set (Credential 'ColdCommitteeRole (EraCrypto era))
toRemove)
      , (Text
"membersToAdd", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall ann. EpochNo -> Doc ann
ppEpochNo Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
toAdd)
      , (Text
"quorum", UnitInterval -> PDoc
ppUnitInterval UnitInterval
quor)
      ]
  (NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
pgaid Constitution era
c) ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"NewConstitution"
      [ (Text
"PrevGovActId", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
pgaid)
      , (Text
"Constitution", forall c. Constitution c -> PDoc
pcConstitution Constitution era
c)
      ]
  GovAction era
InfoAction -> forall a. [Char] -> Doc a
ppString [Char]
"InfoAction"

instance PrettyA (GovAction era) where
  prettyA :: GovAction era -> PDoc
prettyA = forall era. GovAction era -> PDoc
pcGovAction

pcConstitution :: Constitution c -> PDoc
pcConstitution :: forall c. Constitution c -> PDoc
pcConstitution (Constitution Anchor (EraCrypto c)
x StrictMaybe (ScriptHash (EraCrypto c))
y) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Constitution"
    [(Text
"anchor", forall c. Anchor c -> PDoc
pcAnchor Anchor (EraCrypto c)
x), (Text
"scripthash", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall era. ScriptHash era -> PDoc
pcScriptHash StrictMaybe (ScriptHash (EraCrypto c))
y)]

instance PrettyA (Constitution c) where
  prettyA :: Constitution c -> PDoc
prettyA = forall c. Constitution c -> PDoc
pcConstitution

ppCommitteeAuthorization :: CommitteeAuthorization c -> PDoc
ppCommitteeAuthorization :: forall c. CommitteeAuthorization c -> PDoc
ppCommitteeAuthorization =
  \case
    CommitteeHotCredential Credential 'HotCommitteeRole c
hk -> Text -> [PDoc] -> PDoc
ppSexp Text
"CommitteeHotCredential" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'HotCommitteeRole c
hk]
    CommitteeMemberResigned StrictMaybe (Anchor c)
anchor -> Text -> [PDoc] -> PDoc
ppSexp Text
"CommitteeMemberResigned" [forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c. Anchor c -> PDoc
pcAnchor StrictMaybe (Anchor c)
anchor]

instance PrettyA (CommitteeAuthorization c) where
  prettyA :: CommitteeAuthorization c -> PDoc
prettyA = forall c. CommitteeAuthorization c -> PDoc
ppCommitteeAuthorization

pcCommitteeState :: CommitteeState era -> PDoc
pcCommitteeState :: forall era. CommitteeState era -> PDoc
pcCommitteeState CommitteeState era
x = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall c. CommitteeAuthorization c -> PDoc
ppCommitteeAuthorization (forall era.
CommitteeState era
-> Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era))
csCommitteeCreds CommitteeState era
x)

instance (PrettyA (CommitteeState era)) where
  prettyA :: CommitteeState era -> PDoc
prettyA = forall era. CommitteeState era -> PDoc
pcCommitteeState

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

pcReward :: Reward c -> PDoc
pcReward :: forall c. Reward c -> PDoc
pcReward (Reward RewardType
ty KeyHash 'StakePool c
pl Coin
c) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Reward"
    [ (Text
"type", RewardType -> PDoc
ppRewardType RewardType
ty)
    , (Text
"pool", forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'StakePool c
pl)
    , (Text
"amount", Coin -> PDoc
pcCoin Coin
c)
    ]

instance PrettyA (Reward c) where
  prettyA :: Reward c -> PDoc
prettyA = forall c. Reward c -> PDoc
pcReward

pcFutureGenDeleg :: FutureGenDeleg c -> PDoc
pcFutureGenDeleg :: forall c. FutureGenDeleg c -> PDoc
pcFutureGenDeleg (FutureGenDeleg (SlotNo Word64
x) KeyHash 'Genesis c
y) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"FutGenDeleg"
    [ (Text
"slot", forall a. Word64 -> Doc a
ppWord64 Word64
x)
    , (Text
"keyHash", forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash KeyHash 'Genesis c
y)
    ]

instance PrettyA (FutureGenDeleg c) where
  prettyA :: FutureGenDeleg c -> PDoc
prettyA = forall c. FutureGenDeleg c -> PDoc
pcFutureGenDeleg

instance PrettyA (GenDelegPair c) where
  prettyA :: GenDelegPair c -> PDoc
prettyA = forall c. GenDelegPair c -> PDoc
pcGenDelegPair

pcCertState :: CertState era -> PDoc
pcCertState :: forall era. CertState era -> PDoc
pcCertState (CertState VState era
vst PState era
pst DState era
dst) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"CertState"
    [ (Text
"pstate", forall c. PState c -> PDoc
pcPState PState era
pst)
    , (Text
"vstate", forall era. VState era -> PDoc
pcVState VState era
vst)
    , (Text
"dstate", forall c. DState c -> PDoc
pcDState DState era
dst)
    ]

pcVState :: VState era -> PDoc
pcVState :: forall era. VState era -> PDoc
pcVState (VState Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dreps CommitteeState era
committeeState EpochNo
numDormantEpochs) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"VState"
    [ (Text
"DReps", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall c. DRepState c -> PDoc
pcDRepState Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dreps)
    , (Text
"CC Hot Keys", forall era. CommitteeState era -> PDoc
pcCommitteeState CommitteeState era
committeeState)
    , (Text
"Number of dormant epochs", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
numDormantEpochs)
    ]

instance PrettyA (VState era) where
  prettyA :: VState era -> PDoc
prettyA VState era
st = forall era. VState era -> PDoc
pcVState VState era
st

pcAnchor :: Anchor c -> PDoc
pcAnchor :: forall c. Anchor c -> PDoc
pcAnchor (Anchor Url
u SafeHash c AnchorData
h) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Anchor"
    [ (Text
"url", forall a. [Char] -> Doc a
ppString (forall a. Show a => a -> [Char]
show Url
u))
    , (Text
"datahash", PDoc -> PDoc
trim forall a b. (a -> b) -> a -> b
$ forall c index. SafeHash c index -> PDoc
ppSafeHash SafeHash c AnchorData
h)
    ]

instance PrettyA (Anchor c) where
  prettyA :: Anchor c -> PDoc
prettyA = forall c. Anchor c -> PDoc
pcAnchor

pcDRepState :: DRepState c -> PDoc
pcDRepState :: forall c. DRepState c -> PDoc
pcDRepState (DRepState EpochNo
expire StrictMaybe (Anchor c)
anchor Coin
deposit Set (Credential 'Staking c)
delegs) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"DRepState"
    [ (Text
"expire", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
expire)
    , (Text
"anchor", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall c. Anchor c -> PDoc
pcAnchor StrictMaybe (Anchor c)
anchor)
    , (Text
"deposit", Coin -> PDoc
pcCoin Coin
deposit)
    , (Text
"delegations", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Set (Credential 'Staking c)
delegs)
    ]

instance PrettyA (DRepState c) where
  prettyA :: DRepState c -> PDoc
prettyA = forall c. DRepState c -> PDoc
pcDRepState

pcDRep :: DRep c -> PDoc
pcDRep :: forall c. DRep c -> PDoc
pcDRep (DRepCredential Credential 'DRepRole c
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"DRepCred" [forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Credential 'DRepRole c
cred]
pcDRep DRep c
DRepAlwaysAbstain = Text -> [PDoc] -> PDoc
ppSexp Text
"DRep" [forall a. [Char] -> Doc a
ppString [Char]
"Abstain"]
pcDRep DRep c
DRepAlwaysNoConfidence = Text -> [PDoc] -> PDoc
ppSexp Text
"DRep" [forall a. [Char] -> Doc a
ppString [Char]
"NoConfidence"]

instance PrettyA (DRep c) where
  prettyA :: DRep c -> PDoc
prettyA = forall c. DRep c -> PDoc
pcDRep

pcSnapShotL :: Text -> SnapShot c -> [(Text, PDoc)]
pcSnapShotL :: forall c. Text -> SnapShot c -> [(Text, PDoc)]
pcSnapShotL Text
prefix SnapShot c
ss =
  [ (Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
"Stake", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential (Coin -> PDoc
pcCoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Compactible a => CompactForm a -> a
fromCompact) (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap (forall c.
Stake c -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
unStake (forall c. SnapShot c -> Stake c
ssStake SnapShot c
ss))))
  , (Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
"Delegs", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap (forall c.
SnapShot c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
ssDelegations SnapShot c
ss)))
  , (Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
"Pools", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall era. PoolParams era -> PDoc
pcPoolParams (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap (forall c.
SnapShot c -> VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
ssPoolParams SnapShot c
ss)))
  ]

pcIndividualPoolStake :: IndividualPoolStake c -> PDoc
pcIndividualPoolStake :: forall c. IndividualPoolStake c -> PDoc
pcIndividualPoolStake IndividualPoolStake c
x =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"IPS"
    [ (Text
"ratio", forall a. Rational -> Doc a
ppRational (forall c. IndividualPoolStake c -> Rational
individualPoolStake IndividualPoolStake c
x))
    , (Text
"vrf", PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash (forall c. IndividualPoolStake c -> Hash c (VerKeyVRF c)
individualPoolStakeVrf IndividualPoolStake c
x)))
    ]

instance PrettyA (IndividualPoolStake c) where prettyA :: IndividualPoolStake c -> PDoc
prettyA = forall c. IndividualPoolStake c -> PDoc
pcIndividualPoolStake

pcSnapShots :: SnapShots c -> PDoc
pcSnapShots :: forall c. SnapShots c -> PDoc
pcSnapShots SnapShots c
sss =
  PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' PDoc
"" forall a b. (a -> b) -> a -> b
$
    forall c. Text -> SnapShot c -> [(Text, PDoc)]
pcSnapShotL Text
"mark" (forall c. SnapShots c -> SnapShot c
ssStakeMark SnapShots c
sss)
      forall a. [a] -> [a] -> [a]
++ [(Text
"markPoolDistr", forall c. PoolDistr c -> PDoc
pcPoolDistr (forall c. SnapShots c -> PoolDistr c
ssStakeMarkPoolDistr SnapShots c
sss))]
      forall a. [a] -> [a] -> [a]
++ forall c. Text -> SnapShot c -> [(Text, PDoc)]
pcSnapShotL Text
"set" (forall c. SnapShots c -> SnapShot c
ssStakeSet SnapShots c
sss)
      forall a. [a] -> [a] -> [a]
++ forall c. Text -> SnapShot c -> [(Text, PDoc)]
pcSnapShotL Text
"go" (forall c. SnapShots c -> SnapShot c
ssStakeGo SnapShots c
sss)
      forall a. [a] -> [a] -> [a]
++ [(Text
"fee", Coin -> PDoc
pcCoin (forall c. SnapShots c -> Coin
ssFee SnapShots c
sss))]

instance PrettyA (SnapShots c) where prettyA :: SnapShots c -> PDoc
prettyA = forall c. SnapShots c -> PDoc
pcSnapShots

pcPoolDistr :: PoolDistr c -> PDoc
pcPoolDistr :: forall c. PoolDistr c -> PDoc
pcPoolDistr (PoolDistr Map (KeyHash 'StakePool c) (IndividualPoolStake c)
pdistr CompactForm Coin
tot) =
  forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall c. IndividualPoolStake c -> PDoc
pcIndividualPoolStake Map (KeyHash 'StakePool c) (IndividualPoolStake c)
pdistr
    forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> Doc a
ppString [Char]
" total = "
    forall a. Semigroup a => a -> a -> a
<> forall a. Rational -> Doc a
ppRational (forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall a. Num a => a -> a -> a
(+) Rational
0 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c. IndividualPoolStake c -> Rational
individualPoolStake Map (KeyHash 'StakePool c) (IndividualPoolStake c)
pdistr))
    forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> Doc a
ppString [Char]
" actualTotal = "
    forall a. Semigroup a => a -> a -> a
<> Coin -> PDoc
pcCoin (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
tot)

instance PrettyA (PoolDistr c) where prettyA :: PoolDistr c -> PDoc
prettyA = forall c. PoolDistr c -> PDoc
pcPoolDistr

withEraPParams :: forall era a. Proof era -> (Core.EraPParams era => a) -> a
withEraPParams :: forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
Shelley EraPParams era => a
x = EraPParams era => a
x
withEraPParams Proof era
Mary EraPParams era => a
x = EraPParams era => a
x
withEraPParams Proof era
Allegra EraPParams era => a
x = EraPParams era => a
x
withEraPParams Proof era
Alonzo EraPParams era => a
x = EraPParams era => a
x
withEraPParams Proof era
Babbage EraPParams era => a
x = EraPParams era => a
x
withEraPParams Proof era
Conway EraPParams era => a
x = EraPParams era => a
x

-- | Print just a few of the PParams fields
pcPParamsSynopsis :: forall era. Proof era -> Core.PParams era -> PDoc
pcPParamsSynopsis :: forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p PParams era
x = forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p EraPParams era => PDoc
help
  where
    help :: Core.EraPParams era => PDoc
    help :: EraPParams era => PDoc
help =
      Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"PParams (synopsis)"
        [ (Text
"maxBBSize", forall a. Word32 -> Doc a
ppWord32 (PParams era
x forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Word32
Core.ppMaxBBSizeL))
        , (Text
"maxBHSize", forall a. Word16 -> Doc a
ppWord16 (PParams era
x forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Word16
Core.ppMaxBHSizeL))
        , (Text
"maxTxSize", forall a. Word32 -> Doc a
ppWord32 (PParams era
x forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Word32
Core.ppMaxTxSizeL))
        , (Text
"poolDeposit", Coin -> PDoc
pcCoin (PParams era
x forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
Core.ppPoolDepositL))
        , (Text
"keyDeposit", Coin -> PDoc
pcCoin (PParams era
x forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
Core.ppKeyDepositL))
        , (Text
"protVer", forall a. [Char] -> Doc a
ppString (ProtVer -> [Char]
showProtver (PParams era
x forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
Core.ppProtocolVersionL)))
        ]

showProtver :: ProtVer -> String
showProtver :: ProtVer -> [Char]
showProtver (ProtVer Version
x Natural
y) = [Char]
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Version
x forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Natural
y forall a. [a] -> [a] -> [a]
++ [Char]
")"

pcEpochState :: Reflect era => Proof era -> EpochState era -> PDoc
pcEpochState :: forall era. Reflect era => Proof era -> EpochState era -> PDoc
pcEpochState Proof era
proof es :: EpochState era
es@(EpochState (AccountState Coin
tre Coin
res) LedgerState era
ls SnapShots (EraCrypto era)
sss NonMyopic (EraCrypto era)
nonmy) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"EpochState"
    [ (Text
"AccountState", PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' PDoc
"" [(Text
"treasury", Coin -> PDoc
pcCoin Coin
tre), (Text
"reserves", Coin -> PDoc
pcCoin Coin
res)])
    , (Text
"LedgerState", forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
proof LedgerState era
ls)
    , (Text
"SnapShots", forall c. SnapShots c -> PDoc
pcSnapShots SnapShots (EraCrypto era)
sss)
    , (Text
"NonMyopic", forall c. NonMyopic c -> PDoc
ppNonMyopic NonMyopic (EraCrypto era)
nonmy)
    , (Text
"AdaPots", forall era. (EraTxOut era, EraGov era) => EpochState era -> PDoc
pcAdaPot EpochState era
es)
    ]

instance Reflect era => PrettyA (EpochState era) where
  prettyA :: EpochState era -> PDoc
prettyA = forall era. Reflect era => Proof era -> EpochState era -> PDoc
pcEpochState forall era. Reflect era => Proof era
reify

pcAccountState :: AccountState -> PDoc
pcAccountState :: AccountState -> PDoc
pcAccountState (AccountState Coin
tr Coin
re) = PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' PDoc
"" [(Text
"treasury", Coin -> PDoc
pcCoin Coin
tr), (Text
"reserves", Coin -> PDoc
pcCoin Coin
re)]

instance PrettyA AccountState where
  prettyA :: AccountState -> PDoc
prettyA = AccountState -> PDoc
pcAccountState

-- | Like pcEpochState.but it only prints a summary of the UTxO
psEpochState :: Reflect era => Proof era -> EpochState era -> PDoc
psEpochState :: forall era. Reflect era => Proof era -> EpochState era -> PDoc
psEpochState Proof era
proof es :: EpochState era
es@(EpochState (AccountState Coin
tre Coin
res) LedgerState era
ls SnapShots (EraCrypto era)
sss NonMyopic (EraCrypto era)
_) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"EpochState"
    [ (Text
"AccountState", PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' PDoc
"" [(Text
"treasury", Coin -> PDoc
pcCoin Coin
tre), (Text
"reserves", Coin -> PDoc
pcCoin Coin
res)])
    , (Text
"LedgerState", forall era. Reflect era => Proof era -> LedgerState era -> PDoc
psLedgerState Proof era
proof LedgerState era
ls)
    , (Text
"SnapShots", forall c. SnapShots c -> PDoc
pcSnapShots SnapShots (EraCrypto era)
sss)
    , (Text
"AdaPots", forall era. (EraTxOut era, EraGov era) => EpochState era -> PDoc
pcAdaPot EpochState era
es)
    ]

pcNewEpochState :: Reflect era => Proof era -> NewEpochState era -> PDoc
pcNewEpochState :: forall era. Reflect era => Proof era -> NewEpochState era -> PDoc
pcNewEpochState Proof era
proof (NewEpochState EpochNo
en (BlocksMade Map (KeyHash 'StakePool (EraCrypto era)) Natural
pbm) (BlocksMade Map (KeyHash 'StakePool (EraCrypto era)) Natural
cbm) EpochState era
es StrictMaybe (PulsingRewUpdate (EraCrypto era))
_ (PoolDistr Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
pd CompactForm Coin
_) StashedAVVMAddresses era
_) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"NewEpochState"
    [ (Text
"EpochState", forall era. Reflect era => Proof era -> EpochState era -> PDoc
pcEpochState Proof era
proof EpochState era
es)
    , (Text
"PoolDistr", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall c. IndividualPoolStake c -> PDoc
pcIndividualPoolStake Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
pd)
    , (Text
"Prev Blocks", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool (EraCrypto era)) Natural
pbm)
    , (Text
"Current Blocks", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool (EraCrypto era)) Natural
cbm)
    , (Text
"EpochNo", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
en)
    ]

instance Reflect era => PrettyA (NewEpochState era) where prettyA :: NewEpochState era -> PDoc
prettyA = forall era. Reflect era => Proof era -> NewEpochState era -> PDoc
pcNewEpochState forall era. Reflect era => Proof era
reify

-- | Like pcEpochState.but it only prints a summary of the UTxO
psNewEpochState :: Reflect era => Proof era -> NewEpochState era -> PDoc
psNewEpochState :: forall era. Reflect era => Proof era -> NewEpochState era -> PDoc
psNewEpochState Proof era
proof (NewEpochState EpochNo
en (BlocksMade Map (KeyHash 'StakePool (EraCrypto era)) Natural
pbm) (BlocksMade Map (KeyHash 'StakePool (EraCrypto era)) Natural
cbm) EpochState era
es StrictMaybe (PulsingRewUpdate (EraCrypto era))
_ (PoolDistr Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
pd CompactForm Coin
_) StashedAVVMAddresses era
_) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"NewEpochState"
    [ (Text
"EpochState", forall era. Reflect era => Proof era -> EpochState era -> PDoc
psEpochState Proof era
proof EpochState era
es)
    , (Text
"PoolDistr", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall c. IndividualPoolStake c -> PDoc
pcIndividualPoolStake Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
pd)
    , (Text
"Prev Blocks", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool (EraCrypto era)) Natural
pbm)
    , (Text
"Current Blocks", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool (EraCrypto era)) Natural
cbm)
    , (Text
"EpochNo", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
en)
    ]

pcUTxOState :: Proof era -> UTxOState era -> PDoc
pcUTxOState :: forall era. Proof era -> UTxOState era -> PDoc
pcUTxOState Proof era
proof (UTxOState UTxO era
u Coin
dep Coin
fs GovState era
gs (IStake Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
m Map Ptr (CompactForm Coin)
_) Coin
don) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"UTxOState"
    [ (Text
"utxo", forall era. Proof era -> UTxO era -> PDoc
pcUTxO Proof era
proof UTxO era
u)
    , (Text
"deposited", Coin -> PDoc
pcCoin Coin
dep)
    , (Text
"fees", Coin -> PDoc
pcCoin Coin
fs)
    , (Text
"govState", forall era. Proof era -> GovState era -> PDoc
pcGovState Proof era
proof GovState era
gs)
    , (Text
"incremental stake distr", forall a. [Char] -> Doc a
ppString ([Char]
"size = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall k a. Map k a -> Int
Map.size Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
m))) -- This is not part of the model
    , (Text
"donation", Coin -> PDoc
pcCoin Coin
don)
    ]

instance Reflect era => PrettyA (UTxOState era) where
  prettyA :: UTxOState era -> PDoc
prettyA = forall era. Proof era -> UTxOState era -> PDoc
pcUTxOState forall era. Reflect era => Proof era
reify

-- | Like pcUTxOState, except it prints only a summary of the UTxO
psUTxOState :: forall era. Reflect era => Proof era -> UTxOState era -> PDoc
psUTxOState :: forall era. Reflect era => Proof era -> UTxOState era -> PDoc
psUTxOState Proof era
proof (UTxOState (UTxO Map (TxIn (EraCrypto era)) (TxOut era)
u) Coin
dep Coin
fs GovState era
gs (IStake Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
m Map Ptr (CompactForm Coin)
_) Coin
don) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"UTxOState"
    [ (Text
"utxo", forall a. Map a (CompactForm Coin) -> PDoc
summaryMapCompact (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\TxOut era
x -> TxOut era
x forall s a. s -> Getting a s a -> a
^. forall era.
(HasCallStack, EraTxOut era) =>
Lens' (TxOut era) (CompactForm Coin)
compactCoinTxOutL) Map (TxIn (EraCrypto era)) (TxOut era)
u))
    , (Text
"deposited", Coin -> PDoc
pcCoin Coin
dep)
    , (Text
"fees", Coin -> PDoc
pcCoin Coin
fs)
    , (Text
"govState", forall era. Proof era -> GovState era -> PDoc
pcGovState Proof era
proof GovState era
gs)
    , (Text
"incremental stake distr", forall a. [Char] -> Doc a
ppString ([Char]
"size = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall k a. Map k a -> Int
Map.size Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
m))) -- This is not part of the model
    , (Text
"donation", Coin -> PDoc
pcCoin Coin
don)
    ]

pcLedgerState :: Proof era -> LedgerState era -> PDoc
pcLedgerState :: forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
proof LedgerState era
ls =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"LedgerState"
    [ (Text
"utxoState", forall era. Proof era -> UTxOState era -> PDoc
pcUTxOState Proof era
proof (forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls))
    , (Text
"certState", forall era. CertState era -> PDoc
pcCertState (forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls))
    ]

instance Reflect era => PrettyA (LedgerState era) where
  prettyA :: LedgerState era -> PDoc
prettyA = forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState forall era. Reflect era => Proof era
reify

-- | Like pcLedgerState, except it prints only a summary of the UTxO
psLedgerState :: Reflect era => Proof era -> LedgerState era -> PDoc
psLedgerState :: forall era. Reflect era => Proof era -> LedgerState era -> PDoc
psLedgerState Proof era
proof LedgerState era
ls =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"LedgerState"
    [ (Text
"utxoState", forall era. Reflect era => Proof era -> UTxOState era -> PDoc
psUTxOState Proof era
proof (forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls))
    , (Text
"certState", forall era. CertState era -> PDoc
pcCertState (forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls))
    ]

pcPState :: PState era -> PDoc
pcPState :: forall c. PState c -> PDoc
pcPState (PState Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
regP Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
fregP Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
ret Map (KeyHash 'StakePool (EraCrypto era)) Coin
dep) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PState"
    [ (Text
"regPools", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall era. PoolParams era -> PDoc
pcPoolParams Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
regP)
    , (Text
"futureRegPools", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall era. PoolParams era -> PDoc
pcPoolParams Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
fregP)
    , (Text
"retiring", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall ann. EpochNo -> Doc ann
ppEpochNo Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
ret)
    , (Text
"poolDeposits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash Coin -> PDoc
pcCoin Map (KeyHash 'StakePool (EraCrypto era)) Coin
dep)
    ]

instance PrettyA (PState era) where
  prettyA :: PState era -> PDoc
prettyA = forall c. PState c -> PDoc
pcPState

pcDState :: DState c -> PDoc
pcDState :: forall c. DState c -> PDoc
pcDState DState c
ds =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"DState"
    [ (Text
"rewards", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Coin -> PDoc
pcCoin (forall c. UMap c -> Map (Credential 'Staking c) Coin
rewardMap (forall era. DState era -> UMap (EraCrypto era)
dsUnified DState c
ds)))
    , (Text
"deposits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Coin -> PDoc
pcCoin (forall c. UMap c -> Map (Credential 'Staking c) Coin
depositMap (forall era. DState era -> UMap (EraCrypto era)
dsUnified DState c
ds)))
    , (Text
"delegate", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash (forall c.
UMap c -> Map (Credential 'Staking c) (KeyHash 'StakePool c)
sPoolMap (forall era. DState era -> UMap (EraCrypto era)
dsUnified DState c
ds)))
    , (Text
"drepDeleg", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall c. DRep c -> PDoc
pcDRep (forall c. UMap c -> Map (Credential 'Staking c) (DRep c)
dRepMap (forall era. DState era -> UMap (EraCrypto era)
dsUnified DState c
ds)))
    , (Text
"ptrs", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Ptr -> PDoc
ppPtr forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential (forall c. UMap c -> Map Ptr (Credential 'Staking c)
ptrMap (forall era. DState era -> UMap (EraCrypto era)
dsUnified DState c
ds)))
    , (Text
"fGenDel", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. FutureGenDeleg c -> PDoc
pcFutureGenDeleg forall c. GenDelegPair c -> PDoc
pcGenDelegPair (forall era.
DState era
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
dsFutureGenDelegs DState c
ds))
    , (Text
"GenDel", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash forall c. GenDelegPair c -> PDoc
pcGenDelegPair (forall c. GenDelegs c -> Map (KeyHash 'Genesis c) (GenDelegPair c)
unGenDelegs (forall era. DState era -> GenDelegs (EraCrypto era)
dsGenDelegs DState c
ds)))
    , (Text
"iRewards", forall c. InstantaneousRewards c -> PDoc
pcIRewards (forall era. DState era -> InstantaneousRewards (EraCrypto era)
dsIRewards DState c
ds))
    ]

instance PrettyA (DState era) where
  prettyA :: DState era -> PDoc
prettyA = forall c. DState c -> PDoc
pcDState

pcGenDelegPair :: GenDelegPair c -> PDoc
pcGenDelegPair :: forall c. GenDelegPair c -> PDoc
pcGenDelegPair GenDelegPair c
x =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"GDPair"
    [ (Text
"keyhash", forall (discriminator :: KeyRole) c.
KeyHash discriminator c -> PDoc
pcKeyHash (forall c. GenDelegPair c -> KeyHash 'GenesisDelegate c
genDelegKeyHash GenDelegPair c
x))
    , (Text
"vrfhash", PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash (forall c. GenDelegPair c -> Hash c (VerKeyVRF c)
genDelegVrfHash GenDelegPair c
x)))
    ]

pcIRewards :: InstantaneousRewards c -> PDoc
pcIRewards :: forall c. InstantaneousRewards c -> PDoc
pcIRewards InstantaneousRewards c
xs =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"IReward"
    [ (Text
"reserves", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Coin -> PDoc
pcCoin (forall c.
InstantaneousRewards c -> Map (Credential 'Staking c) Coin
DP.iRReserves InstantaneousRewards c
xs))
    , (Text
"treasury", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential Coin -> PDoc
pcCoin (forall c.
InstantaneousRewards c -> Map (Credential 'Staking c) Coin
DP.iRTreasury InstantaneousRewards c
xs))
    , (Text
"deltaR", DeltaCoin -> PDoc
pcDeltaCoin (forall c. InstantaneousRewards c -> DeltaCoin
DP.deltaReserves InstantaneousRewards c
xs))
    , (Text
"deltaT", DeltaCoin -> PDoc
pcDeltaCoin (forall c. InstantaneousRewards c -> DeltaCoin
DP.deltaTreasury InstantaneousRewards c
xs))
    ]

instance PrettyA (InstantaneousRewards c) where
  prettyA :: InstantaneousRewards c -> PDoc
prettyA = forall c. InstantaneousRewards c -> PDoc
pcIRewards

pcDeltaCoin :: DeltaCoin -> PDoc
pcDeltaCoin :: DeltaCoin -> PDoc
pcDeltaCoin (DeltaCoin Integer
n) = forall ann. [Doc ann] -> Doc ann
hsep [forall a. [Char] -> Doc a
ppString [Char]
"▵₳", forall a. Integer -> Doc a
ppInteger Integer
n]

instance PrettyA DeltaCoin where
  prettyA :: DeltaCoin -> PDoc
prettyA = DeltaCoin -> PDoc
pcDeltaCoin

pcSlotNo :: SlotNo -> PDoc
pcSlotNo :: SlotNo -> PDoc
pcSlotNo (SlotNo Word64
n) = forall a. Word64 -> Doc a
ppWord64 Word64
n

instance PrettyA SlotNo where
  prettyA :: SlotNo -> PDoc
prettyA = SlotNo -> PDoc
pcSlotNo

instance PrettyA DP.Obligations where
  prettyA :: Obligations -> PDoc
prettyA = forall a ann. Show a => a -> Doc ann
viaShow

pcAdaPot ::
  ( EraTxOut era
  , EraGov era
  ) =>
  EpochState era ->
  PDoc
pcAdaPot :: forall era. (EraTxOut era, EraGov era) => EpochState era -> PDoc
pcAdaPot EpochState era
es =
  let x :: AdaPots
x = forall era. (EraTxOut era, EraGov era) => EpochState era -> AdaPots
totalAdaPotsES EpochState era
es
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"AdaPot"
        [ (Text
"treasury", Coin -> PDoc
pcCoin (AdaPots -> Coin
treasuryAdaPot AdaPots
x))
        , (Text
"rewards", Coin -> PDoc
pcCoin (AdaPots -> Coin
rewardsAdaPot AdaPots
x))
        , (Text
"utxo", Coin -> PDoc
pcCoin (AdaPots -> Coin
utxoAdaPot AdaPots
x))
        , (Text
"fees", Coin -> PDoc
pcCoin (AdaPots -> Coin
feesAdaPot AdaPots
x))
        , (Text
"obligations", forall t. PrettyA t => t -> PDoc
prettyA (AdaPots -> Obligations
obligationsPot AdaPots
x))
        , (Text
"totalAda", Coin -> PDoc
pcCoin (forall era. (EraTxOut era, EraGov era) => EpochState era -> Coin
totalAdaES EpochState era
es))
        ]

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

pcPolicyID :: PolicyID c -> PDoc
pcPolicyID :: forall c. PolicyID c -> PDoc
pcPolicyID (PolicyID ScriptHash c
sh) = forall era. ScriptHash era -> PDoc
pcScriptHash ScriptHash c
sh

instance PrettyA (PolicyID c) where
  prettyA :: PolicyID c -> PDoc
prettyA = forall c. PolicyID c -> PDoc
pcPolicyID

pcAssetName :: AssetName -> PDoc
pcAssetName :: AssetName -> PDoc
pcAssetName AssetName
x = PDoc -> PDoc
trim (forall a ann. Show a => a -> Doc ann
viaShow AssetName
x)

instance PrettyA AssetName where
  prettyA :: AssetName -> PDoc
prettyA = AssetName -> PDoc
pcAssetName

pcMultiAsset :: MultiAsset c -> PDoc
pcMultiAsset :: forall c. MultiAsset c -> PDoc
pcMultiAsset MultiAsset c
m = forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall {c}. (PolicyID c, AssetName, Integer) -> PDoc
pptriple (forall c. MultiAsset c -> [(PolicyID c, AssetName, Integer)]
flattenMultiAsset MultiAsset c
m)
  where
    pptriple :: (PolicyID c, AssetName, Integer) -> PDoc
pptriple (PolicyID c
i, AssetName
asset, Integer
num) = forall ann. [Doc ann] -> Doc ann
hsep [PDoc
"(", forall c. PolicyID c -> PDoc
pcPolicyID PolicyID c
i, AssetName -> PDoc
pcAssetName AssetName
asset, forall a. Integer -> Doc a
ppInteger Integer
num, PDoc
")"]

instance PrettyA (MultiAsset c) where
  prettyA :: MultiAsset c -> PDoc
prettyA = forall c. MultiAsset c -> PDoc
pcMultiAsset

instance PrettyA ix => PrettyA (AsIx ix it) where
  prettyA :: AsIx ix it -> PDoc
prettyA (AsIx ix
ix) = Text -> [PDoc] -> PDoc
ppSexp Text
"AsIx" [forall t. PrettyA t => t -> PDoc
prettyA ix
ix]

instance PrettyA it => PrettyA (AsItem ix it) where
  prettyA :: AsItem ix it -> PDoc
prettyA (AsItem it
it) = Text -> [PDoc] -> PDoc
ppSexp Text
"AsItem" [forall t. PrettyA t => t -> PDoc
prettyA it
it]

instance (PrettyA ix, PrettyA it) => PrettyA (AsIxItem ix it) where
  prettyA :: AsIxItem ix it -> PDoc
prettyA (AsIxItem ix
ix it
it) = Text -> [PDoc] -> PDoc
ppSexp Text
"AsIxItem" [forall t. PrettyA t => t -> PDoc
prettyA ix
ix, forall t. PrettyA t => t -> PDoc
prettyA it
it]

instance
  ( forall ix it. (PrettyA ix, PrettyA it) => PrettyA (f ix it)
  , Reflect era
  , PrettyA (TxCert era)
  ) =>
  PrettyA (AlonzoPlutusPurpose f era)
  where
  prettyA :: AlonzoPlutusPurpose f era -> PDoc
prettyA = \case
    AlonzoMinting f Word32 (PolicyID (EraCrypto era))
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoMinting" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 (PolicyID (EraCrypto era))
i]
    AlonzoSpending f Word32 (TxIn (EraCrypto era))
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoSpending" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 (TxIn (EraCrypto era))
i]
    AlonzoRewarding f Word32 (RewardAccount (EraCrypto era))
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoRewarding" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 (RewardAccount (EraCrypto era))
i]
    AlonzoCertifying f Word32 (TxCert era)
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoCertifying" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 (TxCert era)
i]

instance
  ( forall ix it. (PrettyA ix, PrettyA it) => PrettyA (f ix it)
  , Reflect era
  , PrettyA (TxCert era)
  ) =>
  PrettyA (ConwayPlutusPurpose f era)
  where
  prettyA :: ConwayPlutusPurpose f era -> PDoc
prettyA = \case
    ConwayMinting f Word32 (PolicyID (EraCrypto era))
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayMinting" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 (PolicyID (EraCrypto era))
i]
    ConwaySpending f Word32 (TxIn (EraCrypto era))
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwaySpending" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 (TxIn (EraCrypto era))
i]
    ConwayRewarding f Word32 (RewardAccount (EraCrypto era))
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayRewarding" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 (RewardAccount (EraCrypto era))
i]
    ConwayCertifying f Word32 (TxCert era)
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayCertifying" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 (TxCert era)
i]
    ConwayVoting f Word32 (Voter (EraCrypto era))
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayVoting" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 (Voter (EraCrypto era))
i]
    ConwayProposing f Word32 (ProposalProcedure era)
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayProposing" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 (ProposalProcedure era)
i]

-- ScriptsNeeded is a type family so it doesn't have PrettyA instance, use pcScriptsNeeded
-- instead of prettyA
pcScriptsNeeded :: Reflect era => Proof era -> ScriptsNeeded era -> PDoc
pcScriptsNeeded :: forall era. Reflect era => Proof era -> ScriptsNeeded era -> PDoc
pcScriptsNeeded Proof era
Shelley (ShelleyScriptsNeeded Set (ScriptHash (EraCrypto (ShelleyEra StandardCrypto)))
ss) = Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto (ShelleyEra StandardCrypto)))
ss]
pcScriptsNeeded Proof era
Allegra (ShelleyScriptsNeeded Set (ScriptHash (EraCrypto (AllegraEra StandardCrypto)))
ss) = Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto (AllegraEra StandardCrypto)))
ss]
pcScriptsNeeded Proof era
Mary (ShelleyScriptsNeeded Set (ScriptHash (EraCrypto (MaryEra StandardCrypto)))
ss) = Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall era. ScriptHash era -> PDoc
pcScriptHash Set (ScriptHash (EraCrypto (MaryEra StandardCrypto)))
ss]
pcScriptsNeeded Proof era
Alonzo (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem (AlonzoEra StandardCrypto),
  ScriptHash (EraCrypto (AlonzoEra StandardCrypto)))]
pl) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair forall t. PrettyA t => t -> PDoc
prettyA forall era. ScriptHash era -> PDoc
pcScriptHash) [(PlutusPurpose AsIxItem (AlonzoEra StandardCrypto),
  ScriptHash (EraCrypto (AlonzoEra StandardCrypto)))]
pl]
pcScriptsNeeded Proof era
Babbage (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem (BabbageEra StandardCrypto),
  ScriptHash (EraCrypto (BabbageEra StandardCrypto)))]
pl) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair forall t. PrettyA t => t -> PDoc
prettyA forall era. ScriptHash era -> PDoc
pcScriptHash) [(PlutusPurpose AsIxItem (BabbageEra StandardCrypto),
  ScriptHash (EraCrypto (BabbageEra StandardCrypto)))]
pl]
pcScriptsNeeded Proof era
Conway (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem (ConwayEra StandardCrypto),
  ScriptHash (EraCrypto (ConwayEra StandardCrypto)))]
pl) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair forall t. PrettyA t => t -> PDoc
prettyA forall era. ScriptHash era -> PDoc
pcScriptHash) [(PlutusPurpose AsIxItem (ConwayEra StandardCrypto),
  ScriptHash (EraCrypto (ConwayEra StandardCrypto)))]
pl]

pcDRepPulser :: DRepPulser era Identity (RatifyState era) -> PDoc
pcDRepPulser :: forall era. DRepPulser era Identity (RatifyState era) -> PDoc
pcDRepPulser DRepPulser era Identity (RatifyState era)
x =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"DRepPulser"
    [ (Text
"pulseSize", forall a. Int -> Doc a
ppInt (forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpPulseSize DRepPulser era Identity (RatifyState era)
x))
    , (Text
"DRepUView Map", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall c. DRep c -> PDoc
pcDRep (forall c. UMap c -> Map (Credential 'Staking c) (DRep c)
dRepMap (forall era ans (m :: * -> *).
DRepPulser era m ans -> UMap (EraCrypto era)
dpUMap DRepPulser era Identity (RatifyState era)
x)))
    , (Text
"index", forall a. Int -> Doc a
ppInt (forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpIndex DRepPulser era Identity (RatifyState era)
x))
    , (Text
"stakeDistr", forall a. Map a (CompactForm Coin) -> PDoc
summaryMapCompact (forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpStakeDistr DRepPulser era Identity (RatifyState era)
x))
    , (Text
"poolDistr", forall c. PoolDistr c -> PDoc
pcPoolDistr (forall era ans (m :: * -> *).
DRepPulser era m ans -> PoolDistr (EraCrypto era)
dpStakePoolDistr DRepPulser era Identity (RatifyState era)
x))
    , (Text
"partialDrepDistr", forall a. Map a (CompactForm Coin) -> PDoc
summaryMapCompact (forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
dpDRepDistr DRepPulser era Identity (RatifyState era)
x))
    , (Text
"drepState", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall c. DRepState c -> PDoc
pcDRepState (forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepState DRepPulser era Identity (RatifyState era)
x))
    , (Text
"epoch", forall ann. EpochNo -> Doc ann
ppEpochNo (forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpCurrentEpoch DRepPulser era Identity (RatifyState era)
x))
    , (Text
"committeeState", forall era. CommitteeState era -> PDoc
pcCommitteeState (forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpCommitteeState DRepPulser era Identity (RatifyState era)
x))
    , (Text
"proposals", forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq forall era. GovActionState era -> PDoc
pcGovActionState (forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpProposals DRepPulser era Identity (RatifyState era)
x))
    , (Text
"globals", forall a. [Char] -> Doc a
ppString [Char]
"...")
    ]

summaryMapCompact :: Map a (CompactForm Coin) -> PDoc
summaryMapCompact :: forall a. Map a (CompactForm Coin) -> PDoc
summaryMapCompact Map a (CompactForm Coin)
x = forall a. [Char] -> Doc a
ppString ([Char]
"Count " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall k a. Map k a -> Int
Map.size Map a (CompactForm Coin)
x) forall a. [a] -> [a] -> [a]
++ [Char]
", Total " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall a. Semigroup a => a -> a -> a
(<>) forall a. Monoid a => a
mempty Map a (CompactForm Coin)
x))

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

pcConwayGovCertEnv :: forall era. Reflect era => ConwayGovCertEnv era -> PDoc
pcConwayGovCertEnv :: forall era. Reflect era => ConwayGovCertEnv era -> PDoc
pcConwayGovCertEnv (ConwayGovCertEnv PParams era
pp EpochNo
ce StrictMaybe (Committee era)
cc Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cp) =
  Text -> [PDoc] -> PDoc
ppSexp
    Text
"ConwayGovCertEnv"
    [ forall era. Proof era -> PParams era -> PDoc
pcPParams @era forall era. Reflect era => Proof era
reify PParams era
pp
    , forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
ce
    , forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall era. Committee era -> PDoc
pcCommittee StrictMaybe (Committee era)
cc
    , forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. GovActionId c -> PDoc
pcGovActionId forall era. GovActionState era -> PDoc
pcGovActionState forall a b. (a -> b) -> a -> b
$ forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovActionId (EraCrypto era)
unGovPurposeId Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cp
    ]

instance Reflect era => PrettyA (ConwayGovCertEnv era) where
  prettyA :: ConwayGovCertEnv era -> PDoc
prettyA = forall era. Reflect era => ConwayGovCertEnv era -> PDoc
pcConwayGovCertEnv

pcPoolEnv :: Reflect era => PoolEnv era -> PDoc
pcPoolEnv :: forall era. Reflect era => PoolEnv era -> PDoc
pcPoolEnv (PoolEnv SlotNo
sn PParams era
pp) = Text -> [PDoc] -> PDoc
ppSexp Text
"PoolEnv" [SlotNo -> PDoc
pcSlotNo SlotNo
sn, forall era. Proof era -> PParams era -> PDoc
pcPParams forall era. Reflect era => Proof era
reify PParams era
pp]

instance forall era. Reflect era => PrettyA (PoolEnv era) where
  prettyA :: PoolEnv era -> PDoc
prettyA = forall era. Reflect era => PoolEnv era -> PDoc
pcPoolEnv

pcEnactSignal :: EnactSignal era -> PDoc
pcEnactSignal :: forall era. EnactSignal era -> PDoc
pcEnactSignal EnactSignal {GovAction era
GovActionId (EraCrypto era)
esGovActionId :: forall era. EnactSignal era -> GovActionId (EraCrypto era)
esGovAction :: forall era. EnactSignal era -> GovAction era
esGovAction :: GovAction era
esGovActionId :: GovActionId (EraCrypto era)
..} =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"EnactSignal"
    [ (Text
"Gov Action Id", forall c. GovActionId c -> PDoc
pcGovActionId GovActionId (EraCrypto era)
esGovActionId)
    , (Text
"Gov Action", forall era. GovAction era -> PDoc
pcGovAction GovAction era
esGovAction)
    ]

instance PrettyA (EnactSignal era) where
  prettyA :: EnactSignal era -> PDoc
prettyA = forall era. EnactSignal era -> PDoc
pcEnactSignal

pcRatifySignal :: RatifySignal era -> PDoc
pcRatifySignal :: forall era. RatifySignal era -> PDoc
pcRatifySignal (RatifySignal StrictSeq (GovActionState era)
s) = forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq forall era. GovActionState era -> PDoc
pcGovActionState StrictSeq (GovActionState era)
s

instance PrettyA (RatifySignal era) where
  prettyA :: RatifySignal era -> PDoc
prettyA = forall era. RatifySignal era -> PDoc
pcRatifySignal

pcRatifyEnv :: RatifyEnv era -> PDoc
pcRatifyEnv :: forall era. RatifyEnv era -> PDoc
pcRatifyEnv rs :: RatifyEnv era
rs@(RatifyEnv {}) =
  let RatifyEnv {Map (DRep (EraCrypto era)) (CompactForm Coin)
Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
CommitteeState era
PoolDistr (EraCrypto era)
EpochNo
reStakeDistr :: forall era.
RatifyEnv era
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
reStakePoolDistr :: forall era. RatifyEnv era -> PoolDistr (EraCrypto era)
reDRepDistr :: forall era.
RatifyEnv era -> Map (DRep (EraCrypto era)) (CompactForm Coin)
reDRepState :: forall era.
RatifyEnv era
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
reCurrentEpoch :: forall era. RatifyEnv era -> EpochNo
reCommitteeState :: forall era. RatifyEnv era -> CommitteeState era
reDelegatees :: forall era.
RatifyEnv era
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
rePoolParams :: forall era.
RatifyEnv era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
rePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
reDelegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
reCommitteeState :: CommitteeState era
reCurrentEpoch :: EpochNo
reDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
reDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
reStakePoolDistr :: PoolDistr (EraCrypto era)
reStakeDistr :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
..} = RatifyEnv era
rs
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"RatifyEnv"
        [ (Text
"StakeDistr", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential (Coin -> PDoc
pcCoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Compactible a => CompactForm a -> a
fromCompact) Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
reStakeDistr)
        , (Text
"StakePoolDistr", forall c. PoolDistr c -> PDoc
pcPoolDistr PoolDistr (EraCrypto era)
reStakePoolDistr)
        , (Text
"DRepDistr", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. DRep c -> PDoc
pcDRep (Coin -> PDoc
pcCoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Compactible a => CompactForm a -> a
fromCompact) Map (DRep (EraCrypto era)) (CompactForm Coin)
reDRepDistr)
        , (Text
"DRepState", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall c. DRepState c -> PDoc
pcDRepState Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
reDRepState)
        , (Text
"CurrentEpoch", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
reCurrentEpoch)
        , (Text
"CommitteeState", forall era. CommitteeState era -> PDoc
pcCommitteeState CommitteeState era
reCommitteeState)
        ]

instance PrettyA (RatifyEnv era) where
  prettyA :: RatifyEnv era -> PDoc
prettyA = forall era. RatifyEnv era -> PDoc
pcRatifyEnv

pcGovEnv :: Reflect era => GovEnv era -> PDoc
pcGovEnv :: forall era. Reflect era => GovEnv era -> PDoc
pcGovEnv GovEnv {PParams era
StrictMaybe (ScriptHash (EraCrypto era))
TxId (EraCrypto era)
CertState era
EpochNo
geTxId :: forall era. GovEnv era -> TxId (EraCrypto era)
geEpoch :: forall era. GovEnv era -> EpochNo
gePParams :: forall era. GovEnv era -> PParams era
gePPolicy :: forall era. GovEnv era -> StrictMaybe (ScriptHash (EraCrypto era))
geCertState :: forall era. GovEnv era -> CertState era
geCertState :: CertState era
gePPolicy :: StrictMaybe (ScriptHash (EraCrypto era))
gePParams :: PParams era
geEpoch :: EpochNo
geTxId :: TxId (EraCrypto era)
..} =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"GovEnv"
    [ (Text
"TxId", forall c. TxId c -> PDoc
pcTxId TxId (EraCrypto era)
geTxId)
    , (Text
"Epoch", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
geEpoch)
    , (Text
"PParams", forall era. Proof era -> PParams era -> PDoc
pcPParams forall era. Reflect era => Proof era
reify PParams era
gePParams)
    ]

instance Reflect era => PrettyA (GovEnv era) where
  prettyA :: GovEnv era -> PDoc
prettyA = forall era. Reflect era => GovEnv era -> PDoc
pcGovEnv

instance Reflect era => PrettyA (LedgerEnv era) where
  prettyA :: LedgerEnv era -> PDoc
prettyA LedgerEnv {Bool
PParams era
TxIx
SlotNo
AccountState
ledgerSlotNo :: forall era. LedgerEnv era -> SlotNo
ledgerIx :: forall era. LedgerEnv era -> TxIx
ledgerPp :: forall era. LedgerEnv era -> PParams era
ledgerAccount :: forall era. LedgerEnv era -> AccountState
ledgerMempool :: forall era. LedgerEnv era -> Bool
ledgerMempool :: Bool
ledgerAccount :: AccountState
ledgerPp :: PParams era
ledgerIx :: TxIx
ledgerSlotNo :: SlotNo
..} =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"LedgerEnv"
      [ (Text
"slot no", forall t. PrettyA t => t -> PDoc
prettyA SlotNo
ledgerSlotNo)
      , (Text
"ix", forall t. PrettyA t => t -> PDoc
prettyA (TxIx -> Int
txIxToInt TxIx
ledgerIx))
      , (Text
"pparams", forall t. PrettyA t => t -> PDoc
prettyA PParams era
ledgerPp)
      , (Text
"account", forall t. PrettyA t => t -> PDoc
prettyA AccountState
ledgerAccount)
      , (Text
"mempool", forall t. PrettyA t => t -> PDoc
prettyA Bool
ledgerMempool)
      ]

instance Reflect era => PrettyA (UtxoEnv era) where
  prettyA :: UtxoEnv era -> PDoc
prettyA UtxoEnv {PParams era
CertState era
SlotNo
ueSlot :: forall era. UtxoEnv era -> SlotNo
uePParams :: forall era. UtxoEnv era -> PParams era
ueCertState :: forall era. UtxoEnv era -> CertState era
ueCertState :: CertState era
uePParams :: PParams era
ueSlot :: SlotNo
..} =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"UtxoEnv"
      [ (Text
"slot no", forall t. PrettyA t => t -> PDoc
prettyA SlotNo
ueSlot)
      , (Text
"pparams", forall t. PrettyA t => t -> PDoc
prettyA PParams era
uePParams)
      , (Text
"certState", forall t. PrettyA t => t -> PDoc
prettyA CertState era
ueCertState)
      ]

instance Reflect era => PrettyA (CertEnv era) where
  prettyA :: CertEnv era -> PDoc
prettyA CertEnv {Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
PParams era
StrictMaybe (Committee era)
EpochNo
SlotNo
ceSlotNo :: forall era. CertEnv era -> SlotNo
cePParams :: forall era. CertEnv era -> PParams era
ceCurrentEpoch :: forall era. CertEnv era -> EpochNo
ceCurrentCommittee :: forall era. CertEnv era -> StrictMaybe (Committee era)
ceCommitteeProposals :: forall era.
CertEnv era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
ceCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
ceCurrentCommittee :: StrictMaybe (Committee era)
ceCurrentEpoch :: EpochNo
cePParams :: PParams era
ceSlotNo :: SlotNo
..} =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"CertEnv"
      [ (Text
"slot no", forall t. PrettyA t => t -> PDoc
prettyA SlotNo
ceSlotNo)
      , (Text
"pparams", forall t. PrettyA t => t -> PDoc
prettyA PParams era
cePParams)
      , (Text
"currentEpoch", forall t. PrettyA t => t -> PDoc
prettyA EpochNo
ceCurrentEpoch)
      ]

instance Reflect era => PrettyA (CertState era) where
  prettyA :: CertState era -> PDoc
prettyA CertState {DState era
PState era
VState era
certVState :: forall era. CertState era -> VState era
certPState :: forall era. CertState era -> PState era
certDState :: forall era. CertState era -> DState era
certDState :: DState era
certPState :: PState era
certVState :: VState era
..} =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"CertState"
      [ (Text
"vState", forall t. PrettyA t => t -> PDoc
prettyA VState era
certVState)
      , (Text
"pState", forall t. PrettyA t => t -> PDoc
prettyA PState era
certPState)
      , (Text
"dState", forall t. PrettyA t => t -> PDoc
prettyA DState era
certDState)
      ]

instance PrettyA x => PrettyA (Seq x) where
  prettyA :: Seq x -> PDoc
prettyA Seq x
x = forall t. PrettyA t => t -> PDoc
prettyA (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq x
x)

instance PrettyA (ConwayRules.CertsEnv era) where
  prettyA :: CertsEnv era -> PDoc
prettyA (ConwayRules.CertsEnv Tx era
_ PParams era
_ SlotNo
slot EpochNo
epoch StrictMaybe (Committee era)
com Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
prop) =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"CertsEnv"
      [ (Text
"Tx", forall a. [Char] -> Doc a
ppString [Char]
"Tx")
      , (Text
"pparams", forall a. [Char] -> Doc a
ppString [Char]
"PParams")
      , (Text
"slot", SlotNo -> PDoc
pcSlotNo SlotNo
slot)
      , (Text
"epoch", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
epoch)
      , (Text
"committee", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall era. Committee era -> PDoc
pcCommittee StrictMaybe (Committee era)
com)
      , (Text
"proposals", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId forall t. PrettyA t => t -> PDoc
prettyA Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
prop)
      ]

instance PrettyA RDPair where
  prettyA :: RDPair -> PDoc
prettyA (RDPair CompactForm Coin
x CompactForm Coin
y) = forall t. PrettyA t => t -> PDoc
prettyA (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
x, forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
y)

pcStake :: Stake c -> PDoc
pcStake :: forall c. Stake c -> PDoc
pcStake (Stake VMap VB VP (Credential 'Staking c) (CompactForm Coin)
m) = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential (Coin -> PDoc
pcCoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Compactible a => CompactForm a -> a
fromCompact) (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap VMap VB VP (Credential 'Staking c) (CompactForm Coin)
m)

instance PrettyA (Stake c) where
  prettyA :: Stake c -> PDoc
prettyA Stake c
s = forall c. Stake c -> PDoc
pcStake Stake c
s

pcSnapShot :: SnapShot c -> PDoc
pcSnapShot :: forall c. SnapShot c -> PDoc
pcSnapShot SnapShot c
x = Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"SnapShot" (forall c. Text -> SnapShot c -> [(Text, PDoc)]
pcSnapShotL Text
"" SnapShot c
x)

instance PrettyA (SnapShot c) where
  prettyA :: SnapShot c -> PDoc
prettyA SnapShot c
s = forall c. SnapShot c -> PDoc
pcSnapShot SnapShot c
s