{-# 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.Chain.Common as Byron
import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Address (Addr (..), BootstrapAddress (..), 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.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.DRep (DRep (..), DRepState (..))
import Cardano.Ledger.EpochBoundary (
  SnapShot (..),
  SnapShots (..),
  Stake (..),
 )
import Cardano.Ledger.Keys (
  GenDelegPair (..),
  GenDelegs (..),
  HasKeyRole (coerceKeyRole),
  VKey (..),
  WitVKey (..),
 )
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.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 (
  GenesisDelegCert (..),
  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 (
  GovStateWit (..),
  Proof (..),
  Reflect (..),
  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))

instance PrettyA a => PrettyA (Set a) where
  prettyA :: Set a -> PDoc
prettyA Set a
x = forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall t. PrettyA t => t -> PDoc
prettyA Set a
x

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 -> PDoc
ppPolicyID :: PolicyID -> PDoc
ppPolicyID (PolicyID ScriptHash
sh) = ScriptHash -> PDoc
pcScriptHash ScriptHash
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 -> PDoc
ppNonMyopic :: NonMyopic -> PDoc
ppNonMyopic (NonMyopic Map (KeyHash 'StakePool) 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). KeyHash discriminator -> PDoc
pcKeyHash Likelihood -> PDoc
ppLikelihood Map (KeyHash 'StakePool) Likelihood
m)
    , (Text
"rewardPot", Coin -> PDoc
pcCoin Coin
c)
    ]

ppRewardUpdate :: RewardUpdate -> PDoc
ppRewardUpdate :: RewardUpdate -> PDoc
ppRewardUpdate (RewardUpdate DeltaCoin
dt DeltaCoin
dr Map (Credential 'Staking) (Set Reward)
rss DeltaCoin
df NonMyopic
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). Credential keyrole -> PDoc
pcCredential (forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet Reward -> PDoc
pcReward) Map (Credential 'Staking) (Set Reward)
rss)
    , (Text
"deltaF", DeltaCoin -> PDoc
pcDeltaCoin DeltaCoin
df)
    , (Text
"nonMyopic", NonMyopic -> PDoc
ppNonMyopic NonMyopic
nonmyop)
    ]

instance PrettyA RewardUpdate where
  prettyA :: RewardUpdate -> PDoc
prettyA = RewardUpdate -> 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)
vk Set BootstrapWitness
wb Map ScriptHash (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).
Typeable keyrole =>
Proof era -> WitVKey keyrole -> PDoc
pcWitVKey @era forall era. Reflect era => Proof era
reify) Set (WitVKey 'Witness)
vk)
    , (Text
"bootstrap witnesses", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet BootstrapWitness -> PDoc
ppBootstrapWitness Set BootstrapWitness
wb)
    , (Text
"scripts map", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap ScriptHash -> PDoc
pcScriptHash (forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript forall era. Reflect era => Proof era
reify) Map ScriptHash (Script era)
sc)
    , (Text
"Data map", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall index. SafeHash index -> PDoc
ppSafeHash forall era. Era era => Data era -> PDoc
pcData (forall era. TxDats era -> Map DataHash (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

ppTxAuxDataHash :: TxAuxDataHash -> PDoc
ppTxAuxDataHash :: TxAuxDataHash -> PDoc
ppTxAuxDataHash (TxAuxDataHash SafeHash EraIndependentTxAuxData
h) = Text -> [PDoc] -> PDoc
ppSexp Text
"TxAuxDataHash" [forall index. SafeHash index -> PDoc
ppSafeHash SafeHash EraIndependentTxAuxData
h]

instance PrettyA TxAuxDataHash where
  prettyA :: TxAuxDataHash -> PDoc
prettyA = TxAuxDataHash -> PDoc
ppTxAuxDataHash

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

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

instance PrettyA (SafeHash x) where
  prettyA :: SafeHash x -> PDoc
prettyA = forall index. SafeHash 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)

ppVRFHash :: VRFVerKeyHash r -> PDoc
ppVRFHash :: forall (r :: KeyRoleVRF). VRFVerKeyHash r -> PDoc
ppVRFHash = forall a b. Hash a b -> PDoc
ppHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Hash HASH KeyRoleVRF
unVRFVerKeyHash

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 HASH 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 HASH 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 :: VKey r -> PDoc
ppVKey :: forall (r :: KeyRole). VKey r -> PDoc
ppVKey vk :: VKey r
vk@(VKey VerKeyDSIGN DSIGN
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
x), PDoc
"hash = " forall a. Doc a -> Doc a -> Doc a
<+> forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey VKey r
vk)]

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

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

instance PrettyA BootstrapWitness where
  prettyA :: BootstrapWitness -> PDoc
prettyA = BootstrapWitness -> PDoc
ppBootstrapWitness

ppWitnessSetHKD :: forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD :: forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD (ShelleyTxWits Set (WitVKey 'Witness)
addr Map ScriptHash (Script era)
scr Set BootstrapWitness
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).
Typeable keyrole =>
Proof era -> WitVKey keyrole -> PDoc
pcWitVKey @era forall era. Reflect era => Proof era
reify) Set (WitVKey 'Witness)
addr)
    , (Text
"scriptWits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap ScriptHash -> PDoc
pcScriptHash (forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript forall era. Reflect era => Proof era
reify) Map ScriptHash (Script era)
scr)
    , (Text
"bootWits", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet BootstrapWitness -> PDoc
ppBootstrapWitness Set BootstrapWitness
boot)
    ]

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

ppPParamsUpdate :: Proof era -> PParamsUpdate era -> PDoc
ppPParamsUpdate :: forall era. Proof era -> PParamsUpdate era -> PDoc
ppPParamsUpdate Proof era
proof PParamsUpdate era
pp = Text -> [(Text, PDoc)] -> PDoc
ppRecord (Text
"PParamsUpdate " 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 -> PParamsUpdate era -> [PParamsField era]
Fields.abstractPPUpdate Proof era
proof PParamsUpdate 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

instance Reflect era => PrettyA (PParamsUpdate era) where
  prettyA :: PParamsUpdate era -> PDoc
prettyA PParamsUpdate era
x = forall era. Proof era -> PParamsUpdate era -> PDoc
ppPParamsUpdate forall era. Reflect era => Proof era
reify PParamsUpdate era
x

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) (PParamsUpdate era)
m) = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash forall t. PrettyA t => t -> PDoc
prettyA Map (KeyHash 'Genesis) (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 -> PDoc
ppWithdrawals :: Withdrawals -> PDoc
ppWithdrawals (Withdrawals Map RewardAccount 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") RewardAccount -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map RewardAccount Coin
m]

instance PrettyA Withdrawals where
  prettyA :: Withdrawals -> PDoc
prettyA = Withdrawals -> PDoc
ppWithdrawals

ppWitHashes :: Set (KeyHash 'Witness) -> PDoc
ppWitHashes :: Set (KeyHash 'Witness) -> PDoc
ppWitHashes Set (KeyHash 'Witness)
hs = Text -> [PDoc] -> PDoc
ppSexp Text
"WitHashes" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Set (KeyHash 'Witness)
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 (TxAuxData 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
ins StrictSeq (TxOut era)
outs StrictSeq (TxCert era)
cs Withdrawals
withdrawals Coin
fee SlotNo
ttl StrictMaybe (Update era)
upd StrictMaybe TxAuxDataHash
mdh) ShortByteString
_)) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"TxBody"
    [ (Text
"inputs", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
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", Withdrawals -> PDoc
ppWithdrawals Withdrawals
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 TxAuxDataHash -> PDoc
ppTxAuxDataHash StrictMaybe TxAuxDataHash
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
addr Value ConwayEra
v Datum ConwayEra
d StrictMaybe (Script ConwayEra)
s) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
pcAddr Addr
addr, MaryValue -> PDoc
pcValue Value ConwayEra
v, forall era. Era era => Datum era -> PDoc
pcDatum Datum ConwayEra
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)
s]
pcTxOut p :: Proof era
p@Proof era
Babbage (BabbageTxOut Addr
addr Value BabbageEra
v Datum BabbageEra
d StrictMaybe (Script BabbageEra)
s) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
pcAddr Addr
addr, MaryValue -> PDoc
pcValue Value BabbageEra
v, forall era. Era era => Datum era -> PDoc
pcDatum Datum BabbageEra
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)
s]
pcTxOut Proof era
Alonzo (AlonzoTxOut Addr
addr Value AlonzoEra
v StrictMaybe DataHash
md) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
pcAddr Addr
addr, MaryValue -> PDoc
pcValue Value AlonzoEra
v, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe DataHash -> PDoc
pcDataHash StrictMaybe DataHash
md]
pcTxOut p :: Proof era
p@Proof era
Mary (ShelleyTxOut Addr
addr Value MaryEra
v) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
pcAddr Addr
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value MaryEra
v]
pcTxOut p :: Proof era
p@Proof era
Allegra (ShelleyTxOut Addr
addr Value AllegraEra
v) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
pcAddr Addr
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value AllegraEra
v]
pcTxOut p :: Proof era
p@Proof era
Shelley (ShelleyTxOut Addr
addr Value ShelleyEra
v) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
pcAddr Addr
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value ShelleyEra
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
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
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
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
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
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
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, 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
s -> [(Text
"spend inputs", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
s)]
  Collateral Set TxIn
s -> [(Text
"coll inputs", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
s)]
  RefInputs Set TxIn
s -> [(Text
"ref inputs", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
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 RewardAccount Coin
m) -> [(Text
"withdrawal", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap RewardAccount -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map RewardAccount 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)
s -> [(Text
"required hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Set (KeyHash 'Witness)
s)]
  Fields.Mint (MultiAsset Map PolicyID (Map AssetName Integer)
m) -> [(Text
"minted", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet PolicyID -> PDoc
pcPolicyID (forall k a. Map k a -> Set k
Map.keysSet Map PolicyID (Map AssetName Integer)
m))]
  WppHash StrictMaybe ScriptIntegrityHash
SNothing -> []
  WppHash (SJust ScriptIntegrityHash
h) -> [(Text
"integrity hash", PDoc -> PDoc
trim (forall index. SafeHash index -> PDoc
ppSafeHash ScriptIntegrityHash
h))]
  AdHash StrictMaybe TxAuxDataHash
SNothing -> []
  AdHash (SJust (TxAuxDataHash SafeHash EraIndependentTxAuxData
h)) -> [(Text
"aux data hash", PDoc -> PDoc
trim (forall index. SafeHash index -> PDoc
ppSafeHash SafeHash 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 index. SafeHash index -> PDoc
ppSafeHash (forall x i. HashAnnotated x i => x -> SafeHash i
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)
set -> [(Text
"key wits", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (forall era (keyrole :: KeyRole).
Typeable keyrole =>
Proof era -> WitVKey keyrole -> PDoc
pcWitVKey Proof era
proof) Set (WitVKey 'Witness)
set)]
  BootWits Set BootstrapWitness
bwits -> [(Text
"boot wits", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (\BootstrapWitness
z -> forall (r :: KeyRole). VKey r -> PDoc
ppVKey (BootstrapWitness -> VKey 'Witness
bwKey BootstrapWitness
z)) Set BootstrapWitness
bwits)]
  ScriptWits Map ScriptHash (Script era)
mp -> [(Text
"script wits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap ScriptHash -> PDoc
pcScriptHash (forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
proof) Map ScriptHash (Script era)
mp)]
  DataWits (TxDats Map DataHash (Data era)
m) -> [(Text
"data wits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap DataHash -> PDoc
pcDataHash forall era. Era era => Data era -> PDoc
pcData Map DataHash (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 Word16
n -> [(Text
"NOpt", forall a. Word16 -> Doc a
ppWord16 Word16
n)]
  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
x) = forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'StakePool
x
ppShelleyDelegsPredFailure Proof era
_ (WithdrawalsNotInRewardsDELEGS Map RewardAccount Coin
x) = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap RewardAccount -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map RewardAccount 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
txins -> Text -> [PDoc] -> PDoc
ppSexp Text
"BadInputsUTxO" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
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 mm :: Mismatch 'RelLTEQ Integer
mm@(Mismatch Integer
_ Integer
_) ->
    let Mismatch {Integer
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: Integer
mismatchSupplied :: Integer
..} = Mismatch 'RelLTEQ Integer
mm
     in Text -> [(Text, PDoc)] -> PDoc
ppRecord
          Text
"MaxTxSizeUTxO"
          [ (Text
"Actual", forall a. Integer -> Doc a
ppInteger Integer
mismatchSupplied)
          , (Text
"max transaction size", forall a. Integer -> Doc a
ppInteger Integer
mismatchExpected)
          ]
  ConwayUtxoPredFailure era
ConwayRules.InputSetEmptyUTxO -> forall a. [Char] -> Doc a
ppString [Char]
"InputSetEmptyUTxO"
  ConwayRules.FeeTooSmallUTxO mm :: Mismatch 'RelGTEQ Coin
mm@(Mismatch Coin
_ Coin
_) ->
    let Mismatch {Coin
mismatchExpected :: Coin
mismatchSupplied :: Coin
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelGTEQ Coin
mm
     in Text -> [(Text, PDoc)] -> PDoc
ppRecord
          Text
"FeeTooSmallUTxO"
          [ (Text
"fee supplied by this transaction", Coin -> PDoc
pcCoin Coin
mismatchSupplied)
          , (Text
"min fee for this transaction", Coin -> PDoc
pcCoin Coin
mismatchExpected)
          ]
  ConwayRules.ValueNotConservedUTxO mm :: Mismatch 'RelEQ (Value era)
mm@(Mismatch Value era
_ Value era
_) ->
    let Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Value era
consumed, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = Value era
produced} = Mismatch 'RelEQ (Value era)
mm
     in 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
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 Addr -> PDoc
pcAddr Set Addr
add)
      ]
  ConwayRules.WrongNetworkWithdrawal Network
n Set RewardAccount
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 RewardAccount -> PDoc
pcRewardAccount Set RewardAccount
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 mm :: Mismatch 'RelLTEQ ExUnits
mm@(Mismatch ExUnits
_ ExUnits
_) ->
    let Mismatch {ExUnits
mismatchExpected :: ExUnits
mismatchSupplied :: ExUnits
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelLTEQ ExUnits
mm
     in Text -> [(Text, PDoc)] -> PDoc
ppRecord
          Text
"ExUnitsTooBigUTxO"
          [ (Text
"EXUnits supplied", ExUnits -> PDoc
pcExUnits ExUnits
mismatchSupplied)
          , (Text
"Max EXUnits from the protocol parameters", ExUnits -> PDoc
pcExUnits ExUnits
mismatchExpected)
          ]
  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 mm :: Mismatch 'RelEQ Network
mm@(Mismatch Network
_ Network
_) ->
    let Mismatch {Network
mismatchExpected :: Network
mismatchSupplied :: Network
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelEQ Network
mm
     in Text -> [(Text, PDoc)] -> PDoc
ppRecord
          Text
"WrongNetworkInTxBody"
          [ (Text
"Network ID in transaction body", Network -> PDoc
ppNetwork Network
mismatchSupplied)
          , (Text
"Actual Network ID", Network -> PDoc
ppNetwork Network
mismatchExpected)
          ]
  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 mm :: Mismatch 'RelLTEQ Natural
mm@(Mismatch Natural
_ Natural
_) ->
    let Mismatch {Natural
mismatchExpected :: Natural
mismatchSupplied :: Natural
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelLTEQ Natural
mm
     in Text -> [(Text, PDoc)] -> PDoc
ppRecord
          Text
"TooManyCollateralInputs"
          [ (Text
"Number of collateral inputs", forall a. Natural -> Doc a
ppNatural Natural
mismatchSupplied)
          , (Text
"Max allowed collateral inputs", forall a. Natural -> Doc a
ppNatural Natural
mismatchExpected)
          ]
  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
xs ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"BabbageNonDisjointRefInputs" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList TxIn -> PDoc
pcTxIn (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty TxIn
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
xs) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"BabbageNonDisjointRefInputs" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList TxIn -> PDoc
pcTxIn (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty TxIn
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)
s -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayWdrlNotDelegatedToDRep" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (KeyHash 'Staking)
s]
  ConwayTreasuryValueMismatch (Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Coin
c1, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = 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 (Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Int
s1, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = 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
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayDRepAlreadyRegistered" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'DRepRole
x]
  ConwayDRepNotRegistered Credential 'DRepRole
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayDRepNotRegistered" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'DRepRole
x]
  ConwayDRepIncorrectDeposit (Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Coin
c1, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = Coin
c2}) ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayDRepIncorrectDeposit" [Coin -> PDoc
pcCoin Coin
c1, Coin -> PDoc
pcCoin Coin
c2]
  ConwayCommitteeHasPreviouslyResigned Credential 'ColdCommitteeRole
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayCommitteeHasPreviouslyResigned" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'ColdCommitteeRole
x]
  ConwayDRepIncorrectRefund (Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Coin
c1, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = Coin
c2}) ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayDRepIncorrectRefund" [Coin -> PDoc
pcCoin Coin
c1, Coin -> PDoc
pcCoin Coin
c2]
  ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole
c -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayCommitteeIsUnknown" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'ColdCommitteeRole
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 Coin
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"WithdrawalsNotInRewardsCERTS" [forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap RewardAccount -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map RewardAccount 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
c -> Text -> [PDoc] -> PDoc
ppSexp Text
"GovActionsDoNotExist" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty GovActionId
c]
  MalformedProposal GovAction era
ga -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedProposal" [forall era. GovAction era -> PDoc
pcGovAction GovAction era
ga]
  ProposalProcedureNetworkIdMismatch RewardAccount
racnt Network
nw ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ProposalProcedureNetworkIdMismatch" [RewardAccount -> PDoc
pcRewardAccount RewardAccount
racnt, Network -> PDoc
pcNetwork Network
nw]
  TreasuryWithdrawalsNetworkIdMismatch Set RewardAccount
sr Network
nw ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"TreasuryWithdrawalsNetworkIdMismatch" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet RewardAccount -> PDoc
pcRewardAccount Set RewardAccount
sr, Network -> PDoc
pcNetwork Network
nw]
  ProposalDepositIncorrect (Mismatch Coin
supplied Coin
expected) -> Text -> [PDoc] -> PDoc
ppSexp Text
"ProposalDepositIncorrect" [Coin -> PDoc
pcCoin Coin
supplied, Coin -> PDoc
pcCoin Coin
expected]
  DisallowedVoters NonEmpty (Voter, GovActionId)
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"DisallowedVoters" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (Voter, GovActionId)
m]
  ConflictingCommitteeUpdate Set (Credential 'ColdCommitteeRole)
s ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ConflictingCommitteeUpdate" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Set (Credential 'ColdCommitteeRole)
s]
  ExpirationEpochTooSmall Map (Credential 'ColdCommitteeRole) EpochNo
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"ExpirationEpochTooSmall" [forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential forall ann. EpochNo -> Doc ann
ppEpochNo Map (Credential 'ColdCommitteeRole) EpochNo
m]
  InvalidPrevGovActionId ProposalProcedure era
p -> Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidPrevGovActionId" [forall era. ProposalProcedure era -> PDoc
pcProposalProcedure ProposalProcedure era
p]
  VotingOnExpiredGovAction NonEmpty (Voter, GovActionId)
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"VotingOnExpiredGovAction" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (Voter, GovActionId)
m]
  ProposalCantFollow StrictMaybe (GovPurposeId 'HardForkPurpose era)
s1 Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = ProtVer
p1, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = 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
a StrictMaybe ScriptHash
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
a, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall t. PrettyA t => t -> PDoc
prettyA StrictMaybe ScriptHash
b]
  DisallowedProposalDuringBootstrap ProposalProcedure era
p ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"DisallowedProposalDuringBootstrap" [forall era. ProposalProcedure era -> PDoc
pcProposalProcedure ProposalProcedure era
p]
  DisallowedVotesDuringBootstrap NonEmpty (Voter, GovActionId)
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"DisallowedVotesDuringBootstrap" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (Voter, GovActionId)
m]
  VotersDoNotExist NonEmpty Voter
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"VotersDoNotExist" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty Voter
m]
  ZeroTreasuryWithdrawals GovAction era
ga -> Text -> [PDoc] -> PDoc
ppSexp Text
"ZeroTreasuryWithdrawals" [forall era. GovAction era -> PDoc
pcGovAction GovAction era
ga]
  ProposalReturnAccountDoesNotExist RewardAccount
a -> Text -> [PDoc] -> PDoc
ppSexp Text
"ProposalReturnAccountDoesNotExist" [forall t. PrettyA t => t -> PDoc
prettyA RewardAccount
a]
  TreasuryWithdrawalReturnAccountsDoNotExist NonEmpty RewardAccount
a -> Text -> [PDoc] -> PDoc
ppSexp Text
"TreasuryWithdrawalReturnAccountsDoNotExist" [forall t. PrettyA t => t -> PDoc
prettyA NonEmpty RewardAccount
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]
vkeyws ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall (r :: KeyRole). VKey r -> PDoc
ppVKey [VKey 'Witness]
vkeyws]
  ConwayRules.MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness)
whs ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"MissingVKeyWitnessesUTXOW" [Set (KeyHash 'Witness) -> PDoc
ppWitHashes Set (KeyHash 'Witness)
whs]
  ConwayRules.MissingScriptWitnessesUTXOW Set ScriptHash
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"MissingScriptWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
m]
  ConwayRules.ScriptWitnessNotValidatingUTXOW Set ScriptHash
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptWitnessNotValidatingUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
m]
  ConwayRules.MissingTxBodyMetadataHash TxAuxDataHash
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
" MissingTxMetadata" [TxAuxDataHash -> PDoc
ppTxAuxDataHash TxAuxDataHash
m]
  ConwayRules.MissingTxMetadata TxAuxDataHash
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
" MissingTxMetadata" [TxAuxDataHash -> PDoc
ppTxAuxDataHash TxAuxDataHash
m]
  ConwayRules.ConflictingMetadataHash mm :: Mismatch 'RelEQ TxAuxDataHash
mm@(Mismatch TxAuxDataHash
_ TxAuxDataHash
_) ->
    let Mismatch {TxAuxDataHash
mismatchExpected :: TxAuxDataHash
mismatchSupplied :: TxAuxDataHash
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelEQ TxAuxDataHash
mm
     in Text -> [(Text, PDoc)] -> PDoc
ppRecord
          Text
"ConflictingMetadataHash"
          [ (Text
"Hash in the body", TxAuxDataHash -> PDoc
ppTxAuxDataHash TxAuxDataHash
mismatchSupplied)
          , (Text
"Hash of full metadata", TxAuxDataHash -> PDoc
ppTxAuxDataHash TxAuxDataHash
mismatchExpected)
          ]
  ConwayUtxowPredFailure era
ConwayRules.InvalidMetadata ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidMetadata" []
  ConwayRules.ExtraneousScriptWitnessesUTXOW Set ScriptHash
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ExtraneousScriptWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
m]
  ConwayRules.MissingRedeemers [(PlutusPurpose AsItem era, ScriptHash)]
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)]
xs]
  ConwayRules.MissingRequiredDatums Set DataHash
h1 Set DataHash
h2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"MissingRequiredDatums"
      [ (Text
"received data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall index. SafeHash index -> PDoc
ppSafeHash Set DataHash
h1)
      , (Text
"missing data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall index. SafeHash index -> PDoc
ppSafeHash Set DataHash
h2)
      ]
  ConwayRules.NotAllowedSupplementalDatums Set DataHash
s1 Set DataHash
s2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"NotAllowedSupplementalDatums"
      [ (Text
"unallowed data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall index. SafeHash index -> PDoc
ppSafeHash Set DataHash
s1)
      , (Text
"acceptable data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall index. SafeHash index -> PDoc
ppSafeHash Set DataHash
s2)
      ]
  ConwayRules.PPViewHashesDontMatch mm :: Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
mm@(Mismatch StrictMaybe ScriptIntegrityHash
_ StrictMaybe ScriptIntegrityHash
_) ->
    let Mismatch {StrictMaybe ScriptIntegrityHash
mismatchExpected :: StrictMaybe ScriptIntegrityHash
mismatchSupplied :: StrictMaybe ScriptIntegrityHash
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
mm
     in Text -> [(Text, PDoc)] -> PDoc
ppRecord
          Text
"PPViewHashesDontMatch"
          [ (Text
"PPHash in the TxBody", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall index. SafeHash index -> PDoc
ppSafeHash StrictMaybe ScriptIntegrityHash
mismatchSupplied)
          , (Text
"PPHash Computed from the current Protocol Parameters", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall index. SafeHash index -> PDoc
ppSafeHash StrictMaybe ScriptIntegrityHash
mismatchExpected)
          ]
  ConwayRules.UnspendableUTxONoDatumHash Set TxIn
x ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"UnspendableUTxONoDatumHash" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
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
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedScriptWitnesses" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
x]
  ConwayRules.MalformedReferenceScripts Set ScriptHash
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedReferenceScripts" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
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
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedScriptWitnesses" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
x]
  MalformedReferenceScripts Set ScriptHash
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedReferenceScripts" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
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 HASH EraIndependentBlockBody
supplied Hash HASH EraIndependentBlockBody
expected)) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"(InvalidBodyHashBBODY"
    [ (Text
"actual hash", forall a b. Hash a b -> PDoc
ppHash Hash HASH EraIndependentBlockBody
supplied)
    , (Text
"claimed hash", forall a b. Hash a b -> PDoc
ppHash Hash HASH 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 mm :: Mismatch 'RelLTEQ Int
mm@(Mismatch Int
_ Int
_)) =
  let Mismatch {Int
mismatchExpected :: Int
mismatchSupplied :: Int
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelLTEQ Int
mm
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"BodyRefScriptsSizeTooBig"
        [ (Text
"Computed sum of reference script size", forall a. Int -> Doc a
ppInt Int
mismatchSupplied)
        , (Text
"Maximum allowed total reference script size", forall a. Int -> Doc a
ppInt Int
mismatchExpected)
        ]
ppConwayBbodyPredFail (ConwayRules.TooManyExUnits mm :: Mismatch 'RelLTEQ ExUnits
mm@(Mismatch ExUnits
_ ExUnits
_)) =
  let Mismatch {ExUnits
mismatchExpected :: ExUnits
mismatchSupplied :: ExUnits
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelLTEQ ExUnits
mm
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"TooManyExUnits"
        [ (Text
"Computed Sum of ExUnits for all plutus scripts", ExUnits -> PDoc
pcExUnits ExUnits
mismatchSupplied)
        , (Text
"Maximum allowed by protocal parameters", ExUnits -> PDoc
pcExUnits ExUnits
mismatchExpected)
        ]
ppConwayBbodyPredFail (ConwayRules.WrongBlockBodySizeBBODY mm :: Mismatch 'RelEQ Int
mm@(Mismatch Int
_ Int
_)) =
  let Mismatch {Int
mismatchExpected :: Int
mismatchSupplied :: Int
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelEQ Int
mm
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"WrongBlockBodySizeBBODY"
        [ (Text
"actual computed BBody size", forall a. Int -> Doc a
ppInt Int
mismatchSupplied)
        , (Text
"claimed BBody Size in Header", forall a. Int -> Doc a
ppInt Int
mismatchExpected)
        ]
ppConwayBbodyPredFail (ConwayRules.InvalidBodyHashBBODY mm :: Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody)
mm@(Mismatch Hash HASH EraIndependentBlockBody
_ Hash HASH EraIndependentBlockBody
_)) =
  let Mismatch {Hash HASH EraIndependentBlockBody
mismatchExpected :: Hash HASH EraIndependentBlockBody
mismatchSupplied :: Hash HASH EraIndependentBlockBody
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody)
mm
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"(InvalidBodyHashBBODY"
        [ (Text
"actual hash", forall a b. Hash a b -> PDoc
ppHash Hash HASH EraIndependentBlockBody
mismatchSupplied)
        , (Text
"claimed hash", forall a b. Hash a b -> PDoc
ppHash Hash HASH EraIndependentBlockBody
mismatchExpected)
        ]
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 Mismatch {ExUnits
mismatchExpected :: ExUnits
mismatchSupplied :: ExUnits
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..}) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"TooManyExUnits"
    [ (Text
"Computed Sum of ExUnits for all plutus scripts", ExUnits -> PDoc
pcExUnits ExUnits
mismatchSupplied)
    , (Text
"Maximum allowed by protocal parameters", ExUnits -> PDoc
pcExUnits ExUnits
mismatchExpected)
    ]

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
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"CorruptRewardUpdate" [RewardUpdate -> PDoc
ppRewardUpdate RewardUpdate
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
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"CorruptRewardUpdate" [RewardUpdate -> PDoc
ppRewardUpdate RewardUpdate
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)]
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)]
xs]
ppAlonzoUtxowPredFailure (MissingRequiredDatums Set DataHash
s1 Set DataHash
s2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"MissingRequiredDatums"
    [ (Text
"missing data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall index. SafeHash index -> PDoc
ppSafeHash Set DataHash
s1)
    , (Text
"received data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall index. SafeHash index -> PDoc
ppSafeHash Set DataHash
s2)
    ]
ppAlonzoUtxowPredFailure (NotAllowedSupplementalDatums Set DataHash
s1 Set DataHash
s2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"NotAllowedSupplementalDatums"
    [ (Text
"unallowed data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall index. SafeHash index -> PDoc
ppSafeHash Set DataHash
s1)
    , (Text
"acceptable data hashes", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall index. SafeHash index -> PDoc
ppSafeHash Set DataHash
s2)
    ]
ppAlonzoUtxowPredFailure (PPViewHashesDontMatch Mismatch {StrictMaybe ScriptIntegrityHash
mismatchExpected :: StrictMaybe ScriptIntegrityHash
mismatchSupplied :: StrictMaybe ScriptIntegrityHash
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..}) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PPViewHashesDontMatch"
    [ (Text
"PPHash in the TxBody", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall index. SafeHash index -> PDoc
ppSafeHash StrictMaybe ScriptIntegrityHash
mismatchSupplied)
    , (Text
"PPHash Computed from the current Protocol Parameters", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall index. SafeHash index -> PDoc
ppSafeHash StrictMaybe ScriptIntegrityHash
mismatchExpected)
    ]
ppAlonzoUtxowPredFailure (MissingRequiredSigners Set (KeyHash 'Witness)
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MissingRequiredSigners" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Set (KeyHash 'Witness)
x]
ppAlonzoUtxowPredFailure (UnspendableUTxONoDatumHash Set TxIn
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"UnspendableUTxONoDatumHash" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
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]
vkeyws) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList forall (r :: KeyRole). VKey r -> PDoc
ppVKey [VKey 'Witness]
vkeyws]
ppShelleyUtxowPredFailure (MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness)
whs) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MissingVKeyWitnessesUTXOW" [Set (KeyHash 'Witness) -> PDoc
ppWitHashes Set (KeyHash 'Witness)
whs]
ppShelleyUtxowPredFailure (MissingScriptWitnessesUTXOW Set ScriptHash
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MissingScriptWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
m]
ppShelleyUtxowPredFailure (ScriptWitnessNotValidatingUTXOW Set ScriptHash
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptWitnessNotValidatingUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
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)
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MIRInsufficientGenesisSigsUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Set (KeyHash 'Witness)
m]
ppShelleyUtxowPredFailure (MissingTxBodyMetadataHash TxAuxDataHash
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
" MissingTxMetadata" [TxAuxDataHash -> PDoc
ppTxAuxDataHash TxAuxDataHash
m]
ppShelleyUtxowPredFailure (MissingTxMetadata TxAuxDataHash
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
" MissingTxMetadata" [TxAuxDataHash -> PDoc
ppTxAuxDataHash TxAuxDataHash
m]
ppShelleyUtxowPredFailure (ConflictingMetadataHash (Mismatch TxAuxDataHash
supplied TxAuxDataHash
expected)) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ConflictingMetadataHash"
    [ (Text
"Hash in the body", TxAuxDataHash -> PDoc
ppTxAuxDataHash TxAuxDataHash
supplied)
    , (Text
"Hash of full metadata", TxAuxDataHash -> PDoc
ppTxAuxDataHash TxAuxDataHash
expected)
    ]
ppShelleyUtxowPredFailure ShelleyUtxowPredFailure era
InvalidMetadata =
  Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidMetadata" []
ppShelleyUtxowPredFailure (ExtraneousScriptWitnessesUTXOW Set ScriptHash
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ExtraneousScriptWitnessesUTXOW" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
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
txins -> Text -> [PDoc] -> PDoc
ppSexp Text
"BadInputsUTxO" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
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 Mismatch {Integer
mismatchExpected :: Integer
mismatchSupplied :: Integer
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"MaxTxSizeUTxO"
      [(Text
"Actual", forall a. Integer -> Doc a
ppInteger Integer
mismatchSupplied), (Text
"max transaction size", forall a. Integer -> Doc a
ppInteger Integer
mismatchExpected)]
  AlonzoUtxoPredFailure era
Alonzo.InputSetEmptyUTxO -> forall a. [Char] -> Doc a
ppString [Char]
"InputSetEmptyUTxO"
  Alonzo.FeeTooSmallUTxO Mismatch {Coin
mismatchExpected :: Coin
mismatchSupplied :: Coin
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"FeeTooSmallUTxO"
      [ (Text
"min fee for this transaction", Coin -> PDoc
pcCoin Coin
mismatchExpected)
      , (Text
"fee supplied by this transaction", Coin -> PDoc
pcCoin Coin
mismatchSupplied)
      ]
  Alonzo.ValueNotConservedUTxO Mismatch {Value era
mismatchExpected :: Value era
mismatchSupplied :: Value era
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} ->
    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
mismatchSupplied)
      , (Text
"coin produced", forall era. Proof era -> Value era -> PDoc
pcVal @era forall era. Reflect era => Proof era
reify Value era
mismatchExpected)
      ]
  Alonzo.WrongNetwork Network
n Set Addr
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 Addr -> PDoc
pcAddr Set Addr
add)
      ]
  Alonzo.WrongNetworkWithdrawal Network
n Set RewardAccount
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 RewardAccount -> PDoc
pcRewardAccount Set RewardAccount
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 Mismatch {ExUnits
mismatchExpected :: ExUnits
mismatchSupplied :: ExUnits
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ExUnitsTooBigUTxO"
      [ (Text
"Max EXUnits from the protocol parameters", ExUnits -> PDoc
pcExUnits ExUnits
mismatchExpected)
      , (Text
"EXUnits supplied", ExUnits -> PDoc
pcExUnits ExUnits
mismatchSupplied)
      ]
  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 Mismatch {Network
mismatchExpected :: Network
mismatchSupplied :: Network
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"WrongNetworkInTxBody"
      [ (Text
"Actual Network ID", Network -> PDoc
ppNetwork Network
mismatchExpected)
      , (Text
"Network ID in transaction body", Network -> PDoc
ppNetwork Network
mismatchSupplied)
      ]
  OutsideForecast SlotNo
slot -> Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"OutsideForecast" [(Text
"slot number outside consensus forecast range", SlotNo -> PDoc
pcSlotNo SlotNo
slot)]
  TooManyCollateralInputs Mismatch {Natural
mismatchExpected :: Natural
mismatchSupplied :: Natural
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"TooManyCollateralInputs"
      [ (Text
"Max allowed collateral inputs", forall a. Natural -> Doc a
ppNatural Natural
mismatchExpected)
      , (Text
"Number of collateral inputs", forall a. Natural -> Doc a
ppNatural Natural
mismatchSupplied)
      ]
  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
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyAlreadyRegisteredDELEG" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred]
  Shelley.StakeKeyNotRegisteredDELEG Credential 'Staking
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyNotRegisteredDELEG" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred]
  StakeKeyNonZeroAccountBalanceDELEG Coin
c -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyNonZeroAccountBalanceDELEG" [Coin -> PDoc
pcCoin Coin
c]
  StakeDelegationImpossibleDELEG Credential 'Staking
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeDelegationImpossibleDELEG" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred]
  ShelleyDelegPredFailure era
WrongCertificateTypeDELEG -> Text -> [PDoc] -> PDoc
ppSexp Text
"WrongCertificateTypeDELEG" []
  GenesisKeyNotInMappingDELEG KeyHash 'Genesis
kh -> Text -> [PDoc] -> PDoc
ppSexp Text
"GenesisKeyNotInMappingDELEG" [forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'Genesis
kh]
  DuplicateGenesisDelegateDELEG KeyHash 'GenesisDelegate
kh -> Text -> [PDoc] -> PDoc
ppSexp Text
"DuplicateGenesisDelegateDELEG" [forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'GenesisDelegate
kh]
  InsufficientForInstantaneousRewardsDELEG MIRPot
pot Mismatch {Coin
mismatchExpected :: Coin
mismatchSupplied :: Coin
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} ->
    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
mismatchSupplied, Coin -> PDoc
pcCoin Coin
mismatchExpected]
  MIRCertificateTooLateinEpochDELEG Mismatch {SlotNo
mismatchExpected :: SlotNo
mismatchSupplied :: SlotNo
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"MIRCertificateTooLateinEpochDELEG" [SlotNo -> PDoc
pcSlotNo SlotNo
mismatchSupplied, SlotNo -> PDoc
pcSlotNo SlotNo
mismatchExpected]
  DuplicateGenesisVRFDELEG VRFVerKeyHash 'GenDelegVRF
hash -> Text -> [PDoc] -> PDoc
ppSexp Text
"DuplicateGenesisVRFDELEG" [forall (r :: KeyRoleVRF). VRFVerKeyHash r -> PDoc
ppVRFHash VRFVerKeyHash 'GenDelegVRF
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 Mismatch {Coin
mismatchExpected :: Coin
mismatchSupplied :: Coin
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} ->
    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
mismatchSupplied, Coin -> PDoc
pcCoin Coin
mismatchExpected]
  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
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyRegisteredDELEG" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred]
  ConwayRules.StakeKeyNotRegisteredDELEG Credential 'Staking
cred ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyNotRegisteredDELEG" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred]
  StakeKeyHasNonZeroRewardAccountBalanceDELEG Coin
c ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyHasNonZeroRewardAccountBalanceDELEG" [Coin -> PDoc
pcCoin Coin
c]
  ConwayRules.DelegateeDRepNotRegisteredDELEG Credential 'DRepRole
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"DelegateeDRepNotRegisteredDELEG" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'DRepRole
cred]
  ConwayRules.DelegateeStakePoolNotRegisteredDELEG KeyHash 'StakePool
kh -> Text -> [PDoc] -> PDoc
ppSexp Text
"DelegateeStakePoolNotRegisteredDELEG" [forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'StakePool
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
kh) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"StakePoolNotRegisteredOnKeyPOOL"
    [ (Text
"KeyHash", forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'StakePool
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
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). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'StakePool
stakePoolId)
      ]
ppShelleyPoolPredFailure
  ( PoolMedataHashTooBig
      KeyHash 'StakePool
stakePoolId
      Int
metadataHashSize
    ) =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"PoolMedataHashTooBig"
      [ (Text
"Stake Pool ID", forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'StakePool
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
sh) = Text -> [PDoc] -> PDoc
ppSexp Text
"NoWitness" [forall t. PrettyA t => t -> PDoc
prettyA ScriptHash
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
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"BadInputsUTxO" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
x]
ppShelleyUtxoPredFailure (Shelley.ExpiredUTxO Mismatch {SlotNo
mismatchExpected :: SlotNo
mismatchSupplied :: SlotNo
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..}) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ExpiredUTxO"
    [ (Text
"transaction time to live", SlotNo -> PDoc
pcSlotNo SlotNo
mismatchSupplied)
    , (Text
"current slot", SlotNo -> PDoc
pcSlotNo SlotNo
mismatchExpected)
    ]
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 Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = Value era
consumed, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = 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
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 Addr -> PDoc
pcAddr Set Addr
add)
    ]
ppShelleyUtxoPredFailure (Shelley.WrongNetworkWithdrawal Network
n Set RewardAccount
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 RewardAccount -> PDoc
pcRewardAccount Set RewardAccount
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)
x, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = Set (KeyHash 'Genesis)
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). KeyHash discriminator -> PDoc
pcKeyHash Set (KeyHash 'Genesis)
x)
    , (Text
"KeyHashes which should be voting", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Set (KeyHash 'Genesis)
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
txins) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"BadInputsUTxO" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
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 Mismatch {Integer
mismatchExpected :: Integer
mismatchSupplied :: Integer
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..}) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"MaxTxSizeUTxO"
    [ (Text
"Actual", forall a. Integer -> Doc a
ppInteger Integer
mismatchSupplied)
    , (Text
"max transaction size", forall a. Integer -> Doc a
ppInteger Integer
mismatchExpected)
    ]
ppAllegraUtxoPredFailure (AllegraUtxoPredFailure era
Allegra.InputSetEmptyUTxO) = Text -> [PDoc] -> PDoc
ppSexp Text
"InputSetEmptyUTxO" []
ppAllegraUtxoPredFailure (Allegra.FeeTooSmallUTxO Mismatch {Coin
mismatchExpected :: Coin
mismatchSupplied :: Coin
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..}) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"FeeTooSmallUTxO"
    [ (Text
"min fee for this transaction", Coin -> PDoc
pcCoin Coin
mismatchExpected)
    , (Text
"fee supplied by this transaction", Coin -> PDoc
pcCoin Coin
mismatchSupplied)
    ]
ppAllegraUtxoPredFailure (Allegra.ValueNotConservedUTxO Mismatch {Value era
mismatchExpected :: Value era
mismatchSupplied :: Value era
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..}) =
  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
mismatchSupplied)
    , (Text
"coin produced", forall era. Proof era -> Value era -> PDoc
pcVal @era forall era. Reflect era => Proof era
reify Value era
mismatchExpected)
    ]
ppAllegraUtxoPredFailure (Allegra.WrongNetwork Network
n Set Addr
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 Addr -> PDoc
pcAddr Set Addr
add)
    ]
ppAllegraUtxoPredFailure (Allegra.WrongNetworkWithdrawal Network
n Set RewardAccount
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 RewardAccount -> PDoc
pcRewardAccount Set RewardAccount
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) 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). KeyHash discriminator -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) 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 :: TxBodyField era -> [(Text, PDoc)]
txBodyFieldSummary :: forall era. TxBodyField era -> [(Text, PDoc)]
txBodyFieldSummary TxBodyField era
txb = case TxBodyField era
txb of
  (Inputs Set TxIn
s) -> [(Text
"Inputs", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set TxIn
s))]
  (Collateral Set TxIn
s) -> [(Text
"Collateral", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set TxIn
s))]
  (RefInputs Set TxIn
s) -> [(Text
"RefInputs", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set TxIn
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
x) -> [(Text
"Withdrawals", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size (Withdrawals -> Map RewardAccount Coin
unWithdrawals Withdrawals
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)
x) -> [(Text
"Required Signer hashes", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set (KeyHash 'Witness)
x))]
  (Fields.Mint MultiAsset
ma) -> [(Text
"Mint", forall a. Integer -> Doc a
ppInteger (forall t. Val t => t -> Integer
Val.size (Coin -> MultiAsset -> MaryValue
MaryValue forall a. Monoid a => a
mempty MultiAsset
ma)) forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> Doc a
ppString [Char]
" bytes")]
  (WppHash (SJust ScriptIntegrityHash
_)) -> [(Text
"WppHash", forall a. [Char] -> Doc a
ppString [Char]
"?")]
  (AdHash (SJust TxAuxDataHash
_)) -> [(Text
"AdHash", forall a. [Char] -> Doc a
ppString [Char]
"?")]
  (Txnetworkid (SJust Network
x)) -> [(Text
"Network id", Network -> PDoc
ppNetwork Network
x)]
  TxBodyField era
_ -> []

bodySummary :: Proof era -> TxBody era -> PDoc
bodySummary :: forall 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. 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)
s) -> (Text
"Address Witnesses", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set (WitVKey 'Witness)
s))
  (BootWits Set BootstrapWitness
s) -> (Text
"BootStrap Witnesses", forall a. Int -> Doc a
ppInt (forall a. Set a -> Int
Set.size Set BootstrapWitness
s))
  (ScriptWits Map ScriptHash (Script era)
s) -> (Text
"Script Witnesses", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map ScriptHash (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 (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 :: Proof era -> TxField era -> [PDoc]
txFieldSummary :: forall era. Proof era -> TxField era -> [PDoc]
txFieldSummary Proof era
proof TxField era
tx = case TxField era
tx of
  (Body TxBody era
b) -> [forall 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. 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 :: Proof era -> Tx era -> PDoc
txSummary :: forall 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. 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 -> PDoc
txInSummary :: TxIn -> PDoc
txInSummary (TxIn (TxId SafeHash EraIndependentTxBody
h) TxIx
n) = Text -> [PDoc] -> PDoc
ppSexp Text
"TxIn" [PDoc -> PDoc
trim (forall index. SafeHash index -> PDoc
ppSafeHash SafeHash 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
addr Value ConwayEra
v Datum ConwayEra
d StrictMaybe (Script ConwayEra)
s) =
  Text -> [PDoc] -> PDoc
ppSexp
    Text
"TxOut"
    [Addr -> PDoc
addrSummary Addr
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value ConwayEra
v, forall era. Era era => Datum era -> PDoc
datumSummary Datum ConwayEra
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)
s]
txOutSummary p :: Proof era
p@Proof era
Babbage (BabbageTxOut Addr
addr Value BabbageEra
v Datum BabbageEra
d StrictMaybe (Script BabbageEra)
s) =
  Text -> [PDoc] -> PDoc
ppSexp
    Text
"TxOut"
    [Addr -> PDoc
addrSummary Addr
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value BabbageEra
v, forall era. Era era => Datum era -> PDoc
datumSummary Datum BabbageEra
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)
s]
txOutSummary p :: Proof era
p@Proof era
Alonzo (AlonzoTxOut Addr
addr Value AlonzoEra
v StrictMaybe DataHash
md) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
addrSummary Addr
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value AlonzoEra
v, forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe DataHash -> PDoc
dataHashSummary StrictMaybe DataHash
md]
txOutSummary p :: Proof era
p@Proof era
Mary (ShelleyTxOut Addr
addr Value MaryEra
v) = Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
addrSummary Addr
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value MaryEra
v]
txOutSummary p :: Proof era
p@Proof era
Allegra (ShelleyTxOut Addr
addr Value AllegraEra
v) = Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
addrSummary Addr
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value AllegraEra
v]
txOutSummary p :: Proof era
p@Proof era
Shelley (ShelleyTxOut Addr
addr Value ShelleyEra
v) = Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
addrSummary Addr
addr, forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value ShelleyEra
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
h) = Text -> [PDoc] -> PDoc
ppSexp Text
"DHash" [PDoc -> PDoc
trim (forall index. SafeHash index -> PDoc
ppSafeHash DataHash
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 -> PDoc
multiAssetSummary :: MultiAsset -> PDoc
multiAssetSummary (MultiAsset Map PolicyID (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 (Map AssetName Integer)
m))

vSummary :: MaryValue -> PDoc
vSummary :: MaryValue -> PDoc
vSummary (MaryValue Coin
n MultiAsset
ma) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Value" [Coin -> PDoc
pcCoin Coin
n, MultiAsset -> PDoc
multiAssetSummary MultiAsset
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 -> PDoc
addrSummary :: Addr -> PDoc
addrSummary (Addr Network
nw PaymentCredential
pay StakeReference
stk) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Addr" [Network -> PDoc
networkSummary Network
nw, forall (keyrole :: KeyRole). Credential keyrole -> PDoc
credSummary PaymentCredential
pay, StakeReference -> PDoc
stakeSummary StakeReference
stk]
addrSummary (AddrBootstrap (BootstrapAddress (Byron.Address AddressHash Address'
x Attributes AddrAttributes
_ AddrType
_))) = forall a. [Char] -> Doc a
ppString ([Char]
"BootAddr " forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
10 (forall a. Show a => a -> [Char]
show AddressHash Address'
x))

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

stakeSummary :: StakeReference -> PDoc
stakeSummary :: StakeReference -> PDoc
stakeSummary StakeReference
StakeRefNull = forall a. [Char] -> Doc a
ppString [Char]
"Null"
stakeSummary (StakeRefPtr Ptr
_) = forall a. [Char] -> Doc a
ppString [Char]
"Ptr"
stakeSummary (StakeRefBase Credential 'Staking
x) = Text -> [PDoc] -> PDoc
ppSexp Text
"Stake" [forall (keyrole :: KeyRole). Credential keyrole -> PDoc
credSummary (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole Credential 'Staking
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 TxIn -> 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 (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 TxIn -> 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 (TxOut era)
unUTxO

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

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

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

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

vKeySummary :: VKey r -> PDoc
vKeySummary :: forall (r :: KeyRole). VKey r -> PDoc
vKeySummary vk :: VKey r
vk@(VKey VerKeyDSIGN DSIGN
x) = forall a ann. Show a => a -> Doc ann
viaShow VerKeyDSIGN DSIGN
x forall a. Semigroup a => a -> a -> a
<> PDoc
" (hash " forall a. Semigroup a => a -> a -> a
<> forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
keyHashSummary (forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey VKey r
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
akh) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Signature" [forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
keyHashSummary KeyHash 'Witness
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
hk) = Text -> [PDoc] -> PDoc
ppSexp Text
"ReqSig" [forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
keyHashSummary KeyHash 'Witness
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
<> ScriptHash -> PDoc
scriptHashSummary (forall era. EraScript era => Script era -> ScriptHash
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
<> ScriptHash -> PDoc
scriptHashSummary (forall era. EraScript era => Script era -> ScriptHash
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
<> ScriptHash -> PDoc
scriptHashSummary (forall era. EraScript era => Script era -> ScriptHash
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
umap Map FutureGenDeleg GenDelegPair
future (GenDelegs Map (KeyHash 'Genesis) GenDelegPair
current) InstantaneousRewards
irwd) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"DState"
    [ (Text
"Unified Reward Map", UMap -> PDoc
uMapSummary UMap
umap)
    , (Text
"Future genesis key delegations", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map FutureGenDeleg GenDelegPair
future))
    , (Text
"Genesis key delegations", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (KeyHash 'Genesis) GenDelegPair
current))
    , (Text
"Instantaneous Rewards", InstantaneousRewards -> PDoc
instantSummary InstantaneousRewards
irwd)
    ]

instantSummary :: InstantaneousRewards -> PDoc
instantSummary :: InstantaneousRewards -> PDoc
instantSummary (InstantaneousRewards Map (Credential 'Staking) Coin
reserves Map (Credential 'Staking) 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) Coin
reserves))
    , (Text
"Rewards from treasury", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (Credential 'Staking) Coin
treasury))
    , (Text
"Treasury to reserves", DeltaCoin -> PDoc
pcDeltaCoin DeltaCoin
dreserves)
    , (Text
"Reserves to treasury", DeltaCoin -> PDoc
pcDeltaCoin DeltaCoin
dtreasury)
    ]

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

pStateSummary :: PState c -> PDoc
pStateSummary :: forall c. PState c -> PDoc
pStateSummary (PState Map (KeyHash 'StakePool) PoolParams
pp Map (KeyHash 'StakePool) PoolParams
fpp Map (KeyHash 'StakePool) EpochNo
retire Map (KeyHash 'StakePool) 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) PoolParams
pp))
    , (Text
"Future pool parameters", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool) PoolParams
fpp))
    , (Text
"Retiring stake pools", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool) EpochNo
retire))
    , (Text
"Deposits", forall a. Int -> Doc a
ppInt (forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool) 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 -> PDoc
pcTxId :: TxId -> PDoc
pcTxId (TxId SafeHash EraIndependentTxBody
safehash) = PDoc -> PDoc
trim (forall index. SafeHash index -> PDoc
ppSafeHash SafeHash EraIndependentTxBody
safehash)

instance PrettyA TxId where prettyA :: TxId -> PDoc
prettyA = TxId -> PDoc
pcTxId

pcTxIn :: TxIn -> PDoc
pcTxIn :: TxIn -> PDoc
pcTxIn (TxIn (TxId SafeHash 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 index. SafeHash index -> PDoc
ppSafeHash SafeHash EraIndependentTxBody
h), forall a. Word64 -> Doc a
ppWord64 Word64
i])

instance PrettyA TxIn where prettyA :: TxIn -> PDoc
prettyA = TxIn -> 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 -> PDoc
pcKeyHash :: forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
h) = PDoc -> PDoc
trim (forall a b. Hash a b -> PDoc
ppHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
h)

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

pcCredential :: Credential keyrole -> PDoc
pcCredential :: forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential (ScriptHashObj (ScriptHash Hash ADDRHASH 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 EraIndependentScript
h) forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> Doc a
ppString [Char]
")"]
pcCredential (KeyHashObj (KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
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 (VerKeyDSIGN DSIGN)
h) forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> Doc a
ppString [Char]
")"]

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

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

instance PrettyA StakeReference where prettyA :: StakeReference -> PDoc
prettyA = StakeReference -> PDoc
pcStakeReference

pcAddr :: Addr -> PDoc
pcAddr :: Addr -> PDoc
pcAddr (Addr Network
nw PaymentCredential
pay StakeReference
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). Credential keyrole -> PDoc
pcCredential PaymentCredential
pay
      , StakeReference -> PDoc
pcStakeReference StakeReference
stk
      ]
pcAddr (AddrBootstrap BootstrapAddress
x) = PDoc
"BootAddr" forall a. Doc a -> Doc a -> Doc a
<+> BootstrapAddress -> PDoc
pcByronAddress BootstrapAddress
x

instance PrettyA Addr where prettyA :: Addr -> PDoc
prettyA = Addr -> PDoc
pcAddr

pcByronAddress :: BootstrapAddress -> PDoc
pcByronAddress :: BootstrapAddress -> PDoc
pcByronAddress (BootstrapAddress (Byron.Address AddressHash Address'
x Attributes AddrAttributes
_ AddrType
_)) = forall a. [Char] -> Doc a
ppString (forall a. Int -> [a] -> [a]
take Int
10 (forall a. Show a => a -> [Char]
show AddressHash Address'
x))

instance PrettyA BootstrapAddress where prettyA :: BootstrapAddress -> PDoc
prettyA = BootstrapAddress -> PDoc
pcByronAddress

-- | 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 = MaryValue -> PDoc
vSummary Value era
v
pcCoreValue Proof era
Babbage Value era
v = MaryValue -> PDoc
vSummary Value era
v
pcCoreValue Proof era
Alonzo Value era
v = MaryValue -> PDoc
vSummary Value era
v
pcCoreValue Proof era
Mary Value era
v = MaryValue -> 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 -> PDoc
pcValue :: MaryValue -> PDoc
pcValue (MaryValue Coin
n (MultiAsset Map PolicyID (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 PolicyID -> PDoc
pcPolicyID (forall k a. Map k a -> Set k
Map.keysSet Map PolicyID (Map AssetName Integer)
m)
    ]

instance PrettyA MaryValue where
  prettyA :: MaryValue -> PDoc
prettyA = MaryValue -> 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 = MaryValue -> PDoc
pcValue Value era
v
pcVal Proof era
Alonzo Value era
v = MaryValue -> PDoc
pcValue Value era
v
pcVal Proof era
Babbage Value era
v = MaryValue -> PDoc
pcValue Value era
v
pcVal Proof era
Conway Value era
v = MaryValue -> 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
h) = Text -> [PDoc] -> PDoc
ppSexp Text
"DHash" [PDoc -> PDoc
trim (forall index. SafeHash index -> PDoc
ppSafeHash DataHash
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 index. SafeHash index -> PDoc
ppSafeHash (forall era. Data era -> DataHash
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 index. SafeHash index -> PDoc
ppSafeHash (forall era. Data era -> DataHash
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 index. SafeHash index -> PDoc
ppSafeHash (forall era. Data era -> DataHash
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 index. SafeHash index -> PDoc
ppSafeHash (forall era. Data era -> DataHash
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 index. SafeHash index -> PDoc
ppSafeHash (forall era. Data era -> DataHash
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
akh) = Text -> [PDoc] -> PDoc
ppSexp Text
"Sign" [forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'Witness
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, NativeScript era ~ MultiSig era) =>
  PDoc ->
  MultiSig era ->
  PDoc
pcMultiSig :: forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
PDoc -> MultiSig era -> PDoc
pcMultiSig PDoc
h (RequireSignature KeyHash 'Witness
hk) = Text -> [PDoc] -> PDoc
ppSexp Text
"ReqSig" [forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
keyHashSummary KeyHash 'Witness
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
  ( ShelleyEraScript era
  , Reflect era
  , NativeScript era ~ MultiSig era
  ) =>
  PrettyA (MultiSig era)
  where
  prettyA :: MultiSig era -> PDoc
prettyA = forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
PDoc -> MultiSig era -> PDoc
pcMultiSig forall a. Monoid a => a
mempty

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

instance PrettyA ScriptHash where
  prettyA :: ScriptHash -> PDoc
prettyA = ScriptHash -> 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
<> ScriptHash -> PDoc
pcScriptHash (forall era. EraScript era => Script era -> ScriptHash
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
<> ScriptHash -> PDoc
pcScriptHash (forall era. EraScript era => Script era -> ScriptHash
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
<> ScriptHash -> PDoc
pcScriptHash (forall era. EraScript era => Script era -> ScriptHash
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
<> ScriptHash -> PDoc
pcScriptHash (forall era. EraScript era => Script era -> ScriptHash
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
<> ScriptHash -> PDoc
pcScriptHash (forall era. EraScript era => Script era -> ScriptHash
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
<> ScriptHash -> PDoc
pcScriptHash (forall era. EraScript era => Script era -> ScriptHash
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

instance PrettyA DataHash where
  prettyA :: DataHash -> PDoc
prettyA = DataHash -> 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 TxIn -> 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 (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 -> PDoc
pcPoolParams :: PoolParams -> PDoc
pcPoolParams PoolParams
x =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PoolParams"
    [ (Text
"Id", forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (PoolParams -> KeyHash 'StakePool
ppId PoolParams
x))
    , (Text
"Reward accnt", RewardAccount -> PDoc
pcRewardAccount (PoolParams -> RewardAccount
ppRewardAccount PoolParams
x))
    , (Text
"Owners", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (PoolParams -> Set (KeyHash 'Staking)
ppOwners PoolParams
x))
    ]

instance PrettyA PoolParams where prettyA :: PoolParams -> PDoc
prettyA = PoolParams -> PDoc
pcPoolParams

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

instance PrettyA ShelleyDelegCert where prettyA :: ShelleyDelegCert -> PDoc
prettyA = ShelleyDelegCert -> PDoc
pcDelegCert

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

instance PrettyA PoolCert where
  prettyA :: PoolCert -> PDoc
prettyA = PoolCert -> PDoc
pcPoolCert

pcGenesisDelegCert :: GenesisDelegCert -> PDoc
pcGenesisDelegCert :: GenesisDelegCert -> PDoc
pcGenesisDelegCert (GenesisDelegCert KeyHash 'Genesis
a KeyHash 'GenesisDelegate
b VRFVerKeyHash 'GenDelegVRF
c) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"GenesisDelegCert"
    [ (Text
"Genesis", forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'Genesis
a)
    , (Text
"GenesisDelegate", forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'GenesisDelegate
b)
    , (Text
"VerKeyVRF", PDoc -> PDoc
trim (forall (r :: KeyRoleVRF). VRFVerKeyHash r -> PDoc
ppVRFHash VRFVerKeyHash 'GenDelegVRF
c))
    ]

instance PrettyA GenesisDelegCert where
  prettyA :: GenesisDelegCert -> PDoc
prettyA = GenesisDelegCert -> PDoc
pcGenesisDelegCert

pcShelleyTxCert :: ShelleyTxCert c -> PDoc
pcShelleyTxCert :: forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert (ShelleyTxCertDelegCert ShelleyDelegCert
x) = ShelleyDelegCert -> PDoc
pcDelegCert ShelleyDelegCert
x
pcShelleyTxCert (ShelleyTxCertPool PoolCert
x) = PoolCert -> PDoc
pcPoolCert PoolCert
x
pcShelleyTxCert (ShelleyTxCertGenesisDeleg GenesisDelegCert
x) = GenesisDelegCert -> PDoc
pcGenesisDelegCert GenesisDelegCert
x
pcShelleyTxCert (ShelleyTxCertMir (MIRCert MIRPot
x (StakeAddressesMIR Map (Credential 'Staking) 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). Credential keyrole -> PDoc
pcCredential DeltaCoin -> PDoc
pcDeltaCoin Map (Credential 'Staking) 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
dc) = ConwayDelegCert -> PDoc
pcConwayDelegCert ConwayDelegCert
dc
pcConwayTxCert (ConwayTxCertPool PoolCert
poolc) = PoolCert -> PDoc
pcPoolCert PoolCert
poolc
pcConwayTxCert (ConwayTxCertGov ConwayGovCert
x) = ConwayGovCert -> PDoc
pcConwayGovCert ConwayGovCert
x

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

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

instance PrettyA ConwayGovCert where
  prettyA :: ConwayGovCert -> PDoc
prettyA = ConwayGovCert -> PDoc
pcConwayGovCert

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

instance PrettyA ConwayDelegCert where
  prettyA :: ConwayDelegCert -> PDoc
prettyA = ConwayDelegCert -> PDoc
pcConwayDelegCert

instance Reflect era => PrettyA (ConwayDelegEnv era) where
  prettyA :: ConwayDelegEnv era -> PDoc
prettyA ConwayDelegEnv {Map (KeyHash 'StakePool) PoolParams
PParams era
cdePParams :: forall era. ConwayDelegEnv era -> PParams era
cdePools :: forall era.
ConwayDelegEnv era -> Map (KeyHash 'StakePool) PoolParams
cdePools :: Map (KeyHash 'StakePool) PoolParams
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) PoolParams
cdePools)
      ]

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

instance PrettyA Delegatee where
  prettyA :: Delegatee -> PDoc
prettyA = Delegatee -> 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 (Map GovActionId (VotingProcedure era))
m) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"VotingProcedures" [forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Voter -> PDoc
pcVoter (forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap GovActionId -> PDoc
pcGovActionId forall era. VotingProcedure era -> PDoc
pcVotingProcedure) Map Voter (Map GovActionId (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
rewacnt GovAction era
govact Anchor
anch) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ProposalProcedure"
    [ (Text
"Deposit", Coin -> PDoc
pcCoin Coin
c)
    , (Text
"ReturnAddr", RewardAccount -> PDoc
pcRewardAccount RewardAccount
rewacnt)
    , (Text
"GovAction", forall era. GovAction era -> PDoc
pcGovAction GovAction era
govact)
    , (Text
"Anchor", Anchor -> PDoc
pcAnchor Anchor
anch)
    ]

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

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

instance PrettyA Voter where
  prettyA :: Voter -> PDoc
prettyA = Voter -> PDoc
pcVoter

pcVotingProcedure :: VotingProcedure era -> PDoc
pcVotingProcedure :: forall era. VotingProcedure era -> PDoc
pcVotingProcedure (VotingProcedure Vote
v StrictMaybe Anchor
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 Anchor -> PDoc
pcAnchor StrictMaybe Anchor
smA)]

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

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

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

instance PrettyA RewardAccount where prettyA :: RewardAccount -> PDoc
prettyA = RewardAccount -> 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.
  Typeable keyrole =>
  Proof era ->
  WitVKey keyrole ->
  PDoc
pcWitVKey :: forall era (keyrole :: KeyRole).
Typeable keyrole =>
Proof era -> WitVKey keyrole -> PDoc
pcWitVKey Proof era
_p (WitVKey vk :: VKey keyrole
vk@(VKey VerKeyDSIGN DSIGN
x) SignedDSIGN DSIGN (Hash HASH 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
x
    hash :: PDoc
hash = forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey VKey keyrole
vk)
    sigstring :: [Char]
sigstring = forall a. Show a => a -> [Char]
show SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig

instance
  forall era keyrole.
  ( Reflect era
  , Typeable keyrole
  ) =>
  PrettyA (WitVKey keyrole)
  where
  prettyA :: WitVKey keyrole -> PDoc
prettyA = forall era (keyrole :: KeyRole).
Typeable keyrole =>
Proof era -> WitVKey keyrole -> 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) Coin
_ GovRelation StrictMaybe era
_) =
  let EnactState {Map (Credential 'Staking) 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) 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) 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). Credential keyrole -> PDoc
pcCredential Coin -> PDoc
pcCoin Map (Credential 'Staking) 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 -> PDoc
pcGovActionId :: GovActionId -> PDoc
pcGovActionId (GovActionId TxId
txid (GovActionIx Word16
a)) = Text -> [PDoc] -> PDoc
ppSexp Text
"GovActId" [TxId -> PDoc
pcTxId TxId
txid, forall a. Word16 -> Doc a
ppWord16 Word16
a]

instance PrettyA GovActionId where
  prettyA :: GovActionId -> PDoc
prettyA = GovActionId -> PDoc
pcGovActionId

pcGovPurposeId :: GovPurposeId p era -> PDoc
pcGovPurposeId :: forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId (GovPurposeId GovActionId
x) = GovActionId -> PDoc
pcGovActionId GovActionId
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 (CompactForm Coin)
dd Map (Credential 'DRepRole) DRepState
ds Map (KeyHash 'StakePool) (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 DRep -> 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 (CompactForm Coin)
dd)
    , (Text
"drepState", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential DRepState -> PDoc
pcDRepState Map (Credential 'DRepRole) DRepState
ds)
    , (Text
"poolDistr", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> 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) (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
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 GovActionId -> PDoc
pcGovActionId Set GovActionId
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 GovActionId -> PDoc
pcGovActionId forall era. GovActionState era -> PDoc
pcGovActionState (forall era. Proposals era -> Map GovActionId (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
_ Map (Credential 'HotCommitteeRole) Vote
_ Map (Credential 'DRepRole) Vote
_ Map (KeyHash 'StakePool) Vote
_ ProposalProcedure era
_ EpochNo
_ EpochNo
_) =
  let GovActionState {Map (KeyHash 'StakePool) Vote
Map (Credential 'DRepRole) Vote
Map (Credential 'HotCommitteeRole) Vote
ProposalProcedure era
GovActionId
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) Vote
gasDRepVotes :: forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasCommitteeVotes :: forall era.
GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
gasId :: forall era. GovActionState era -> GovActionId
gasExpiresAfter :: EpochNo
gasProposedIn :: EpochNo
gasProposalProcedure :: ProposalProcedure era
gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasDRepVotes :: Map (Credential 'DRepRole) Vote
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole) Vote
gasId :: GovActionId
..} = GovActionState era
gas
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"GovActionState"
        [ (Text
"Id", GovActionId -> PDoc
pcGovActionId GovActionId
gasId)
        , (Text
"CommitteVotes", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Vote -> PDoc
pcVote Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes)
        , (Text
"DRepVotes", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Vote -> PDoc
pcVote Map (Credential 'DRepRole) Vote
gasDRepVotes)
        , (Text
"StakePoolVotes", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Vote -> PDoc
pcVote Map (KeyHash 'StakePool) 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) 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). Credential keyrole -> PDoc
pcCredential forall ann. EpochNo -> Doc ann
ppEpochNo Map (Credential 'ColdCommitteeRole) 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
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
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 Coin
ws StrictMaybe ScriptHash
policy) ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"TreasuryWithdrawals"
      [ (Text
"Withdrawals", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap RewardAccount -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map RewardAccount Coin
ws)
      , (Text
"Policy", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe forall t. PrettyA t => t -> PDoc
prettyA StrictMaybe ScriptHash
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)
toRemove Map (Credential 'ColdCommitteeRole) 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). Credential keyrole -> PDoc
pcCredential Set (Credential 'ColdCommitteeRole)
toRemove)
      , (Text
"membersToAdd", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential forall ann. EpochNo -> Doc ann
ppEpochNo Map (Credential 'ColdCommitteeRole) 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
x StrictMaybe ScriptHash
y) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"Constitution"
    [(Text
"anchor", Anchor -> PDoc
pcAnchor Anchor
x), (Text
"scripthash", forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe ScriptHash -> PDoc
pcScriptHash StrictMaybe ScriptHash
y)]

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

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

instance PrettyA CommitteeAuthorization where
  prettyA :: CommitteeAuthorization -> PDoc
prettyA = CommitteeAuthorization -> 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). Credential keyrole -> PDoc
pcCredential CommitteeAuthorization -> PDoc
ppCommitteeAuthorization (forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds CommitteeState era
x)

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

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

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

instance PrettyA Reward where
  prettyA :: Reward -> PDoc
prettyA = Reward -> PDoc
pcReward

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

instance PrettyA FutureGenDeleg where
  prettyA :: FutureGenDeleg -> PDoc
prettyA = FutureGenDeleg -> PDoc
pcFutureGenDeleg

instance PrettyA GenDelegPair where
  prettyA :: GenDelegPair -> PDoc
prettyA = GenDelegPair -> 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) DRepState
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). Credential keyrole -> PDoc
pcCredential DRepState -> PDoc
pcDRepState Map (Credential 'DRepRole) DRepState
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 -> PDoc
pcAnchor :: Anchor -> PDoc
pcAnchor (Anchor Url
u SafeHash 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 index. SafeHash index -> PDoc
ppSafeHash SafeHash AnchorData
h)
    ]

instance PrettyA Anchor where
  prettyA :: Anchor -> PDoc
prettyA = Anchor -> PDoc
pcAnchor

pcDRepState :: DRepState -> PDoc
pcDRepState :: DRepState -> PDoc
pcDRepState (DRepState EpochNo
expire StrictMaybe Anchor
anchor Coin
deposit Set (Credential 'Staking)
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 Anchor -> PDoc
pcAnchor StrictMaybe Anchor
anchor)
    , (Text
"deposit", Coin -> PDoc
pcCoin Coin
deposit)
    , (Text
"delegations", forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Set (Credential 'Staking)
delegs)
    ]

instance PrettyA DRepState where
  prettyA :: DRepState -> PDoc
prettyA = DRepState -> PDoc
pcDRepState

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

instance PrettyA DRep where
  prettyA :: DRep -> PDoc
prettyA = DRep -> PDoc
pcDRep

pcSnapShotL :: Text -> SnapShot -> [(Text, PDoc)]
pcSnapShotL :: Text -> SnapShot -> [(Text, PDoc)]
pcSnapShotL Text
prefix SnapShot
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). Credential keyrole -> 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 (Stake -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
unStake (SnapShot -> Stake
ssStake SnapShot
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). Credential keyrole -> PDoc
pcCredential forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap (SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations SnapShot
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). KeyHash discriminator -> PDoc
pcKeyHash PoolParams -> PDoc
pcPoolParams (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap (SnapShot -> VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams SnapShot
ss)))
  ]

pcIndividualPoolStake :: IndividualPoolStake -> PDoc
pcIndividualPoolStake :: IndividualPoolStake -> PDoc
pcIndividualPoolStake IndividualPoolStake
x =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"IPS"
    [ (Text
"ratio", forall a. Rational -> Doc a
ppRational (IndividualPoolStake -> Rational
individualPoolStake IndividualPoolStake
x))
    , (Text
"vrf", PDoc -> PDoc
trim (forall (r :: KeyRoleVRF). VRFVerKeyHash r -> PDoc
ppVRFHash (IndividualPoolStake -> VRFVerKeyHash 'StakePoolVRF
individualPoolStakeVrf IndividualPoolStake
x)))
    ]

instance PrettyA IndividualPoolStake where prettyA :: IndividualPoolStake -> PDoc
prettyA = IndividualPoolStake -> PDoc
pcIndividualPoolStake

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

instance PrettyA SnapShots where prettyA :: SnapShots -> PDoc
prettyA = SnapShots -> PDoc
pcSnapShots

pcPoolDistr :: PoolDistr -> PDoc
pcPoolDistr :: PoolDistr -> PDoc
pcPoolDistr (PoolDistr Map (KeyHash 'StakePool) IndividualPoolStake
pdistr CompactForm Coin
tot) =
  forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash IndividualPoolStake -> PDoc
pcIndividualPoolStake Map (KeyHash 'StakePool) IndividualPoolStake
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 IndividualPoolStake -> Rational
individualPoolStake Map (KeyHash 'StakePool) IndividualPoolStake
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 where prettyA :: PoolDistr -> PDoc
prettyA = PoolDistr -> 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
sss NonMyopic
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", SnapShots -> PDoc
pcSnapShots SnapShots
sss)
    , (Text
"NonMyopic", NonMyopic -> PDoc
ppNonMyopic NonMyopic
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
sss NonMyopic
_) =
  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", SnapShots -> PDoc
pcSnapShots SnapShots
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) Natural
pbm) (BlocksMade Map (KeyHash 'StakePool) Natural
cbm) EpochState era
es StrictMaybe PulsingRewUpdate
_ (PoolDistr Map (KeyHash 'StakePool) IndividualPoolStake
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). KeyHash discriminator -> PDoc
pcKeyHash IndividualPoolStake -> PDoc
pcIndividualPoolStake Map (KeyHash 'StakePool) IndividualPoolStake
pd)
    , (Text
"Prev Blocks", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) Natural
pbm)
    , (Text
"Current Blocks", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) 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) Natural
pbm) (BlocksMade Map (KeyHash 'StakePool) Natural
cbm) EpochState era
es StrictMaybe PulsingRewUpdate
_ (PoolDistr Map (KeyHash 'StakePool) IndividualPoolStake
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). KeyHash discriminator -> PDoc
pcKeyHash IndividualPoolStake -> PDoc
pcIndividualPoolStake Map (KeyHash 'StakePool) IndividualPoolStake
pd)
    , (Text
"Prev Blocks", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) Natural
pbm)
    , (Text
"Current Blocks", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) 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) (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) (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 (TxOut era)
u) Coin
dep Coin
fs GovState era
gs (IStake Map (Credential 'Staking) (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 (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) (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) PoolParams
regP Map (KeyHash 'StakePool) PoolParams
fregP Map (KeyHash 'StakePool) EpochNo
ret Map (KeyHash 'StakePool) 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). KeyHash discriminator -> PDoc
pcKeyHash PoolParams -> PDoc
pcPoolParams Map (KeyHash 'StakePool) PoolParams
regP)
    , (Text
"futureRegPools", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash PoolParams -> PDoc
pcPoolParams Map (KeyHash 'StakePool) PoolParams
fregP)
    , (Text
"retiring", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash forall ann. EpochNo -> Doc ann
ppEpochNo Map (KeyHash 'StakePool) EpochNo
ret)
    , (Text
"poolDeposits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Coin -> PDoc
pcCoin Map (KeyHash 'StakePool) 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). Credential keyrole -> PDoc
pcCredential Coin -> PDoc
pcCoin (UMap -> Map (Credential 'Staking) Coin
rewardMap (forall era. DState era -> UMap
dsUnified DState c
ds)))
    , (Text
"deposits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Coin -> PDoc
pcCoin (UMap -> Map (Credential 'Staking) Coin
depositMap (forall era. DState era -> UMap
dsUnified DState c
ds)))
    , (Text
"delegate", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap (forall era. DState era -> UMap
dsUnified DState c
ds)))
    , (Text
"drepDeleg", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential DRep -> PDoc
pcDRep (UMap -> Map (Credential 'Staking) DRep
dRepMap (forall era. DState era -> UMap
dsUnified DState c
ds)))
    , (Text
"ptrs", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Ptr -> PDoc
ppPtr forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential (UMap -> Map Ptr (Credential 'Staking)
ptrMap (forall era. DState era -> UMap
dsUnified DState c
ds)))
    , (Text
"fGenDel", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap FutureGenDeleg -> PDoc
pcFutureGenDeleg GenDelegPair -> PDoc
pcGenDelegPair (forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs DState c
ds))
    , (Text
"GenDel", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash GenDelegPair -> PDoc
pcGenDelegPair (GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair
unGenDelegs (forall era. DState era -> GenDelegs
dsGenDelegs DState c
ds)))
    , (Text
"iRewards", InstantaneousRewards -> PDoc
pcIRewards (forall era. DState era -> InstantaneousRewards
dsIRewards DState c
ds))
    ]

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

pcGenDelegPair :: GenDelegPair -> PDoc
pcGenDelegPair :: GenDelegPair -> PDoc
pcGenDelegPair GenDelegPair
x =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"GDPair"
    [ (Text
"keyhash", forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (GenDelegPair -> KeyHash 'GenesisDelegate
genDelegKeyHash GenDelegPair
x))
    , (Text
"vrfhash", PDoc -> PDoc
trim (forall (r :: KeyRoleVRF). VRFVerKeyHash r -> PDoc
ppVRFHash (GenDelegPair -> VRFVerKeyHash 'GenDelegVRF
genDelegVrfHash GenDelegPair
x)))
    ]

pcIRewards :: InstantaneousRewards -> PDoc
pcIRewards :: InstantaneousRewards -> PDoc
pcIRewards InstantaneousRewards
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). Credential keyrole -> PDoc
pcCredential Coin -> PDoc
pcCoin (InstantaneousRewards -> Map (Credential 'Staking) Coin
DP.iRReserves InstantaneousRewards
xs))
    , (Text
"treasury", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Coin -> PDoc
pcCoin (InstantaneousRewards -> Map (Credential 'Staking) Coin
DP.iRTreasury InstantaneousRewards
xs))
    , (Text
"deltaR", DeltaCoin -> PDoc
pcDeltaCoin (InstantaneousRewards -> DeltaCoin
DP.deltaReserves InstantaneousRewards
xs))
    , (Text
"deltaT", DeltaCoin -> PDoc
pcDeltaCoin (InstantaneousRewards -> DeltaCoin
DP.deltaTreasury InstantaneousRewards
xs))
    ]

instance PrettyA InstantaneousRewards where
  prettyA :: InstantaneousRewards -> PDoc
prettyA = InstantaneousRewards -> 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 -> PDoc
pcPolicyID :: PolicyID -> PDoc
pcPolicyID (PolicyID ScriptHash
sh) = ScriptHash -> PDoc
pcScriptHash ScriptHash
sh

instance PrettyA PolicyID where
  prettyA :: PolicyID -> PDoc
prettyA = PolicyID -> 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 -> PDoc
pcMultiAsset :: MultiAsset -> PDoc
pcMultiAsset MultiAsset
m = forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (PolicyID, AssetName, Integer) -> PDoc
pptriple (MultiAsset -> [(PolicyID, AssetName, Integer)]
flattenMultiAsset MultiAsset
m)
  where
    pptriple :: (PolicyID, AssetName, Integer) -> PDoc
pptriple (PolicyID
i, AssetName
asset, Integer
num) = forall ann. [Doc ann] -> Doc ann
hsep [PDoc
"(", PolicyID -> PDoc
pcPolicyID PolicyID
i, AssetName -> PDoc
pcAssetName AssetName
asset, forall a. Integer -> Doc a
ppInteger Integer
num, PDoc
")"]

instance PrettyA MultiAsset where
  prettyA :: MultiAsset -> PDoc
prettyA = MultiAsset -> 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
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoMinting" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 PolicyID
i]
    AlonzoSpending f Word32 TxIn
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoSpending" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 TxIn
i]
    AlonzoRewarding f Word32 RewardAccount
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoRewarding" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 RewardAccount
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
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayMinting" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 PolicyID
i]
    ConwaySpending f Word32 TxIn
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwaySpending" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 TxIn
i]
    ConwayRewarding f Word32 RewardAccount
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayRewarding" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 RewardAccount
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
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayVoting" [forall t. PrettyA t => t -> PDoc
prettyA f Word32 Voter
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
ss) = Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
ss]
pcScriptsNeeded Proof era
Allegra (ShelleyScriptsNeeded Set ScriptHash
ss) = Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
ss]
pcScriptsNeeded Proof era
Mary (ShelleyScriptsNeeded Set ScriptHash
ss) = Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet ScriptHash -> PDoc
pcScriptHash Set ScriptHash
ss]
pcScriptsNeeded Proof era
Alonzo (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem AlonzoEra, ScriptHash)]
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 ScriptHash -> PDoc
pcScriptHash) [(PlutusPurpose AsIxItem AlonzoEra, ScriptHash)]
pl]
pcScriptsNeeded Proof era
Babbage (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem BabbageEra, ScriptHash)]
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 ScriptHash -> PDoc
pcScriptHash) [(PlutusPurpose AsIxItem BabbageEra, ScriptHash)]
pl]
pcScriptsNeeded Proof era
Conway (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem ConwayEra, ScriptHash)]
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 ScriptHash -> PDoc
pcScriptHash) [(PlutusPurpose AsIxItem ConwayEra, ScriptHash)]
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). Credential keyrole -> PDoc
pcCredential DRep -> PDoc
pcDRep (UMap -> Map (Credential 'Staking) DRep
dRepMap (forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
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) (CompactForm Coin)
dpStakeDistr DRepPulser era Identity (RatifyState era)
x))
    , (Text
"poolDistr", PoolDistr -> PDoc
pcPoolDistr (forall era ans (m :: * -> *). DRepPulser era m ans -> PoolDistr
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 (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). Credential keyrole -> PDoc
pcCredential DRepState -> PDoc
pcDRepState (forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (Credential 'DRepRole) DRepState
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 GovActionId -> 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
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 EpochNo
en PParams era
pp) = Text -> [PDoc] -> PDoc
ppSexp Text
"PoolEnv" [forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
en, 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
esGovActionId :: forall era. EnactSignal era -> GovActionId
esGovAction :: forall era. EnactSignal era -> GovAction era
esGovAction :: GovAction era
esGovActionId :: GovActionId
..} =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"EnactSignal"
    [ (Text
"Gov Action Id", GovActionId -> PDoc
pcGovActionId GovActionId
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 (KeyHash 'StakePool) PoolParams
Map DRep (CompactForm Coin)
Map (Credential 'Staking) DRep
Map (Credential 'Staking) (CompactForm Coin)
Map (Credential 'DRepRole) DRepState
CommitteeState era
PoolDistr
EpochNo
reStakeDistr :: forall era.
RatifyEnv era -> Map (Credential 'Staking) (CompactForm Coin)
reStakePoolDistr :: forall era. RatifyEnv era -> PoolDistr
reDRepDistr :: forall era. RatifyEnv era -> Map DRep (CompactForm Coin)
reDRepState :: forall era. RatifyEnv era -> Map (Credential 'DRepRole) DRepState
reCurrentEpoch :: forall era. RatifyEnv era -> EpochNo
reCommitteeState :: forall era. RatifyEnv era -> CommitteeState era
reDelegatees :: forall era. RatifyEnv era -> Map (Credential 'Staking) DRep
rePoolParams :: forall era. RatifyEnv era -> Map (KeyHash 'StakePool) PoolParams
rePoolParams :: Map (KeyHash 'StakePool) PoolParams
reDelegatees :: Map (Credential 'Staking) DRep
reCommitteeState :: CommitteeState era
reCurrentEpoch :: EpochNo
reDRepState :: Map (Credential 'DRepRole) DRepState
reDRepDistr :: Map DRep (CompactForm Coin)
reStakePoolDistr :: PoolDistr
reStakeDistr :: Map (Credential 'Staking) (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). Credential keyrole -> 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) (CompactForm Coin)
reStakeDistr)
        , (Text
"StakePoolDistr", PoolDistr -> PDoc
pcPoolDistr PoolDistr
reStakePoolDistr)
        , (Text
"DRepDistr", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap DRep -> 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 (CompactForm Coin)
reDRepDistr)
        , (Text
"DRepState", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential DRepState -> PDoc
pcDRepState Map (Credential 'DRepRole) DRepState
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
TxId
CertState era
EpochNo
geTxId :: forall era. GovEnv era -> TxId
geEpoch :: forall era. GovEnv era -> EpochNo
gePParams :: forall era. GovEnv era -> PParams era
gePPolicy :: forall era. GovEnv era -> StrictMaybe ScriptHash
geCertState :: forall era. GovEnv era -> CertState era
geCertState :: CertState era
gePPolicy :: StrictMaybe ScriptHash
gePParams :: PParams era
geEpoch :: EpochNo
geTxId :: TxId
..} =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"GovEnv"
    [ (Text
"TxId", TxId -> PDoc
pcTxId TxId
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
Maybe EpochNo
PParams era
TxIx
SlotNo
AccountState
ledgerSlotNo :: forall era. LedgerEnv era -> SlotNo
ledgerEpochNo :: forall era. LedgerEnv era -> Maybe EpochNo
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
ledgerEpochNo :: Maybe EpochNo
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
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
..} =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"CertEnv"
      [ (Text
"slot no", forall t. PrettyA t => t -> PDoc
prettyA EpochNo
ceCurrentEpoch)
      , (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
_ 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
"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 -> PDoc
pcStake :: Stake -> PDoc
pcStake (Stake VMap VB VP (Credential 'Staking) (CompactForm Coin)
m) = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole). Credential keyrole -> 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) (CompactForm Coin)
m)

instance PrettyA Stake where
  prettyA :: Stake -> PDoc
prettyA Stake
s = Stake -> PDoc
pcStake Stake
s

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

instance PrettyA SnapShot where
  prettyA :: SnapShot -> PDoc
prettyA SnapShot
s = SnapShot -> PDoc
pcSnapShot SnapShot
s

-- | pretty print a TxBody, summarizing the coin in the inputs and outputs.
--   Useful when inspecting to see if the TxBody balances
pcTxBodyWithUTxO :: forall era. Reflect era => UTxO era -> TxBody era -> PDoc
pcTxBodyWithUTxO :: forall era. Reflect era => UTxO era -> TxBody era -> PDoc
pcTxBodyWithUTxO (UTxO Map TxIn (TxOut era)
utxo) 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
    proof :: Proof era
proof = forall era. Reflect era => Proof era
reify @era
    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 TxBodyField era -> [(Text, PDoc)]
f [TxBodyField era]
fields
    f :: TxBodyField era -> [(Text, PDoc)]
f (Inputs Set TxIn
s) =
      [([Char] -> Text
pack [Char]
"spend inputs", Map TxIn (TxOut era) -> PDoc
pcUtxoDoc Map TxIn (TxOut era)
subutxo forall a. Semigroup a => a -> a -> a
<> forall a. Map a Coin -> PDoc
summaryMap (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) Coin
coinTxOutL) Map TxIn (TxOut era)
subutxo))]
      where
        subutxo :: Map TxIn (TxOut era)
subutxo = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxIn (TxOut era)
utxo Set TxIn
s
    f (Collateral Set TxIn
s) = [([Char] -> Text
pack [Char]
"coll inputs", Map TxIn (TxOut era) -> PDoc
pcUtxoDoc Map TxIn (TxOut era)
subutxo)]
      where
        subutxo :: Map TxIn (TxOut era)
subutxo = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxIn (TxOut era)
utxo Set TxIn
s
    f (RefInputs Set TxIn
s) = [([Char] -> Text
pack [Char]
"ref inputs", Map TxIn (TxOut era) -> PDoc
pcUtxoDoc Map TxIn (TxOut era)
subutxo)]
      where
        subutxo :: Map TxIn (TxOut era)
subutxo = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxIn (TxOut era)
utxo Set TxIn
s
    f (Outputs StrictSeq (TxOut era)
x) =
      [([Char] -> Text
pack [Char]
"Outputs", forall ann. [Doc ann] -> Doc ann
sep (forall a b. (a -> b) -> [a] -> [b]
map (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof) [TxOut era]
outs) forall a. Semigroup a => a -> a -> a
<> [Coin] -> PDoc
summaryList (forall a b. (a -> b) -> [a] -> [b]
map (\TxOut era
v -> TxOut era
v forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL) [TxOut era]
outs))]
      where
        outs :: [TxOut era]
outs = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxOut era)
x
    f TxBodyField era
x = forall era. Proof era -> TxBodyField era -> [(Text, PDoc)]
pcTxBodyField Proof era
proof TxBodyField era
x
    pcUtxoDoc :: Map TxIn (TxOut era) -> PDoc
pcUtxoDoc Map TxIn (TxOut era)
m = forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap TxIn -> PDoc
pcTxIn (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof) Map TxIn (TxOut era)
m

summaryMap :: Map a Coin -> PDoc
summaryMap :: forall a. Map a Coin -> PDoc
summaryMap Map a 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 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 Coin
x))

summaryList :: [Coin] -> PDoc
summaryList :: [Coin] -> PDoc
summaryList [Coin]
x = forall a. [Char] -> Doc a
ppString ([Char]
" Count " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Coin]
x) forall a. [a] -> [a] -> [a]
++ [Char]
", Total " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Semigroup a => a -> a -> a
(<>) forall a. Monoid a => a
mempty [Coin]
x))