{-# 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 #-}
{-# LANGUAGE ViewPatterns #-}
{-# 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.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,
  atadrMetadata,
  getAlonzoTxAuxDataScripts,
 )
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..))
import Cardano.Ledger.Alonzo.TxWits (
  AlonzoTxWits,
  AlonzoTxWitsRaw (..),
  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.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 (..),
  ConwayUtxosPredFailure,
  EnactSignal (..),
  GovEnv (..),
  GovSignal (..),
 )
import qualified Cardano.Ledger.Conway.Rules as ConwayRules
import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..))
import Cardano.Ledger.Conway.State (
  ChainAccountState (..),
  ConwayCertState (..),
  ConwayEraCertState (..),
  VState (..),
 )
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 (..),
  SlotNo32 (..),
  StakeReference (..),
 )
import Cardano.Ledger.DRep (DRep (..), DRepState (..))
import Cardano.Ledger.Keys (
  GenDelegPair (..),
  GenDelegs (..),
  HasKeyRole (coerceKeyRole),
  VKey (..),
  WitVKey (..),
 )
import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness (..), ChainCode (..))
import Cardano.Ledger.Mary.Value (
  AssetName (..),
  MaryValue (..),
  MultiAsset (..),
  PolicyID (..),
  flattenMultiAsset,
 )
import Cardano.Ledger.MemoBytes (getMemoRawType)
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.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley.AdaPots (
  AdaPots (..),
  totalAdaES,
  totalAdaPotsES,
 )
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  DState (..),
  EpochState (..),
  EraCertState (..),
  FutureGenDeleg (..),
  InstantaneousRewards (..),
  LedgerState (..),
  NewEpochState (..),
  PState (..),
  RewardUpdate (..),
  UTxOState (..),
 )
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.State (ShelleyCertState (..))
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxAuxData (Metadatum (..), ShelleyTxAuxData (..))
import Cardano.Ledger.Shelley.TxBody (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.State (
  CommitteeAuthorization (..),
  CommitteeState (..),
  IndividualPoolStake (..),
  PoolDistr (..),
  ScriptsNeeded,
  SnapShot (..),
  SnapShots (..),
  Stake (..),
  UTxO (..),
 )
import qualified Cardano.Ledger.State as DP
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 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 qualified Data.VMap as VMap
import Data.Void (Void, absurd)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Natural (Natural)
import Lens.Micro ((^.))
import qualified PlutusLedgerApi.V1 as PV1 (Data (..))
import Prettyprinter (
  Pretty (pretty),
  align,
  brackets,
  comma,
  encloseSep,
  fillSep,
  flatAlt,
  group,
  hang,
  hsep,
  lbrace,
  lparen,
  parens,
  punctuate,
  rbrace,
  reAnnotate,
  rparen,
  sep,
  space,
  vcat,
  viaShow,
  vsep,
  (<+>),
 )
import Prettyprinter.Internal (Doc (Empty))
import Prettyprinter.Util (putDocW)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
import Test.Cardano.Ledger.Generic.Fields (
  PParamsField (..),
  TxBodyField (..),
  TxField (..),
  WitnessesField (..),
  abstractPParams,
  abstractTx,
  abstractTxBody,
  abstractWitnesses,
 )
import qualified Test.Cardano.Ledger.Generic.Fields as Fields
import Test.Cardano.Ledger.Generic.Proof (
  AllegraEra,
  AlonzoEra,
  CertStateWit (..),
  GovStateWit (..),
  MaryEra,
  Proof (..),
  Reflect (..),
  ShelleyEra,
  unReflect,
  whichCertState,
  whichGovState,
 )

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

class PrettyA t where
  prettyA :: t -> PDoc

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

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

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

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

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

instance PrettyA x => PrettyA (NonEmpty x) where
  prettyA :: NonEmpty x -> PDoc
prettyA = [x] -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA ([x] -> PDoc) -> (NonEmpty x -> [x]) -> NonEmpty x -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty x -> [x]
forall a. NonEmpty a -> [a]
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 = (a -> PDoc) -> (b -> PDoc) -> Map a b -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap a -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA b -> PDoc
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) = PDoc -> PDoc -> PDoc -> [PDoc] -> PDoc
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep PDoc
forall ann. Doc ann
lparen PDoc
forall ann. Doc ann
rparen PDoc
forall ann. Doc ann
comma [a -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA a
x, b -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA b
y]

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

instance PrettyA Word64 where
  prettyA :: Word64 -> PDoc
prettyA = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char] -> PDoc) -> (Word64 -> [Char]) -> Word64 -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> [Char]
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 = Int -> Doc ann -> IO ()
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 = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

trim :: PDoc -> PDoc
trim :: PDoc -> PDoc
trim PDoc
x = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
10 (PDoc -> [Char]
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 = [Char] -> Doc a
forall a. [Char] -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty

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

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

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

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

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

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

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

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

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

ppFixedPoint :: FixedPoint -> Doc a
ppFixedPoint :: forall a. FixedPoint -> Doc a
ppFixedPoint = FixedPoint -> Doc a
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' PDoc
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 = ([PrettyAnn] -> [PrettyAnn]) -> PDoc -> PDoc
forall ann ann'. (ann -> ann') -> Doc ann -> Doc ann'
reAnnotate (Int -> PrettyAnn
Width Int
5 PrettyAnn -> [PrettyAnn] -> [PrettyAnn]
forall a. a -> [a] -> [a]
:) (a -> PDoc
forall a ann. Show a => a -> Doc ann
viaShow a
x)

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

ppInt :: Int -> Doc a
ppInt :: forall a. Int -> Doc a
ppInt = Int -> Doc a
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 = Text -> PDoc
forall ann. Text -> Doc ann
text (ByteString -> Text
long_bech32 ByteString
x)

ppLazy :: Lazy.ByteString -> PDoc
ppLazy :: ByteString -> PDoc
ppLazy ByteString
x = Text -> PDoc
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 = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
group (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
flatAlt (Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall ann. Text -> Doc ann
text Text
"=", Doc a
y])) ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
hsep [Doc a
x, Text -> Doc a
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) = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
group (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
flatAlt (Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall ann. Text -> Doc ann
text Text
"->", Doc a
y])) ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
hsep [Doc a
x, Text -> Doc a
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' (Text -> PDoc
forall ann. Text -> Doc ann
text Text
con)

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

ppRecord' :: PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' :: PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' PDoc
con [(Text, PDoc)]
fields =
  PDoc -> PDoc
forall ann. Doc ann -> Doc ann
group (PDoc -> PDoc) -> PDoc -> PDoc
forall a b. (a -> b) -> a -> b
$
    PDoc -> PDoc -> PDoc
forall a. Doc a -> Doc a -> Doc a
flatAlt
      (Int -> PDoc -> PDoc
forall ann. Int -> Doc ann -> Doc ann
hang Int
1 ([PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
vcat [PDoc
con, PDoc -> [PDoc] -> PDoc -> PDoc -> PDoc
forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
puncLeft PDoc
forall ann. Doc ann
lbrace (((Text, PDoc) -> PDoc) -> [(Text, PDoc)] -> [PDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x, PDoc
y) -> PDoc -> PDoc -> PDoc
forall a. Doc a -> Doc a -> Doc a
equate (Text -> PDoc
forall ann. Text -> Doc ann
text Text
x) PDoc
y) [(Text, PDoc)]
fields) PDoc
forall ann. Doc ann
comma PDoc
forall ann. Doc ann
rbrace]))
      ( PDoc
con
          PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc -> PDoc -> PDoc -> [PDoc] -> PDoc
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep
            (PDoc
forall ann. Doc ann
lbrace PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
forall ann. Doc ann
space)
            (PDoc
forall ann. Doc ann
space PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
forall ann. Doc ann
rbrace)
            (PDoc
forall ann. Doc ann
comma PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
forall ann. Doc ann
space)
            (((Text, PDoc) -> PDoc) -> [(Text, PDoc)] -> [PDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x, PDoc
y) -> PDoc -> PDoc -> PDoc
forall a. Doc a -> Doc a -> Doc a
equate (Text -> PDoc
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 = [Doc ann] -> Doc ann
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 = [Doc ann] -> Doc ann
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 = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ((Doc ann
open Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
x) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann] -> [Doc ann]
help [Doc ann]
xs))
  where
    help :: [Doc ann] -> [Doc ann]
help [] = [Doc ann]
forall a. Monoid a => a
mempty
    help [Doc ann
y] = [[Doc ann] -> Doc ann
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 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
y) Doc ann -> [Doc ann] -> [Doc ann]
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 = Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep Doc ann
forall ann. Doc ann
lbrace Doc ann
forall ann. Doc ann
rbrace Doc ann
forall ann. Doc ann
comma ((x -> Doc ann) -> [x] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map x -> Doc ann
p (Set x -> [x]
forall a. Set a -> [a]
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 = (a -> PDoc) -> Set a -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet a -> PDoc
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 = (a -> Doc ann) -> [a] -> Doc ann
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList a -> Doc ann
p ((a -> [a] -> [a]) -> [a] -> Seq a -> [a]
forall a b. (a -> b -> b) -> b -> Seq a -> b
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 = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ (x -> Doc ann) -> [x] -> [Doc ann]
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 = (a -> Doc ann) -> [a] -> Doc ann
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList a -> Doc ann
p ((a -> [a] -> [a]) -> [a] -> StrictSeq a -> [a]
forall a b. (a -> b -> b) -> b -> StrictSeq a -> b
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 = (a -> Doc ann) -> [a] -> Doc ann
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList a -> Doc ann
p ((a -> [a] -> [a]) -> [a] -> OSet a -> [a]
forall a b. (a -> b -> b) -> b -> OSet a -> b
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 = Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"?-"
ppStrictMaybe x -> Doc ann
p (SJust x
x) = Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"?" Doc ann -> Doc ann -> Doc ann
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 = Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"?-"
ppMaybe x -> Doc ann
p (Just x
x) = Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"?" Doc ann -> Doc ann -> Doc ann
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 = ((k, v) -> PDoc) -> [(k, v)] -> [PDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(k
k, v
v) -> (PDoc, PDoc) -> PDoc
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 PDoc -> Bool
forall ann. Doc ann -> Bool
isEmpty PDoc
name
          then Int -> PDoc -> PDoc
forall ann. Int -> Doc ann -> Doc ann
hang Int
1 (PDoc -> [PDoc] -> PDoc -> PDoc -> PDoc
forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
puncLeft PDoc
forall ann. Doc ann
lbrace [PDoc]
docs PDoc
forall ann. Doc ann
comma PDoc
forall ann. Doc ann
rbrace)
          else Int -> PDoc -> PDoc
forall ann. Int -> Doc ann -> Doc ann
hang Int
1 ([PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
vcat [PDoc
name, PDoc -> [PDoc] -> PDoc -> PDoc -> PDoc
forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
puncLeft PDoc
forall ann. Doc ann
lbrace [PDoc]
docs PDoc
forall ann. Doc ann
comma PDoc
forall ann. Doc ann
rbrace])
   in PDoc -> PDoc
forall ann. Doc ann -> Doc ann
group (PDoc -> PDoc) -> PDoc -> PDoc
forall a b. (a -> b) -> a -> b
$
        PDoc -> PDoc -> PDoc
forall a. Doc a -> Doc a -> Doc a
flatAlt
          PDoc
vertical
          (PDoc
name PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc -> PDoc -> PDoc -> [PDoc] -> PDoc
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep (PDoc
forall ann. Doc ann
lbrace PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
forall ann. Doc ann
space) (PDoc
forall ann. Doc ann
space PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
forall ann. Doc ann
rbrace) (PDoc
forall ann. Doc ann
comma PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
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 = PDoc -> (k -> PDoc) -> (v -> PDoc) -> [(k, v)] -> PDoc
forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> [(k, v)] -> PDoc
ppAssocList PDoc
name k -> PDoc
kf v -> PDoc
vf ([(k, v)] -> PDoc) -> (Map k v -> [(k, v)]) -> Map k v -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
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 = PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' (Text -> PDoc
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 = PDoc -> (k -> PDoc) -> (v -> PDoc) -> [(k, v)] -> PDoc
forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> [(k, v)] -> PDoc
ppAssocList (Text -> PDoc
forall ann. Text -> Doc ann
text Text
"VMap") k -> PDoc
pk v -> PDoc
pv ([(k, v)] -> PDoc)
-> (VMap kv vv k v -> [(k, v)]) -> VMap kv vv k v -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMap kv vv k v -> [(k, v)]
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" [Float -> PDoc
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", Rational -> PDoc
forall a. Rational -> Doc a
ppRational (Rational -> PDoc) -> Rational -> PDoc
forall a b. (a -> b) -> a -> b
$ NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational NonNegativeInterval
prMem)
    , (Text
"prSteps", Rational -> PDoc
forall a. Rational -> Doc a
ppRational (Rational -> PDoc) -> Rational -> PDoc
forall a b. (a -> b) -> a -> b
$ NonNegativeInterval -> Rational
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 = Text -> PDoc
forall ann. Text -> Doc ann
text Text
"MemberReward"
ppRewardType RewardType
LeaderReward = Text -> PDoc
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" [(LogWeight -> PDoc) -> StrictSeq LogWeight -> PDoc
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", PDoc
-> (KeyHash 'StakePool -> PDoc)
-> (Likelihood -> PDoc)
-> Map (KeyHash 'StakePool) Likelihood
-> PDoc
forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' PDoc
"" KeyHash 'StakePool -> 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", PDoc
-> (Credential 'Staking -> PDoc)
-> (Set Reward -> PDoc)
-> Map (Credential 'Staking) (Set Reward)
-> PDoc
forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' PDoc
forall a. Monoid a => a
mempty Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential ((Reward -> PDoc) -> Set Reward -> PDoc
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 = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char] -> PDoc) -> (Language -> [Char]) -> Language -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> [Char]
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 era -> RawType (AlonzoTxWits era)
forall t. Memoized t => t -> RawType t
getMemoRawType -> AlonzoTxWitsRaw 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", (WitVKey 'Witness -> PDoc) -> Set (WitVKey 'Witness) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (forall era (keyrole :: KeyRole).
Proof era -> WitVKey keyrole -> PDoc
pcWitVKey @era Proof era
forall era. Reflect era => Proof era
reify) Set (WitVKey 'Witness)
vk)
    , (Text
"bootstrap witnesses", (BootstrapWitness -> PDoc) -> Set BootstrapWitness -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet BootstrapWitness -> PDoc
ppBootstrapWitness Set BootstrapWitness
wb)
    , (Text
"scripts map", (ScriptHash -> PDoc)
-> (Script era -> PDoc) -> Map ScriptHash (Script era) -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap ScriptHash -> PDoc
pcScriptHash (Proof era -> Script era -> PDoc
forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
forall era. Reflect era => Proof era
reify) Map ScriptHash (Script era)
sc)
    , (Text
"Data map", (SafeHash EraIndependentData -> PDoc)
-> (Data era -> PDoc)
-> Map (SafeHash EraIndependentData) (Data era)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash Data era -> PDoc
forall era. Era era => Data era -> PDoc
pcData (TxDats era -> Map (SafeHash EraIndependentData) (Data era)
forall era.
TxDats era -> Map (SafeHash EraIndependentData) (Data era)
unTxDats TxDats era
da))
    , (Text
"Redeemer map", (PlutusPurpose AsIx era -> PDoc)
-> ((Data era, ExUnits) -> PDoc)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap PlutusPurpose AsIx era -> PDoc
forall era. Reflect era => PlutusPurpose AsIx era -> PDoc
ppPlutusPurposeAsIx ((Data era -> PDoc)
-> (ExUnits -> PDoc) -> (Data era, ExUnits) -> PDoc
forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair Data era -> PDoc
forall era. Era era => Data era -> PDoc
pcData ExUnits -> PDoc
pcExUnits) (Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
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 = AlonzoTxWits era -> PDoc
forall era. Reflect era => AlonzoTxWits era -> PDoc
ppTxWitness

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

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

ppNetwork :: Network -> PDoc
ppNetwork :: Network -> PDoc
ppNetwork Network
Testnet = Text -> PDoc
forall ann. Text -> Doc ann
text Text
"Testnet"
ppNetwork Network
Mainnet = Text -> PDoc
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", (SlotNo -> PDoc) -> StrictMaybe SlotNo -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe SlotNo -> PDoc
pcSlotNo StrictMaybe SlotNo
b)
    , (Text
"invalidHereafter", (SlotNo -> PDoc) -> StrictMaybe SlotNo -> PDoc
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" [SafeHash EraIndependentTxAuxData -> PDoc
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 = Hash HASH index -> PDoc
forall a b. Hash a b -> PDoc
ppHash (SafeHash index -> Hash HASH index
forall i. SafeHash i -> Hash HASH i
extractHash SafeHash index
x)

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

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

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

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

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

instance PrettyA EpochInterval where
  prettyA :: EpochInterval -> PDoc
prettyA = EpochInterval -> PDoc
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 = Text -> PDoc
forall ann. Text -> Doc ann
text Text
"#" PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> ([PrettyAnn] -> [PrettyAnn]) -> PDoc -> PDoc
forall ann ann'. (ann -> ann') -> Doc ann -> Doc ann'
reAnnotate (Int -> PrettyAnn
Width Int
5 PrettyAnn -> [PrettyAnn] -> [PrettyAnn]
forall a. a -> [a] -> [a]
:) (Hash a b -> PDoc
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 = Hash HASH KeyRoleVRF -> PDoc
forall a b. Hash a b -> PDoc
ppHash (Hash HASH KeyRoleVRF -> PDoc)
-> (VRFVerKeyHash r -> Hash HASH KeyRoleVRF)
-> VRFVerKeyHash r
-> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VRFVerKeyHash r -> Hash HASH KeyRoleVRF
forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Hash HASH KeyRoleVRF
unVRFVerKeyHash

ppUnitInterval :: UnitInterval -> PDoc
ppUnitInterval :: UnitInterval -> PDoc
ppUnitInterval = UnitInterval -> PDoc
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) = Text -> PDoc
forall ann. Text -> Doc ann
text Text
"Nonce" PDoc -> PDoc -> PDoc
forall a. Doc a -> Doc a -> Doc a
<+> Hash HASH Nonce -> PDoc
forall a b. Hash a b -> PDoc
ppHash Hash HASH Nonce
h
ppNonce Nonce
NeutralNonce = Text -> PDoc
forall ann. Text -> Doc ann
text Text
"NeutralNonce"

ppPtr :: Ptr -> PDoc
ppPtr :: Ptr -> PDoc
ppPtr (Ptr (SlotNo32 Word32
slot) TxIx
txIx CertIx
certIx) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Ptr" [Word32 -> PDoc
forall a. Word32 -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty Word32
slot, Int -> PDoc
forall a. Int -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty (TxIx -> Int
txIxToInt TxIx
txIx), Int -> PDoc
forall a. Int -> Doc a
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", Natural -> PDoc
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) = [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
vsep [([PrettyAnn] -> [PrettyAnn]) -> PDoc -> PDoc
forall ann ann'. (ann -> ann') -> Doc ann -> Doc ann'
reAnnotate (Int -> PrettyAnn
Width Int
5 PrettyAnn -> [PrettyAnn] -> [PrettyAnn]
forall a. a -> [a] -> [a]
:) (VerKeyDSIGN DSIGN -> PDoc
forall a ann. Show a => a -> Doc ann
viaShow VerKeyDSIGN DSIGN
x), PDoc
"hash = " PDoc -> PDoc -> PDoc
forall a. Doc a -> Doc a -> Doc a
<+> KeyHash r -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (VKey r -> KeyHash r
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey VKey r
vk)]

instance PrettyA (VKey r) where
  prettyA :: VKey r -> PDoc
prettyA = VKey r -> PDoc
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", VKey 'Witness -> PDoc
forall (r :: KeyRole). VKey r -> PDoc
ppVKey VKey 'Witness
key)
    , (Text
"signature", SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> PDoc
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", (WitVKey 'Witness -> PDoc) -> Set (WitVKey 'Witness) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (forall era (keyrole :: KeyRole).
Proof era -> WitVKey keyrole -> PDoc
pcWitVKey @era Proof era
forall era. Reflect era => Proof era
reify) Set (WitVKey 'Witness)
addr)
    , (Text
"scriptWits", (ScriptHash -> PDoc)
-> (Script era -> PDoc) -> Map ScriptHash (Script era) -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap ScriptHash -> PDoc
pcScriptHash (Proof era -> Script era -> PDoc
forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
forall era. Reflect era => Proof era
reify) Map ScriptHash (Script era)
scr)
    , (Text
"bootWits", (BootstrapWitness -> PDoc) -> Set BootstrapWitness -> PDoc
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 = ShelleyTxWits era -> PDoc
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Proof era -> [Char]
forall a. Show a => a -> [Char]
show Proof era
proof)) [(Text, PDoc)]
pairs
  where
    fields :: [PParamsField era]
fields = Proof era -> PParamsUpdate era -> [PParamsField era]
forall era. Proof era -> PParamsUpdate era -> [PParamsField era]
Fields.abstractPPUpdate Proof era
proof PParamsUpdate era
pp
    pairs :: [(Text, PDoc)]
pairs = (PParamsField era -> [(Text, PDoc)])
-> [PParamsField era] -> [(Text, PDoc)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PParamsField era -> [(Text, PDoc)]
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 = Proof era -> PParamsUpdate era -> PDoc
forall era. Proof era -> PParamsUpdate era -> PDoc
ppPParamsUpdate Proof era
forall era. Reflect era => Proof era
reify PParamsUpdate era
x

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

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

ppProposedPPUpdates :: PrettyA (PParamsUpdate era) => ProposedPPUpdates era -> PDoc
ppProposedPPUpdates :: forall era.
PrettyA (PParamsUpdate era) =>
ProposedPPUpdates era -> PDoc
ppProposedPPUpdates (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate era)
m) = (KeyHash 'Genesis -> PDoc)
-> (PParamsUpdate era -> PDoc)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'Genesis -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash PParamsUpdate era -> PDoc
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 = ProposedPPUpdates e -> PDoc
forall era.
PrettyA (PParamsUpdate era) =>
ProposedPPUpdates era -> PDoc
ppProposedPPUpdates

ppMetadatum :: Metadatum -> PDoc
ppMetadatum :: Metadatum -> PDoc
ppMetadatum (Map [(Metadatum, Metadatum)]
m) =
  let pairs :: [PDoc]
pairs = ((Metadatum, Metadatum) -> PDoc)
-> [(Metadatum, Metadatum)] -> [PDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Metadatum
k, Metadatum
v) -> (PDoc, PDoc) -> PDoc
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"
        [ PDoc -> PDoc
forall ann. Doc ann -> Doc ann
group (PDoc -> PDoc) -> PDoc -> PDoc
forall a b. (a -> b) -> a -> b
$
            PDoc -> PDoc -> PDoc
forall a. Doc a -> Doc a -> Doc a
flatAlt
              (Int -> PDoc -> PDoc
forall ann. Int -> Doc ann -> Doc ann
hang Int
1 (PDoc -> [PDoc] -> PDoc -> PDoc -> PDoc
forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
puncLeft PDoc
forall ann. Doc ann
lbrace [PDoc]
pairs PDoc
forall ann. Doc ann
comma PDoc
forall ann. Doc ann
rbrace))
              (PDoc -> PDoc -> PDoc -> [PDoc] -> PDoc
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep (PDoc
forall ann. Doc ann
lbrace PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
forall ann. Doc ann
space) (PDoc
forall ann. Doc ann
space PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
forall ann. Doc ann
rbrace) (PDoc
forall ann. Doc ann
comma PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
forall ann. Doc ann
space) [PDoc]
pairs)
        ]
ppMetadatum (List [Metadatum]
ds) = Text -> [PDoc] -> PDoc
ppSexp Text
"List" [(Metadatum -> PDoc) -> [Metadatum] -> PDoc
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" [Integer -> PDoc
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" [Text -> PDoc
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) = PDoc
-> (Word64 -> PDoc)
-> (Metadatum -> PDoc)
-> Map Word64 Metadatum
-> PDoc
forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' (Text -> PDoc
forall ann. Text -> Doc ann
text Text
"ShelleyTxAuxData") Word64 -> PDoc
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 = ShelleyTxAuxData era -> PDoc
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", PDoc
-> (Word64 -> PDoc)
-> (Metadatum -> PDoc)
-> Map Word64 Metadatum
-> PDoc
forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' (Text -> PDoc
forall ann. Text -> Doc ann
text Text
"Metadata") Word64 -> PDoc
forall a. Word64 -> Doc a
ppWord64 Metadatum -> PDoc
ppMetadatum Map Word64 Metadatum
m)
    , (Text
"auxiliaryScripts", (Timelock era -> PDoc) -> StrictSeq (Timelock era) -> PDoc
forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq Timelock era -> PDoc
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 = AllegraTxAuxData era -> PDoc
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"
    [ (Word64 -> PDoc)
-> (Metadatum -> PDoc) -> Map Word64 Metadatum -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Word64 -> PDoc
forall a. Word64 -> Doc a
ppWord64 Metadatum -> PDoc
ppMetadatum (AlonzoTxAuxDataRaw era -> Map Word64 Metadatum
forall era. AlonzoTxAuxDataRaw era -> Map Word64 Metadatum
atadrMetadata (AlonzoTxAuxData era -> RawType (AlonzoTxAuxData era)
forall t. Memoized t => t -> RawType t
getMemoRawType AlonzoTxAuxData era
auxData))
    , (Script era -> PDoc) -> StrictSeq (Script era) -> PDoc
forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq (Proof era -> Script era -> PDoc
forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
forall era. Reflect era => Proof era
reify) (AlonzoTxAuxData era -> StrictSeq (Script era)
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 -> [Char] -> StrictSeq (MultiSig ShelleyEra)
forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Allegra -> [Char] -> StrictSeq (Timelock AllegraEra)
forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Mary -> [Char] -> StrictSeq (Timelock MaryEra)
forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Alonzo -> AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
forall era.
AlonzoEraScript era =>
AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
getAlonzoTxAuxDataScripts AlonzoTxAuxData era
auxData
    Proof era
Babbage -> AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
forall era.
AlonzoEraScript era =>
AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
getAlonzoTxAuxDataScripts AlonzoTxAuxData era
auxData
    Proof era
Conway -> AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
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 = AlonzoTxAuxData era -> PDoc
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 = ShelleyTxAuxData ShelleyEra -> PDoc
forall era. Era era => ShelleyTxAuxData era -> PDoc
ppShelleyTxAuxData TxAuxData era
ShelleyTxAuxData ShelleyEra
x
pcAuxData Proof era
Allegra TxAuxData era
x = AllegraTxAuxData AllegraEra -> PDoc
forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
AllegraTxAuxData era -> PDoc
ppAllegraTxAuxData AllegraTxAuxData AllegraEra
TxAuxData era
x
pcAuxData Proof era
Mary TxAuxData era
x = AllegraTxAuxData MaryEra -> PDoc
forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
AllegraTxAuxData era -> PDoc
ppAllegraTxAuxData AllegraTxAuxData MaryEra
TxAuxData era
x
pcAuxData Proof era
Alonzo TxAuxData era
x = AlonzoTxAuxData AlonzoEra -> PDoc
forall era. Reflect era => AlonzoTxAuxData era -> PDoc
ppAlonzoTxAuxData TxAuxData era
AlonzoTxAuxData AlonzoEra
x
pcAuxData Proof era
Babbage TxAuxData era
x = AlonzoTxAuxData BabbageEra -> PDoc
forall era. Reflect era => AlonzoTxAuxData era -> PDoc
ppAlonzoTxAuxData TxAuxData era
AlonzoTxAuxData BabbageEra
x
pcAuxData Proof era
Conway TxAuxData era
x = AlonzoTxAuxData ConwayEra -> PDoc
forall era. Reflect era => AlonzoTxAuxData era -> PDoc
ppAlonzoTxAuxData TxAuxData era
AlonzoTxAuxData ConwayEra
x

ppWithdrawals :: Withdrawals -> PDoc
ppWithdrawals :: Withdrawals -> PDoc
ppWithdrawals (Withdrawals Map RewardAccount Coin
m) = Text -> [PDoc] -> PDoc
ppSexp Text
"Withdrawals" [PDoc
-> (RewardAccount -> PDoc)
-> (Coin -> PDoc)
-> Map RewardAccount Coin
-> PDoc
forall k v. PDoc -> (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap' (Text -> PDoc
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" [(KeyHash 'Witness -> PDoc) -> Set (KeyHash 'Witness) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet KeyHash 'Witness -> PDoc
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", Proof era -> TxBody era -> PDoc
forall era. Proof era -> TxBody era -> PDoc
pcTxBody Proof era
forall era. Reflect era => Proof era
reify (TxBody era -> PDoc) -> TxBody era -> PDoc
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL)
    , (Text
"witnessSet", Proof era -> TxWits era -> PDoc
forall era. Proof era -> TxWits era -> PDoc
ppCoreWitnesses Proof era
forall era. Reflect era => Proof era
reify (TxWits era -> PDoc) -> TxWits era -> PDoc
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era -> Getting (TxWits era) (Tx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx era) (TxWits era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL)
    , (Text
"metadata", (TxAuxData era -> PDoc) -> StrictMaybe (TxAuxData era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (Proof era -> TxAuxData era -> PDoc
forall era. Proof era -> TxAuxData era -> PDoc
pcAuxData Proof era
forall era. Reflect era => Proof era
reify) (StrictMaybe (TxAuxData era) -> PDoc)
-> StrictMaybe (TxAuxData era) -> PDoc
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era
-> Getting
     (StrictMaybe (TxAuxData era))
     (Tx era)
     (StrictMaybe (TxAuxData era))
-> StrictMaybe (TxAuxData era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxAuxData era))
  (Tx era)
  (StrictMaybe (TxAuxData era))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL)
    ]

instance
  ( Reflect era
  , Tx era ~ ShelleyTx era
  ) =>
  PrettyA (ShelleyTx era)
  where
  prettyA :: ShelleyTx era -> PDoc
prettyA = Tx era -> PDoc
ShelleyTx era -> PDoc
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 = Proof era -> Tx era -> [TxField era]
forall era. Proof era -> Tx era -> [TxField era]
abstractTx Proof era
forall era. Reflect era => Proof era
reify Tx era
AlonzoTx era
tx
    pairs :: [(Text, PDoc)]
pairs = (TxField era -> [(Text, PDoc)]) -> [TxField era] -> [(Text, PDoc)]
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 = AlonzoTx era -> PDoc
forall era.
(Reflect era, Tx era ~ AlonzoTx era) =>
AlonzoTx era -> PDoc
ppAlonzoTx

ppShelleyTxBody ::
  TxBody ShelleyEra ->
  PDoc
ppShelleyTxBody :: TxBody ShelleyEra -> PDoc
ppShelleyTxBody TxBody ShelleyEra
txBody =
  let ShelleyTxBodyRaw Set TxIn
ins StrictSeq (TxOut ShelleyEra)
outs StrictSeq (TxCert ShelleyEra)
cs Withdrawals
withdrawals Coin
fee SlotNo
ttl StrictMaybe (Update ShelleyEra)
upd StrictMaybe TxAuxDataHash
mdh = TxBody ShelleyEra -> RawType (TxBody ShelleyEra)
forall t. Memoized t => t -> RawType t
getMemoRawType TxBody ShelleyEra
txBody
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"TxBody"
        [ (Text
"inputs", (TxIn -> PDoc) -> Set TxIn -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
ins)
        , (Text
"outputs", (TxOut ShelleyEra -> PDoc) -> StrictSeq (TxOut ShelleyEra) -> PDoc
forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq (Proof ShelleyEra -> TxOut ShelleyEra -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof ShelleyEra
forall era. Reflect era => Proof era
reify) StrictSeq (TxOut ShelleyEra)
outs)
        , (Text
"cert", (TxCert ShelleyEra -> PDoc)
-> StrictSeq (TxCert ShelleyEra) -> PDoc
forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq (Proof ShelleyEra -> TxCert ShelleyEra -> PDoc
forall era. Proof era -> TxCert era -> PDoc
pcTxCert Proof ShelleyEra
forall era. Reflect era => Proof era
reify) StrictSeq (TxCert ShelleyEra)
cs)
        , (Text
"withdrawals", Withdrawals -> PDoc
ppWithdrawals Withdrawals
withdrawals)
        , (Text
"fee", Coin -> PDoc
pcCoin Coin
fee)
        , (Text
"timetolive", SlotNo -> PDoc
pcSlotNo SlotNo
ttl)
        , (Text
"update", (Update ShelleyEra -> PDoc)
-> StrictMaybe (Update ShelleyEra) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Update ShelleyEra -> PDoc
forall era. PrettyA (PParamsUpdate era) => Update era -> PDoc
ppPPUpdate StrictMaybe (Update ShelleyEra)
upd)
        , (Text
"metadatahash", (TxAuxDataHash -> PDoc) -> StrictMaybe TxAuxDataHash -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe TxAuxDataHash -> PDoc
ppTxAuxDataHash StrictMaybe TxAuxDataHash
mdh)
        ]

instance PrettyA (TxBody ShelleyEra) where
  prettyA :: TxBody ShelleyEra -> PDoc
prettyA = TxBody ShelleyEra -> PDoc
ppShelleyTxBody

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

instance PrettyA (TxBody AllegraEra) where
  prettyA :: TxBody AllegraEra -> PDoc
prettyA = TxBody AllegraEra -> PDoc
ppAllegraTxBody

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

instance PrettyA (TxBody AlonzoEra) where
  prettyA :: TxBody AlonzoEra -> PDoc
prettyA = TxBody AlonzoEra -> PDoc
ppAlonzoTxBody

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

instance PrettyA (TxBody MaryEra) where
  prettyA :: TxBody MaryEra -> PDoc
prettyA = TxBody MaryEra -> 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 = AlonzoTxWits ConwayEra -> PDoc
forall era. Reflect era => AlonzoTxWits era -> PDoc
ppTxWitness TxWits era
AlonzoTxWits ConwayEra
x
ppCoreWitnesses Proof era
Babbage TxWits era
x = AlonzoTxWits BabbageEra -> PDoc
forall era. Reflect era => AlonzoTxWits era -> PDoc
ppTxWitness TxWits era
AlonzoTxWits BabbageEra
x
ppCoreWitnesses Proof era
Alonzo TxWits era
x = AlonzoTxWits AlonzoEra -> PDoc
forall era. Reflect era => AlonzoTxWits era -> PDoc
ppTxWitness TxWits era
AlonzoTxWits AlonzoEra
x
ppCoreWitnesses Proof era
Mary TxWits era
x = ShelleyTxWits MaryEra -> PDoc
forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD TxWits era
ShelleyTxWits MaryEra
x
ppCoreWitnesses Proof era
Allegra TxWits era
x = ShelleyTxWits AllegraEra -> PDoc
forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD TxWits era
ShelleyTxWits AllegraEra
x
ppCoreWitnesses Proof era
Shelley TxWits era
x = ShelleyTxWits ShelleyEra -> PDoc
forall era. Reflect era => ShelleyTxWits era -> PDoc
ppWitnessSetHKD TxWits era
ShelleyTxWits ShelleyEra
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
MaryValue
v, Datum ConwayEra -> PDoc
forall era. Era era => Datum era -> PDoc
pcDatum Datum ConwayEra
d, (AlonzoScript ConwayEra -> PDoc)
-> StrictMaybe (AlonzoScript ConwayEra) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (Proof era -> Script era -> PDoc
forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
p) StrictMaybe (Script ConwayEra)
StrictMaybe (AlonzoScript 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
MaryValue
v, Datum BabbageEra -> PDoc
forall era. Era era => Datum era -> PDoc
pcDatum Datum BabbageEra
d, (AlonzoScript BabbageEra -> PDoc)
-> StrictMaybe (AlonzoScript BabbageEra) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (Proof era -> Script era -> PDoc
forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
p) StrictMaybe (Script BabbageEra)
StrictMaybe (AlonzoScript BabbageEra)
s]
pcTxOut Proof era
Alonzo (AlonzoTxOut Addr
addr Value AlonzoEra
v StrictMaybe (SafeHash EraIndependentData)
md) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
pcAddr Addr
addr, MaryValue -> PDoc
pcValue Value AlonzoEra
MaryValue
v, (SafeHash EraIndependentData -> PDoc)
-> StrictMaybe (SafeHash EraIndependentData) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe SafeHash EraIndependentData -> PDoc
pcDataHash StrictMaybe (SafeHash EraIndependentData)
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, Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value era
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, Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value era
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, Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value era
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) =
  PDoc -> PDoc
forall ann. Doc ann -> Doc ann
parens ([PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char]
"PlutusScript " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Language -> [Char]
forall a. Show a => a -> [Char]
show (PlutusScript ConwayEra -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript ConwayEra
v) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" "), Proof era -> Script era -> PDoc
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) =
  PDoc -> PDoc
forall ann. Doc ann -> Doc ann
parens ([PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char]
"PlutusScript " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Language -> [Char]
forall a. Show a => a -> [Char]
show (PlutusScript BabbageEra -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript BabbageEra
v) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" "), Proof era -> Script era -> PDoc
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) =
  PDoc -> PDoc
forall ann. Doc ann -> Doc ann
parens ([PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char]
"PlutusScript " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Language -> [Char]
forall a. Show a => a -> [Char]
show (PlutusScript AlonzoEra -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript AlonzoEra
v) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" "), Proof era -> Script era -> PDoc
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 Timelock 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 Timelock 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
MultiSig 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 = Proof era -> TxWits era -> [WitnessesField era]
forall era. Proof era -> TxWits era -> [WitnessesField era]
abstractWitnesses Proof era
proof TxWits era
txwits
    pairs :: [(Text, PDoc)]
pairs = [[(Text, PDoc)]] -> [(Text, PDoc)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((WitnessesField era -> [(Text, PDoc)])
-> [WitnessesField era] -> [[(Text, PDoc)]]
forall a b. (a -> b) -> [a] -> [b]
map (Proof era -> WitnessesField era -> [(Text, PDoc)]
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 = Proof era -> Tx era -> [TxField era]
forall era. Proof era -> Tx era -> [TxField era]
abstractTx Proof era
proof Tx era
tx
    pairs :: [(Text, PDoc)]
pairs = (TxField era -> [(Text, PDoc)]) -> [TxField era] -> [(Text, PDoc)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Reflect era => Proof era -> TxField era -> [(Text, PDoc)])
-> Proof era -> TxField era -> [(Text, PDoc)]
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> TxField era -> [(Text, PDoc)]
Proof era -> TxField era -> [(Text, PDoc)]
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Proof era -> [Char]
forall a. Show a => a -> [Char]
show Proof era
proof)) [(Text, PDoc)]
pairs
  where
    fields :: [TxBodyField era]
fields = Proof era -> TxBody era -> [TxBodyField era]
forall era. Proof era -> TxBody era -> [TxBodyField era]
abstractTxBody Proof era
proof TxBody era
txbody
    pairs :: [(Text, PDoc)]
pairs = (TxBodyField era -> [(Text, PDoc)])
-> [TxBodyField era] -> [(Text, PDoc)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Proof era -> TxBodyField era -> [(Text, PDoc)]
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Proof era -> [Char]
forall a. Show a => a -> [Char]
show Proof era
proof)) [(Text, PDoc)]
pairs
  where
    fields :: [PParamsField era]
fields = Proof era -> PParams era -> [PParamsField era]
forall era. Proof era -> PParams era -> [PParamsField era]
abstractPParams Proof era
proof PParams era
pp
    pairs :: [(Text, PDoc)]
pairs = (PParamsField era -> [(Text, PDoc)])
-> [PParamsField era] -> [(Text, PDoc)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PParamsField era -> [(Text, PDoc)]
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 = Proof era -> PParams era -> PDoc
forall era. Proof era -> PParams era -> PDoc
pcPParams Proof era
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", (TxIn -> PDoc) -> Set TxIn -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
s)]
  Collateral Set TxIn
s -> [(Text
"coll inputs", (TxIn -> PDoc) -> Set TxIn -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
s)]
  RefInputs Set TxIn
s -> [(Text
"ref inputs", (TxIn -> PDoc) -> Set TxIn -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
s)]
  Outputs StrictSeq (TxOut era)
s -> [(Text
"outputs", (TxOut era -> PDoc) -> [TxOut era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ((Reflect era => Proof era -> TxOut era -> PDoc)
-> Proof era -> TxOut era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> TxOut era -> PDoc
Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof) (StrictSeq (TxOut era) -> [TxOut era]
forall a. StrictSeq a -> [a]
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", (Reflect era => Proof era -> TxOut era -> PDoc)
-> Proof era -> TxOut era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> TxOut era -> PDoc
Proof era -> TxOut era -> PDoc
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", (TxCert era -> PDoc) -> [TxCert era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxCert era -> PDoc
forall era. Proof era -> TxCert era -> PDoc
pcTxCert Proof era
proof) (StrictSeq (TxCert era) -> [TxCert era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxCert era)
xs))]
  Withdrawals' (Withdrawals Map RewardAccount Coin
m) -> [(Text
"withdrawal", (RewardAccount -> PDoc)
-> (Coin -> PDoc) -> Map RewardAccount Coin -> PDoc
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", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"UPDATE")]
  ReqSignerHashes Set (KeyHash 'Witness)
s -> [(Text
"required hashes", (KeyHash 'Witness -> PDoc) -> Set (KeyHash 'Witness) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet KeyHash 'Witness -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Set (KeyHash 'Witness)
s)]
  Fields.Mint (MultiAsset Map PolicyID (Map AssetName Integer)
m) -> [(Text
"minted", (PolicyID -> PDoc) -> Set PolicyID -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet PolicyID -> PDoc
pcPolicyID (Map PolicyID (Map AssetName Integer) -> Set PolicyID
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 (ScriptIntegrityHash -> PDoc
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 (SafeHash EraIndependentTxAuxData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash SafeHash EraIndependentTxAuxData
h))]
  Txnetworkid StrictMaybe Network
SNothing -> [(Text
"network id", [Char] -> PDoc
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", (ProposalProcedure era -> PDoc) -> [ProposalProcedure era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ProposalProcedure era -> PDoc
forall era. ProposalProcedure era -> PDoc
pcProposalProcedure (OSet (ProposalProcedure era) -> [ProposalProcedure era]
forall a. OSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OSet (ProposalProcedure era)
props))]
  VotingProc VotingProcedures era
votes -> [(Text
"voting procedure", VotingProcedures era -> PDoc
forall era. VotingProcedures era -> PDoc
pcVotingProcedures VotingProcedures era
votes)]
  CurrentTreasuryValue StrictMaybe Coin
ctv -> [(Text
"current treasury value", (Coin -> PDoc) -> StrictMaybe Coin -> PDoc
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", SafeHash EraIndependentTxBody -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
b)), (Text
"body", Proof era -> TxBody era -> PDoc
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" ([[(Text, PDoc)]] -> [(Text, PDoc)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((TxBodyField era -> [(Text, PDoc)])
-> [TxBodyField era] -> [[(Text, PDoc)]]
forall a b. (a -> b) -> [a] -> [b]
map (Proof era -> TxBodyField era -> [(Text, PDoc)]
forall era. Proof era -> TxBodyField era -> [(Text, PDoc)]
pcTxBodyField Proof era
proof) [TxBodyField era]
xs)))]
  TxWits TxWits era
w -> [(Text
"witnesses", Proof era -> TxWits era -> PDoc
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" ([[(Text, PDoc)]] -> [(Text, PDoc)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((WitnessesField era -> [(Text, PDoc)])
-> [WitnessesField era] -> [[(Text, PDoc)]]
forall a b. (a -> b) -> [a] -> [b]
map (Proof era -> WitnessesField era -> [(Text, PDoc)]
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", Proof era -> TxAuxData era -> PDoc
forall era. Proof era -> TxAuxData era -> PDoc
pcAuxData Proof era
proof TxAuxData era
auxdata)]
  Valid (IsValid Bool
v) -> [(Text
"is valid", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (Bool -> [Char]
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", (WitVKey 'Witness -> PDoc) -> Set (WitVKey 'Witness) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (Proof era -> WitVKey 'Witness -> PDoc
forall era (keyrole :: KeyRole).
Proof era -> WitVKey keyrole -> PDoc
pcWitVKey Proof era
proof) Set (WitVKey 'Witness)
set)]
  BootWits Set BootstrapWitness
bwits -> [(Text
"boot wits", (BootstrapWitness -> PDoc) -> Set BootstrapWitness -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet (\BootstrapWitness
z -> VKey 'Witness -> PDoc
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", (ScriptHash -> PDoc)
-> (Script era -> PDoc) -> Map ScriptHash (Script era) -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap ScriptHash -> PDoc
pcScriptHash (Proof era -> Script era -> PDoc
forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
proof) Map ScriptHash (Script era)
mp)]
  DataWits (TxDats Map (SafeHash EraIndependentData) (Data era)
m) -> [(Text
"data wits", (SafeHash EraIndependentData -> PDoc)
-> (Data era -> PDoc)
-> Map (SafeHash EraIndependentData) (Data era)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap SafeHash EraIndependentData -> PDoc
pcDataHash Data era -> PDoc
forall era. Era era => Data era -> PDoc
pcData Map (SafeHash EraIndependentData) (Data era)
m)]
  RdmrWits Redeemers era
m ->
    [(Text
"redeemer wits", (PlutusPurpose AsIx era -> PDoc)
-> ((Data era, ExUnits) -> PDoc)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap PlutusPurpose AsIx era -> PDoc
forall era. Reflect era => PlutusPurpose AsIx era -> PDoc
ppPlutusPurposeAsIx ((Data era -> PDoc)
-> (ExUnits -> PDoc) -> (Data era, ExUnits) -> PDoc
forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
pcPair Data era -> PDoc
forall era. Era era => Data era -> PDoc
pcData ExUnits -> PDoc
pcExUnits) (Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
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", Word32 -> PDoc
forall a. Word32 -> Doc a
ppWord32 Word32
natural)]
  MaxTxSize Word32
natural -> [(Text
"maxTxsize", Word32 -> PDoc
forall a. Word32 -> Doc a
ppWord32 Word32
natural)]
  MaxBHSize Word16
natural -> [(Text
"maxBHsize", Word16 -> PDoc
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", EpochInterval -> PDoc
forall ann. EpochInterval -> Doc ann
ppEpochInterval EpochInterval
n)]
  NOpt Word16
n -> [(Text
"NOpt", Word16 -> PDoc
forall a. Word16 -> Doc a
ppWord16 Word16
n)]
  A0 NonNegativeInterval
i -> [(Text
"A0", NonNegativeInterval -> PDoc
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", [Char] -> PDoc
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", Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Natural
n)]
  CollateralPercentage Natural
n -> [(Text
"Collateral%", Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Natural
n)]
  MaxCollateralInputs Natural
n -> [(Text
"maxCollateralInputs", Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Natural
n)]
  PoolVotingThreshold PoolVotingThresholds
_ -> [(Text
"PoolVotingThresholds", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"?")]
  DRepVotingThreshold DRepVotingThresholds
_ -> [(Text
"DRepVotingThresholds", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"?")]
  MinCommitteeSize Natural
n -> [(Text
"minCommitteeSize", Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Natural
n)]
  CommitteeTermLimit EpochInterval
n -> [(Text
"committeeTermLimit", EpochInterval -> PDoc
forall ann. EpochInterval -> Doc ann
ppEpochInterval EpochInterval
n)]
  GovActionExpiration EpochInterval
epochNo -> [(Text
"govActionExpire", EpochInterval -> PDoc
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", EpochInterval -> PDoc
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 = ShelleyUtxowPredFailure ShelleyEra -> PDoc
forall era. Reflect era => ShelleyUtxowPredFailure era -> PDoc
ppShelleyUtxowPredFailure PredicateFailure (EraRule "UTXOW" era)
ShelleyUtxowPredFailure ShelleyEra
x
ppUTXOW Proof era
Allegra PredicateFailure (EraRule "UTXOW" era)
x = ShelleyUtxowPredFailure AllegraEra -> PDoc
forall era. Reflect era => ShelleyUtxowPredFailure era -> PDoc
ppShelleyUtxowPredFailure PredicateFailure (EraRule "UTXOW" era)
ShelleyUtxowPredFailure AllegraEra
x
ppUTXOW Proof era
Mary PredicateFailure (EraRule "UTXOW" era)
x = ShelleyUtxowPredFailure MaryEra -> PDoc
forall era. Reflect era => ShelleyUtxowPredFailure era -> PDoc
ppShelleyUtxowPredFailure PredicateFailure (EraRule "UTXOW" era)
ShelleyUtxowPredFailure MaryEra
x
ppUTXOW Proof era
Alonzo PredicateFailure (EraRule "UTXOW" era)
x = AlonzoUtxowPredFailure AlonzoEra -> PDoc
forall era. Reflect era => AlonzoUtxowPredFailure era -> PDoc
ppAlonzoUtxowPredFailure PredicateFailure (EraRule "UTXOW" era)
AlonzoUtxowPredFailure AlonzoEra
x
ppUTXOW p :: Proof era
p@Proof era
Babbage PredicateFailure (EraRule "UTXOW" era)
x = Proof era -> BabbageUtxowPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> BabbageUtxowPredFailure era -> PDoc
ppBabbageUtxowPredFailure Proof era
p PredicateFailure (EraRule "UTXOW" era)
BabbageUtxowPredFailure era
x
ppUTXOW p :: Proof era
p@Proof era
Conway PredicateFailure (EraRule "UTXOW" era)
x = Proof era -> ConwayUtxowPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ConwayUtxowPredFailure era -> PDoc
ppConwayUtxowPredFailure Proof era
p PredicateFailure (EraRule "UTXOW" era)
ConwayUtxowPredFailure 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 = AlonzoUtxosPredFailure AlonzoEra -> PDoc
forall era. Reflect era => AlonzoUtxosPredFailure era -> PDoc
ppUtxosPredicateFailure PredicateFailure (EraRule "UTXOS" era)
AlonzoUtxosPredFailure AlonzoEra
x
ppUTXOS Proof era
Babbage PredicateFailure (EraRule "UTXOS" era)
x = AlonzoUtxosPredFailure BabbageEra -> PDoc
forall era. Reflect era => AlonzoUtxosPredFailure era -> PDoc
ppUtxosPredicateFailure PredicateFailure (EraRule "UTXOS" era)
AlonzoUtxosPredFailure BabbageEra
x
ppUTXOS Proof era
Conway PredicateFailure (EraRule "UTXOS" era)
x = ConwayUtxosPredFailure ConwayEra -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA PredicateFailure (EraRule "UTXOS" era)
ConwayUtxosPredFailure ConwayEra
x
ppUTXOS Proof era
proof PredicateFailure (EraRule "UTXOS" era)
_ =
  [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error
    ( [Char]
"Only the AlonzoEra, BabbageEra, and ConwayEra have a (PredicateFailure (EraRule \"UTXOS\" era))."
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"This Era is "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Proof era -> [Char]
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 = Proof era -> ShelleyDelegsPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
p PredicateFailure (EraRule "DELEGS" era)
ShelleyDelegsPredFailure era
x
ppDELEGS p :: Proof era
p@Proof era
Allegra PredicateFailure (EraRule "DELEGS" era)
x = Proof era -> ShelleyDelegsPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
p PredicateFailure (EraRule "DELEGS" era)
ShelleyDelegsPredFailure era
x
ppDELEGS p :: Proof era
p@Proof era
Mary PredicateFailure (EraRule "DELEGS" era)
x = Proof era -> ShelleyDelegsPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
p PredicateFailure (EraRule "DELEGS" era)
ShelleyDelegsPredFailure era
x
ppDELEGS p :: Proof era
p@Proof era
Alonzo PredicateFailure (EraRule "DELEGS" era)
x = Proof era -> ShelleyDelegsPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
p PredicateFailure (EraRule "DELEGS" era)
ShelleyDelegsPredFailure era
x
ppDELEGS p :: Proof era
p@Proof era
Babbage PredicateFailure (EraRule "DELEGS" era)
x = Proof era -> ShelleyDelegsPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
p PredicateFailure (EraRule "DELEGS" era)
ShelleyDelegsPredFailure era
x
ppDELEGS p :: Proof era
p@Proof era
Conway PredicateFailure (EraRule "DELEGS" era)
_ =
  [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error
    ( [Char]
"Only the Shelley, Allegra, Mary, Alonzo, and Babbage era have a (PredicateFailure (EraRule \"DELEGS\" era))."
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"This Era is "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Proof era -> [Char]
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 = ShelleyDelegPredFailure ShelleyEra -> PDoc
forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure PredicateFailure (EraRule "DELEG" era)
ShelleyDelegPredFailure ShelleyEra
x
ppDELEG Proof era
Allegra PredicateFailure (EraRule "DELEG" era)
x = ShelleyDelegPredFailure AllegraEra -> PDoc
forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure PredicateFailure (EraRule "DELEG" era)
ShelleyDelegPredFailure AllegraEra
x
ppDELEG Proof era
Mary PredicateFailure (EraRule "DELEG" era)
x = ShelleyDelegPredFailure MaryEra -> PDoc
forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure PredicateFailure (EraRule "DELEG" era)
ShelleyDelegPredFailure MaryEra
x
ppDELEG Proof era
Alonzo PredicateFailure (EraRule "DELEG" era)
x = ShelleyDelegPredFailure AlonzoEra -> PDoc
forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure PredicateFailure (EraRule "DELEG" era)
ShelleyDelegPredFailure AlonzoEra
x
ppDELEG Proof era
Babbage PredicateFailure (EraRule "DELEG" era)
x = ShelleyDelegPredFailure BabbageEra -> PDoc
forall era. ShelleyDelegPredFailure era -> PDoc
ppShelleyDelegPredFailure PredicateFailure (EraRule "DELEG" era)
ShelleyDelegPredFailure BabbageEra
x
ppDELEG Proof era
Conway PredicateFailure (EraRule "DELEG" era)
x = ConwayDelegPredFailure ConwayEra -> PDoc
forall era. ConwayDelegPredFailure era -> PDoc
ppConwayDelegPredFailure PredicateFailure (EraRule "DELEG" era)
ConwayDelegPredFailure ConwayEra
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 = ShelleyPoolPredFailure ShelleyEra -> PDoc
forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
ShelleyPoolPredFailure ShelleyEra
x
ppPOOL Proof era
Allegra PredicateFailure (EraRule "POOL" era)
x = ShelleyPoolPredFailure AllegraEra -> PDoc
forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
ShelleyPoolPredFailure AllegraEra
x
ppPOOL Proof era
Mary PredicateFailure (EraRule "POOL" era)
x = ShelleyPoolPredFailure MaryEra -> PDoc
forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
ShelleyPoolPredFailure MaryEra
x
ppPOOL Proof era
Alonzo PredicateFailure (EraRule "POOL" era)
x = ShelleyPoolPredFailure AlonzoEra -> PDoc
forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
ShelleyPoolPredFailure AlonzoEra
x
ppPOOL Proof era
Babbage PredicateFailure (EraRule "POOL" era)
x = ShelleyPoolPredFailure BabbageEra -> PDoc
forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
ShelleyPoolPredFailure BabbageEra
x
ppPOOL Proof era
Conway PredicateFailure (EraRule "POOL" era)
x = ShelleyPoolPredFailure ConwayEra -> PDoc
forall era. ShelleyPoolPredFailure era -> PDoc
ppShelleyPoolPredFailure PredicateFailure (EraRule "POOL" era)
ShelleyPoolPredFailure ConwayEra
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 = Proof era -> ShelleyLedgerPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
ShelleyLedgerPredFailure era
x
ppLEDGER p :: Proof era
p@Proof era
Allegra PredicateFailure (EraRule "LEDGER" era)
x = Proof era -> ShelleyLedgerPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
ShelleyLedgerPredFailure era
x
ppLEDGER p :: Proof era
p@Proof era
Mary PredicateFailure (EraRule "LEDGER" era)
x = Proof era -> ShelleyLedgerPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
ShelleyLedgerPredFailure era
x
ppLEDGER p :: Proof era
p@Proof era
Alonzo PredicateFailure (EraRule "LEDGER" era)
x = Proof era -> ShelleyLedgerPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
ShelleyLedgerPredFailure era
x
ppLEDGER p :: Proof era
p@Proof era
Babbage PredicateFailure (EraRule "LEDGER" era)
x = Proof era -> ShelleyLedgerPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
ShelleyLedgerPredFailure era
x
ppLEDGER p :: Proof era
p@Proof era
Conway PredicateFailure (EraRule "LEDGER" era)
x = Proof era -> ConwayLedgerPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ConwayLedgerPredFailure era -> PDoc
ppConwayLedgerPredFailure Proof era
p PredicateFailure (EraRule "LEDGER" era)
ConwayLedgerPredFailure 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 = ShelleyUtxoPredFailure ShelleyEra -> PDoc
forall era. Reflect era => ShelleyUtxoPredFailure era -> PDoc
ppShelleyUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
ShelleyUtxoPredFailure ShelleyEra
x
ppUTXO Proof era
Allegra PredicateFailure (EraRule "UTXO" era)
x = AllegraUtxoPredFailure AllegraEra -> PDoc
forall era. Reflect era => AllegraUtxoPredFailure era -> PDoc
ppAllegraUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
AllegraUtxoPredFailure AllegraEra
x
ppUTXO Proof era
Mary PredicateFailure (EraRule "UTXO" era)
x = AllegraUtxoPredFailure MaryEra -> PDoc
forall era. Reflect era => AllegraUtxoPredFailure era -> PDoc
ppAllegraUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
AllegraUtxoPredFailure MaryEra
x
ppUTXO Proof era
Alonzo PredicateFailure (EraRule "UTXO" era)
x = AlonzoUtxoPredFailure AlonzoEra -> PDoc
forall era. Reflect era => AlonzoUtxoPredFailure era -> PDoc
ppAlonzoUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
AlonzoUtxoPredFailure AlonzoEra
x
ppUTXO Proof era
Babbage PredicateFailure (EraRule "UTXO" era)
x = BabbageUtxoPredFailure BabbageEra -> PDoc
forall era. Reflect era => BabbageUtxoPredFailure era -> PDoc
ppBabbageUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
BabbageUtxoPredFailure BabbageEra
x
ppUTXO Proof era
Conway PredicateFailure (EraRule "UTXO" era)
x = ConwayUtxoPredFailure ConwayEra -> PDoc
forall era. Reflect era => ConwayUtxoPredFailure era -> PDoc
ppConwayUtxoPredFailure PredicateFailure (EraRule "UTXO" era)
ConwayUtxoPredFailure ConwayEra
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 = (Reflect era =>
 Proof era -> ShelleyLedgersPredFailure ShelleyEra -> PDoc)
-> Proof era -> ShelleyLedgersPredFailure ShelleyEra -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era =>
Proof era -> ShelleyLedgersPredFailure ShelleyEra -> PDoc
Proof era -> ShelleyLedgersPredFailure era -> PDoc
Proof era -> ShelleyLedgersPredFailure ShelleyEra -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
ShelleyLedgersPredFailure ShelleyEra
x
ppLEDGERS p :: Proof era
p@Proof era
Allegra PredicateFailure (EraRule "LEDGERS" era)
x = (Reflect era =>
 Proof era -> ShelleyLedgersPredFailure AllegraEra -> PDoc)
-> Proof era -> ShelleyLedgersPredFailure AllegraEra -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era =>
Proof era -> ShelleyLedgersPredFailure AllegraEra -> PDoc
Proof era -> ShelleyLedgersPredFailure era -> PDoc
Proof era -> ShelleyLedgersPredFailure AllegraEra -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
ShelleyLedgersPredFailure AllegraEra
x
ppLEDGERS p :: Proof era
p@Proof era
Mary PredicateFailure (EraRule "LEDGERS" era)
x = (Reflect era =>
 Proof era -> ShelleyLedgersPredFailure MaryEra -> PDoc)
-> Proof era -> ShelleyLedgersPredFailure MaryEra -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era =>
Proof era -> ShelleyLedgersPredFailure MaryEra -> PDoc
Proof era -> ShelleyLedgersPredFailure era -> PDoc
Proof era -> ShelleyLedgersPredFailure MaryEra -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
ShelleyLedgersPredFailure MaryEra
x
ppLEDGERS p :: Proof era
p@Proof era
Alonzo PredicateFailure (EraRule "LEDGERS" era)
x = (Reflect era =>
 Proof era -> ShelleyLedgersPredFailure AlonzoEra -> PDoc)
-> Proof era -> ShelleyLedgersPredFailure AlonzoEra -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era =>
Proof era -> ShelleyLedgersPredFailure AlonzoEra -> PDoc
Proof era -> ShelleyLedgersPredFailure era -> PDoc
Proof era -> ShelleyLedgersPredFailure AlonzoEra -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
ShelleyLedgersPredFailure AlonzoEra
x
ppLEDGERS p :: Proof era
p@Proof era
Babbage PredicateFailure (EraRule "LEDGERS" era)
x = (Reflect era =>
 Proof era -> ShelleyLedgersPredFailure BabbageEra -> PDoc)
-> Proof era -> ShelleyLedgersPredFailure BabbageEra -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era =>
Proof era -> ShelleyLedgersPredFailure BabbageEra -> PDoc
Proof era -> ShelleyLedgersPredFailure era -> PDoc
Proof era -> ShelleyLedgersPredFailure BabbageEra -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
ShelleyLedgersPredFailure BabbageEra
x
ppLEDGERS p :: Proof era
p@Proof era
Conway PredicateFailure (EraRule "LEDGERS" era)
x = (Reflect era =>
 Proof era -> ShelleyLedgersPredFailure ConwayEra -> PDoc)
-> Proof era -> ShelleyLedgersPredFailure ConwayEra -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era =>
Proof era -> ShelleyLedgersPredFailure ConwayEra -> PDoc
Proof era -> ShelleyLedgersPredFailure era -> PDoc
Proof era -> ShelleyLedgersPredFailure ConwayEra -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
p PredicateFailure (EraRule "LEDGERS" era)
ShelleyLedgersPredFailure ConwayEra
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 = Proof era -> ShelleyDelplPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p PredicateFailure (EraRule "DELPL" era)
ShelleyDelplPredFailure era
x
ppDELPL p :: Proof era
p@Proof era
Allegra PredicateFailure (EraRule "DELPL" era)
x = Proof era -> ShelleyDelplPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p PredicateFailure (EraRule "DELPL" era)
ShelleyDelplPredFailure era
x
ppDELPL p :: Proof era
p@Proof era
Mary PredicateFailure (EraRule "DELPL" era)
x = Proof era -> ShelleyDelplPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p PredicateFailure (EraRule "DELPL" era)
ShelleyDelplPredFailure era
x
ppDELPL p :: Proof era
p@Proof era
Alonzo PredicateFailure (EraRule "DELPL" era)
x = Proof era -> ShelleyDelplPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p PredicateFailure (EraRule "DELPL" era)
ShelleyDelplPredFailure era
x
ppDELPL p :: Proof era
p@Proof era
Babbage PredicateFailure (EraRule "DELPL" era)
x = Proof era -> ShelleyDelplPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
p PredicateFailure (EraRule "DELPL" era)
ShelleyDelplPredFailure era
x
ppDELPL p :: Proof era
p@Proof era
Conway PredicateFailure (EraRule "DELPL" era)
_ =
  [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error
    ( [Char]
"Only the Shelley, Allegra, Mary, Alonzo, and Babbage era have a (PredicateFailure (EraRule \"DELPL\" era))."
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"This Era is "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Proof era -> [Char]
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 = ShelleyNewEpochPredFailure ShelleyEra -> PDoc
forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure PredicateFailure (EraRule "NEWEPOCH" era)
ShelleyNewEpochPredFailure ShelleyEra
x
ppNEWEPOCH Proof era
Allegra PredicateFailure (EraRule "NEWEPOCH" era)
x = ShelleyNewEpochPredFailure AllegraEra -> PDoc
forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure PredicateFailure (EraRule "NEWEPOCH" era)
ShelleyNewEpochPredFailure AllegraEra
x
ppNEWEPOCH Proof era
Mary PredicateFailure (EraRule "NEWEPOCH" era)
x = ShelleyNewEpochPredFailure MaryEra -> PDoc
forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure PredicateFailure (EraRule "NEWEPOCH" era)
ShelleyNewEpochPredFailure MaryEra
x
ppNEWEPOCH Proof era
Alonzo PredicateFailure (EraRule "NEWEPOCH" era)
x = ShelleyNewEpochPredFailure AlonzoEra -> PDoc
forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure PredicateFailure (EraRule "NEWEPOCH" era)
ShelleyNewEpochPredFailure AlonzoEra
x
ppNEWEPOCH Proof era
Babbage PredicateFailure (EraRule "NEWEPOCH" era)
x = ShelleyNewEpochPredFailure BabbageEra -> PDoc
forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure PredicateFailure (EraRule "NEWEPOCH" era)
ShelleyNewEpochPredFailure BabbageEra
x
ppNEWEPOCH Proof era
Conway PredicateFailure (EraRule "NEWEPOCH" era)
x = Void -> PDoc
forall a. Void -> a
absurd Void
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 = ShelleyEpochPredFailure ShelleyEra -> PDoc
forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure PredicateFailure (EraRule "EPOCH" era)
ShelleyEpochPredFailure ShelleyEra
x
ppEPOCH Proof era
Allegra PredicateFailure (EraRule "EPOCH" era)
x = ShelleyEpochPredFailure AllegraEra -> PDoc
forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure PredicateFailure (EraRule "EPOCH" era)
ShelleyEpochPredFailure AllegraEra
x
ppEPOCH Proof era
Mary PredicateFailure (EraRule "EPOCH" era)
x = ShelleyEpochPredFailure MaryEra -> PDoc
forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure PredicateFailure (EraRule "EPOCH" era)
ShelleyEpochPredFailure MaryEra
x
ppEPOCH Proof era
Alonzo PredicateFailure (EraRule "EPOCH" era)
x = ShelleyEpochPredFailure AlonzoEra -> PDoc
forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure PredicateFailure (EraRule "EPOCH" era)
ShelleyEpochPredFailure AlonzoEra
x
ppEPOCH Proof era
Babbage PredicateFailure (EraRule "EPOCH" era)
x = ShelleyEpochPredFailure BabbageEra -> PDoc
forall era. ShelleyEpochPredFailure era -> PDoc
ppShelleyEpochPredFailure PredicateFailure (EraRule "EPOCH" era)
ShelleyEpochPredFailure BabbageEra
x
ppEPOCH Proof era
Conway PredicateFailure (EraRule "EPOCH" era)
_ = [Char] -> PDoc
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 = Proof era -> LedgerState era -> PDoc
forall era. Reflect era => Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p
ppStateLEDGERS p :: Proof era
p@Proof era
Allegra = Proof era -> LedgerState era -> PDoc
forall era. Reflect era => Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p
ppStateLEDGERS p :: Proof era
p@Proof era
Mary = Proof era -> LedgerState era -> PDoc
forall era. Reflect era => Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p
ppStateLEDGERS p :: Proof era
p@Proof era
Alonzo = Proof era -> LedgerState era -> PDoc
forall era. Reflect era => Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p
ppStateLEDGERS p :: Proof era
p@Proof era
Babbage = Proof era -> LedgerState era -> PDoc
forall era. Reflect era => Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
p
ppStateLEDGERS p :: Proof era
p@Proof era
Conway = Proof era -> LedgerState era -> PDoc
forall era. Reflect 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) = KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'StakePool
x
ppShelleyDelegsPredFailure Proof era
_ (WithdrawalsNotInRewardsDELEGS Map RewardAccount Coin
x) = (RewardAccount -> PDoc)
-> (Coin -> PDoc) -> Map RewardAccount Coin -> PDoc
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) = Proof era -> PredicateFailure (EraRule "DELPL" era) -> PDoc
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 = Proof era -> ShelleyDelegsPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelegsPredFailure era -> PDoc
ppShelleyDelegsPredFailure Proof era
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 Proof era
forall era. Reflect era => Proof era
reify PredicateFailure (EraRule "UTXOS" era)
yy]
  ConwayRules.BadInputsUTxO Set TxIn
txins -> Text -> [PDoc] -> PDoc
ppSexp Text
"BadInputsUTxO" [(TxIn -> PDoc) -> Set TxIn -> PDoc
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 :: Integer
mismatchExpected :: Integer
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
..} = Mismatch 'RelLTEQ Integer
mm
     in Text -> [(Text, PDoc)] -> PDoc
ppRecord
          Text
"MaxTxSizeUTxO"
          [ (Text
"Actual", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
mismatchSupplied)
          , (Text
"max transaction size", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
mismatchExpected)
          ]
  ConwayUtxoPredFailure era
ConwayRules.InputSetEmptyUTxO -> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"InputSetEmptyUTxO"
  ConwayRules.FeeTooSmallUTxO mm :: Mismatch 'RelGTEQ Coin
mm@(Mismatch Coin
_ Coin
_) ->
    let Mismatch {Coin
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Coin
mismatchExpected :: Coin
..} = 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 Proof era
forall era. Reflect era => Proof era
reify Value era
consumed)
          , (Text
"coin produced", forall era. Proof era -> Value era -> PDoc
pcVal @era Proof 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", (Addr -> PDoc) -> Set Addr -> PDoc
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", (RewardAccount -> PDoc) -> Set RewardAccount -> PDoc
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", (TxOut era -> PDoc) -> [TxOut era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
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", (TxOut era -> PDoc) -> [TxOut era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
  ConwayRules.OutputTooBigUTxO [(Int, Int, TxOut era)]
xs ->
    Text -> [PDoc] -> PDoc
ppSexp
      Text
"OutputTooBigUTxO"
      [ ((Int, Int, TxOut era) -> PDoc) -> [(Int, Int, TxOut era)] -> PDoc
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", Int -> PDoc
forall a. Int -> Doc a
ppInt Int
a), (Text
"PParam max value", Int -> PDoc
forall a. Int -> Doc a
ppInt Int
b), (Text
"TxOut", Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
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", DeltaCoin -> PDoc
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" [Proof era -> UTxO era -> PDoc
forall era. Proof era -> UTxO era -> PDoc
pcUTxO Proof era
forall era. Reflect era => Proof era
reify UTxO era
u]
  ConwayRules.ExUnitsTooBigUTxO mm :: Mismatch 'RelLTEQ ExUnits
mm@(Mismatch ExUnits
_ ExUnits
_) ->
    let Mismatch {ExUnits
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: ExUnits
mismatchExpected :: ExUnits
..} = 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" [Proof era -> Value era -> PDoc
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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Network
mismatchExpected :: Network
..} = 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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Natural
mismatchExpected :: Natural
..} = Mismatch 'RelLTEQ Natural
mm
     in Text -> [(Text, PDoc)] -> PDoc
ppRecord
          Text
"TooManyCollateralInputs"
          [ (Text
"Number of collateral inputs", Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Natural
mismatchSupplied)
          , (Text
"Max allowed collateral inputs", Natural -> PDoc
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", DeltaCoin -> PDoc
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" [((TxOut era, Coin) -> PDoc) -> [(TxOut era, Coin)] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ((TxOut era -> PDoc) -> (Coin -> PDoc) -> (TxOut era, Coin) -> PDoc
forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
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" [(TxIn -> PDoc) -> [TxIn] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList TxIn -> PDoc
pcTxIn (NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
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 = ConwayUtxoPredFailure era -> PDoc
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) = AlonzoUtxoPredFailure era -> PDoc
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", DeltaCoin -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA DeltaCoin
c1), (Text
"collateral declared", Coin -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA Coin
c2)]
ppBabbageUtxoPredFailure (BabbageOutputTooSmallUTxO [(TxOut era, Coin)]
xs) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"BabbageOutputTooSmallUTxO" [((TxOut era, Coin) -> PDoc) -> [(TxOut era, Coin)] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ((TxOut era -> PDoc) -> (Coin -> PDoc) -> (TxOut era, Coin) -> PDoc
forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
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" [(TxIn -> PDoc) -> [TxIn] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList TxIn -> PDoc
pcTxIn (NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty TxIn
xs)]

instance Reflect era => PrettyA (BabbageUtxoPredFailure era) where
  prettyA :: BabbageUtxoPredFailure era -> PDoc
prettyA = BabbageUtxoPredFailure era -> PDoc
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) = Proof era -> PredicateFailure (EraRule "LEDGER" era) -> PDoc
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 = Proof era -> ShelleyLedgersPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgersPredFailure era -> PDoc
ppShelleyLedgersPredFailure Proof era
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" [NonEmpty (KeyHash 'Staking) -> PDoc
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" [ConwayGovPredFailure ConwayEra -> PDoc
forall era. ConwayGovPredFailure era -> PDoc
ppConwayGovPredFailure PredicateFailure (EraRule "GOV" era)
ConwayGovPredFailure ConwayEra
y]
    Proof era
_ ->
      [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error
        ([Char]
"Only the ConwayEra has a (PredicateFailure (EraRule \"GOV\" era)). This Era is " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Proof era -> [Char]
forall a. Show a => a -> [Char]
show Proof era
proof)
  ConwayUtxowFailure PredicateFailure (EraRule "UTXOW" era)
y -> Proof era -> PredicateFailure (EraRule "UTXOW" era) -> PDoc
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 -> Proof era -> ConwayCertsPredFailure era -> PDoc
forall era. Proof era -> ConwayCertsPredFailure era -> PDoc
ppConwayCertsPredFailure Proof era
proof PredicateFailure (EraRule "CERTS" era)
ConwayCertsPredFailure era
pf
    Proof era
_ ->
      [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error
        ([Char]
"Only the ConwayEra has a (PredicateFailure (EraRule \"CERTS\" era)). This Era is " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Proof era -> [Char]
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", Int -> PDoc
forall a. Int -> Doc a
ppInt Int
s1)
      , (Text
"Maximum allowed total reference script size", Int -> PDoc
forall a. Int -> Doc a
ppInt Int
s2)
      ]
  ConwayMempoolFailure Text
t ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayMempoolFailure" [Text -> PDoc
forall ann. Text -> Doc ann
text Text
t]

instance Reflect era => PrettyA (ConwayLedgerPredFailure era) where
  prettyA :: ConwayLedgerPredFailure era -> PDoc
prettyA = Proof era -> ConwayLedgerPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ConwayLedgerPredFailure era -> PDoc
ppConwayLedgerPredFailure Proof era
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" [Proof era -> PredicateFailure (EraRule "DELEG" era) -> PDoc
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" [Proof era -> PredicateFailure (EraRule "POOL" era) -> PDoc
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" [ConwayGovCertPredFailure ConwayEra -> PDoc
forall era. ConwayGovCertPredFailure era -> PDoc
ppConwayGovCertPredFailure PredicateFailure (EraRule "GOVCERT" era)
ConwayGovCertPredFailure ConwayEra
pf] -- (PredicateFailure (EraRule "GOVCERT" era))
    Proof era
_ ->
      [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error ([Char] -> PDoc) -> [Char] -> PDoc
forall a b. (a -> b) -> a -> b
$
        [Char]
"Only the ConwayEra has a (PredicateFailure (EraRule \"GOVCERT\" era)). This Era is " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Proof era -> [Char]
forall a. Show a => a -> [Char]
show Proof era
proof

instance Reflect era => PrettyA (ConwayRules.ConwayCertPredFailure era) where
  prettyA :: ConwayCertPredFailure era -> PDoc
prettyA = Proof era -> ConwayCertPredFailure era -> PDoc
forall era. Proof era -> ConwayCertPredFailure era -> PDoc
ppConwayCertPredFailure Proof era
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" [Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'DRepRole
x]
  ConwayDRepNotRegistered Credential 'DRepRole
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayDRepNotRegistered" [Credential 'DRepRole -> PDoc
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" [Credential 'ColdCommitteeRole -> PDoc
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" [Credential 'ColdCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'ColdCommitteeRole
c]

instance PrettyA (ConwayGovCertPredFailure era) where
  prettyA :: ConwayGovCertPredFailure era -> PDoc
prettyA = ConwayGovCertPredFailure era -> PDoc
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" [(RewardAccount -> PDoc)
-> (Coin -> PDoc) -> Map RewardAccount Coin -> PDoc
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" [Proof era -> ConwayCertPredFailure era -> PDoc
forall era. Proof era -> ConwayCertPredFailure era -> PDoc
ppConwayCertPredFailure Proof era
proof PredicateFailure (EraRule "CERT" era)
ConwayCertPredFailure era
pf] -- !(PredicateFailure (EraRule "CERT" era))
    Proof era
_ ->
      [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error
        ([Char]
"Only the ConwayEra has a (PredicateFailure (EraRule \"CERT\" era)). This Era is " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Proof era -> [Char]
forall a. Show a => a -> [Char]
show Proof era
proof)

instance Reflect era => PrettyA (ConwayCertsPredFailure era) where
  prettyA :: ConwayCertsPredFailure era -> PDoc
prettyA = Proof era -> ConwayCertsPredFailure era -> PDoc
forall era. Proof era -> ConwayCertsPredFailure era -> PDoc
ppConwayCertsPredFailure Proof era
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" [NonEmpty GovActionId -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA NonEmpty GovActionId
c]
  MalformedProposal GovAction era
ga -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedProposal" [GovAction era -> PDoc
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" [(RewardAccount -> PDoc) -> Set RewardAccount -> PDoc
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" [NonEmpty (Voter, GovActionId) -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (Voter, GovActionId)
m]
  ConflictingCommitteeUpdate Set (Credential 'ColdCommitteeRole)
s ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"ConflictingCommitteeUpdate" [(Credential 'ColdCommitteeRole -> PDoc)
-> Set (Credential 'ColdCommitteeRole) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet Credential 'ColdCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Set (Credential 'ColdCommitteeRole)
s]
  ExpirationEpochTooSmall Map (Credential 'ColdCommitteeRole) EpochNo
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"ExpirationEpochTooSmall" [(Credential 'ColdCommitteeRole -> PDoc)
-> (EpochNo -> PDoc)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'ColdCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo Map (Credential 'ColdCommitteeRole) EpochNo
m]
  InvalidPrevGovActionId ProposalProcedure era
p -> Text -> [PDoc] -> PDoc
ppSexp Text
"InvalidPrevGovActionId" [ProposalProcedure era -> PDoc
forall era. ProposalProcedure era -> PDoc
pcProposalProcedure ProposalProcedure era
p]
  VotingOnExpiredGovAction NonEmpty (Voter, GovActionId)
m ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"VotingOnExpiredGovAction" [NonEmpty (Voter, GovActionId) -> PDoc
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" [(GovPurposeId 'HardForkPurpose era -> PDoc)
-> StrictMaybe (GovPurposeId 'HardForkPurpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId 'HardForkPurpose era -> PDoc
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" [(ScriptHash -> PDoc) -> StrictMaybe ScriptHash -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe ScriptHash -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA StrictMaybe ScriptHash
a, (ScriptHash -> PDoc) -> StrictMaybe ScriptHash -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe ScriptHash -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA StrictMaybe ScriptHash
b]
  DisallowedProposalDuringBootstrap ProposalProcedure era
p ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"DisallowedProposalDuringBootstrap" [ProposalProcedure era -> PDoc
forall era. ProposalProcedure era -> PDoc
pcProposalProcedure ProposalProcedure era
p]
  DisallowedVotesDuringBootstrap NonEmpty (Voter, GovActionId)
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"DisallowedVotesDuringBootstrap" [NonEmpty (Voter, GovActionId) -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA NonEmpty (Voter, GovActionId)
m]
  VotersDoNotExist NonEmpty Voter
m -> Text -> [PDoc] -> PDoc
ppSexp Text
"VotersDoNotExist" [NonEmpty Voter -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA NonEmpty Voter
m]
  ZeroTreasuryWithdrawals GovAction era
ga -> Text -> [PDoc] -> PDoc
ppSexp Text
"ZeroTreasuryWithdrawals" [GovAction era -> PDoc
forall era. GovAction era -> PDoc
pcGovAction GovAction era
ga]
  ProposalReturnAccountDoesNotExist RewardAccount
a -> Text -> [PDoc] -> PDoc
ppSexp Text
"ProposalReturnAccountDoesNotExist" [RewardAccount -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA RewardAccount
a]
  TreasuryWithdrawalReturnAccountsDoNotExist NonEmpty RewardAccount
a -> Text -> [PDoc] -> PDoc
ppSexp Text
"TreasuryWithdrawalReturnAccountsDoNotExist" [NonEmpty RewardAccount -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA NonEmpty RewardAccount
a]

instance PrettyA (ConwayGovPredFailure era) where
  prettyA :: ConwayGovPredFailure era -> PDoc
prettyA = ConwayGovPredFailure era -> PDoc
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) = Proof era -> PredicateFailure (EraRule "UTXOW" era) -> PDoc
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) = Proof era -> PredicateFailure (EraRule "DELEGS" era) -> PDoc
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 = Proof era -> ShelleyLedgerPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ShelleyLedgerPredFailure era -> PDoc
ppShelleyLedgerPredFailure Proof era
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" [Proof era -> PredicateFailure (EraRule "UTXO" era) -> PDoc
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" [(VKey 'Witness -> PDoc) -> [VKey 'Witness] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList VKey 'Witness -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: TxAuxDataHash
mismatchExpected :: TxAuxDataHash
..} = 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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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" [((PlutusPurpose AsItem era, ScriptHash) -> PDoc)
-> [(PlutusPurpose AsItem era, ScriptHash)] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ((PlutusPurpose AsItem era -> PDoc)
-> (ScriptHash -> PDoc)
-> (PlutusPurpose AsItem era, ScriptHash)
-> PDoc
forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair PlutusPurpose AsItem era -> PDoc
forall era. Reflect era => PlutusPurpose AsItem era -> PDoc
ppPlutusPurposeAsItem ScriptHash -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA) [(PlutusPurpose AsItem era, ScriptHash)]
xs]
  ConwayRules.MissingRequiredDatums Set (SafeHash EraIndependentData)
h1 Set (SafeHash EraIndependentData)
h2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"MissingRequiredDatums"
      [ (Text
"received data hashes", (SafeHash EraIndependentData -> PDoc)
-> Set (SafeHash EraIndependentData) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash Set (SafeHash EraIndependentData)
h1)
      , (Text
"missing data hashes", (SafeHash EraIndependentData -> PDoc)
-> Set (SafeHash EraIndependentData) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash Set (SafeHash EraIndependentData)
h2)
      ]
  ConwayRules.NotAllowedSupplementalDatums Set (SafeHash EraIndependentData)
s1 Set (SafeHash EraIndependentData)
s2 ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"NotAllowedSupplementalDatums"
      [ (Text
"unallowed data hashes", (SafeHash EraIndependentData -> PDoc)
-> Set (SafeHash EraIndependentData) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash Set (SafeHash EraIndependentData)
s1)
      , (Text
"acceptable data hashes", (SafeHash EraIndependentData -> PDoc)
-> Set (SafeHash EraIndependentData) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash Set (SafeHash EraIndependentData)
s2)
      ]
  ConwayRules.PPViewHashesDontMatch mm :: Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
mm@(Mismatch StrictMaybe ScriptIntegrityHash
_ StrictMaybe ScriptIntegrityHash
_) ->
    let Mismatch {StrictMaybe ScriptIntegrityHash
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: StrictMaybe ScriptIntegrityHash
mismatchExpected :: StrictMaybe ScriptIntegrityHash
..} = Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
mm
     in Text -> [(Text, PDoc)] -> PDoc
ppRecord
          Text
"PPViewHashesDontMatch"
          [ (Text
"PPHash in the TxBody", (ScriptIntegrityHash -> PDoc)
-> StrictMaybe ScriptIntegrityHash -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe ScriptIntegrityHash -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash StrictMaybe ScriptIntegrityHash
mismatchSupplied)
          , (Text
"PPHash Computed from the current Protocol Parameters", (ScriptIntegrityHash -> PDoc)
-> StrictMaybe ScriptIntegrityHash -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe ScriptIntegrityHash -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash StrictMaybe ScriptIntegrityHash
mismatchExpected)
          ]
  ConwayRules.UnspendableUTxONoDatumHash Set TxIn
x ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"UnspendableUTxONoDatumHash" [(TxIn -> PDoc) -> Set TxIn -> PDoc
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" [(PlutusPurpose AsIx era -> PDoc)
-> [PlutusPurpose AsIx era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList PlutusPurpose AsIx era -> PDoc
forall era. Reflect era => PlutusPurpose AsIx era -> PDoc
ppPlutusPurposeAsIx [PlutusPurpose AsIx era]
x]
  ConwayRules.MalformedScriptWitnesses Set ScriptHash
x -> Text -> [PDoc] -> PDoc
ppSexp Text
"MalformedScriptWitnesses" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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 = Proof era -> ConwayUtxowPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> ConwayUtxowPredFailure era -> PDoc
ppConwayUtxowPredFailure Proof era
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" [AlonzoUtxowPredFailure era -> PDoc
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" [Proof era -> PredicateFailure (EraRule "UTXO" era) -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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 = Proof era -> BabbageUtxowPredFailure era -> PDoc
forall era.
Reflect era =>
Proof era -> BabbageUtxowPredFailure era -> PDoc
ppBabbageUtxowPredFailure Proof era
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", Int -> PDoc
forall a. Int -> Doc a
ppInt Int
supplied)
    , (Text
"claimed BBody Size in Header", Int -> PDoc
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", Hash HASH EraIndependentBlockBody -> PDoc
forall a b. Hash a b -> PDoc
ppHash Hash HASH EraIndependentBlockBody
supplied)
    , (Text
"claimed hash", Hash HASH EraIndependentBlockBody -> PDoc
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 Proof 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 = ShelleyBbodyPredFailure era -> PDoc
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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Int
mismatchExpected :: Int
..} = Mismatch 'RelLTEQ Int
mm
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"BodyRefScriptsSizeTooBig"
        [ (Text
"Computed sum of reference script size", Int -> PDoc
forall a. Int -> Doc a
ppInt Int
mismatchSupplied)
        , (Text
"Maximum allowed total reference script size", Int -> PDoc
forall a. Int -> Doc a
ppInt Int
mismatchExpected)
        ]
ppConwayBbodyPredFail (ConwayRules.TooManyExUnits mm :: Mismatch 'RelLTEQ ExUnits
mm@(Mismatch ExUnits
_ ExUnits
_)) =
  let Mismatch {ExUnits
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: ExUnits
mismatchExpected :: ExUnits
..} = 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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Int
mismatchExpected :: Int
..} = Mismatch 'RelEQ Int
mm
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"WrongBlockBodySizeBBODY"
        [ (Text
"actual computed BBody size", Int -> PDoc
forall a. Int -> Doc a
ppInt Int
mismatchSupplied)
        , (Text
"claimed BBody Size in Header", Int -> PDoc
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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Hash HASH EraIndependentBlockBody
mismatchExpected :: Hash HASH EraIndependentBlockBody
..} = Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody)
mm
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"(InvalidBodyHashBBODY"
        [ (Text
"actual hash", Hash HASH EraIndependentBlockBody -> PDoc
forall a b. Hash a b -> PDoc
ppHash Hash HASH EraIndependentBlockBody
mismatchSupplied)
        , (Text
"claimed hash", Hash HASH EraIndependentBlockBody -> PDoc
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 Proof 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 = ConwayBbodyPredFailure era -> PDoc
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" [ShelleyBbodyPredFailure era -> PDoc
forall era. Reflect era => ShelleyBbodyPredFailure era -> PDoc
ppBbodyPredicateFailure ShelleyBbodyPredFailure era
x]
ppAlonzoBbodyPredFail (TooManyExUnits Mismatch {ExUnits
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: ExUnits
mismatchExpected :: ExUnits
..}) =
  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 = AlonzoBbodyPredFailure era -> PDoc
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 Proof era
forall era. Reflect era => Proof era
reify PredicateFailure (EraRule "NEWEPOCH" era)
x
ppTickPredicateFailure (RupdFailure PredicateFailure (EraRule "RUPD" era)
_) =
  [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"RupdPredicateFailure has no constructors"

instance Reflect era => PrettyA (ShelleyTickPredFailure era) where
  prettyA :: ShelleyTickPredFailure era -> PDoc
prettyA = ShelleyTickPredFailure era -> PDoc
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 Proof era
forall era. Reflect era => Proof era
reify PredicateFailure (EraRule "EPOCH" era)
x
ppShelleyNewEpochPredicateFailure (MirFailure PredicateFailure (EraRule "MIR" era)
_) =
  [Char] -> PDoc
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 = ShelleyNewEpochPredFailure era -> PDoc
forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc
ppShelleyNewEpochPredicateFailure

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

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

instance Reflect era => PrettyA (ShelleyEpochPredFailure era) where
  prettyA :: ShelleyEpochPredFailure era -> PDoc
prettyA = ShelleyEpochPredFailure era -> PDoc
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 = ShelleyPoolreapPredFailure era -> PDoc
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 = ShelleySnapPredFailure era -> PDoc
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) = ShelleyUtxowPredFailure era -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA ShelleyUtxowPredFailure era
x
ppAlonzoUtxowPredFailure (MissingRedeemers [(PlutusPurpose AsItem era, ScriptHash)]
xs) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MissingRedeemers" [((PlutusPurpose AsItem era, ScriptHash) -> PDoc)
-> [(PlutusPurpose AsItem era, ScriptHash)] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ((PlutusPurpose AsItem era -> PDoc)
-> (ScriptHash -> PDoc)
-> (PlutusPurpose AsItem era, ScriptHash)
-> PDoc
forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair PlutusPurpose AsItem era -> PDoc
forall era. Reflect era => PlutusPurpose AsItem era -> PDoc
ppPlutusPurposeAsItem ScriptHash -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA) [(PlutusPurpose AsItem era, ScriptHash)]
xs]
ppAlonzoUtxowPredFailure (MissingRequiredDatums Set (SafeHash EraIndependentData)
s1 Set (SafeHash EraIndependentData)
s2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"MissingRequiredDatums"
    [ (Text
"missing data hashes", (SafeHash EraIndependentData -> PDoc)
-> Set (SafeHash EraIndependentData) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash Set (SafeHash EraIndependentData)
s1)
    , (Text
"received data hashes", (SafeHash EraIndependentData -> PDoc)
-> Set (SafeHash EraIndependentData) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash Set (SafeHash EraIndependentData)
s2)
    ]
ppAlonzoUtxowPredFailure (NotAllowedSupplementalDatums Set (SafeHash EraIndependentData)
s1 Set (SafeHash EraIndependentData)
s2) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"NotAllowedSupplementalDatums"
    [ (Text
"unallowed data hashes", (SafeHash EraIndependentData -> PDoc)
-> Set (SafeHash EraIndependentData) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash Set (SafeHash EraIndependentData)
s1)
    , (Text
"acceptable data hashes", (SafeHash EraIndependentData -> PDoc)
-> Set (SafeHash EraIndependentData) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash Set (SafeHash EraIndependentData)
s2)
    ]
ppAlonzoUtxowPredFailure (PPViewHashesDontMatch Mismatch {StrictMaybe ScriptIntegrityHash
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: StrictMaybe ScriptIntegrityHash
mismatchExpected :: StrictMaybe ScriptIntegrityHash
..}) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PPViewHashesDontMatch"
    [ (Text
"PPHash in the TxBody", (ScriptIntegrityHash -> PDoc)
-> StrictMaybe ScriptIntegrityHash -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe ScriptIntegrityHash -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash StrictMaybe ScriptIntegrityHash
mismatchSupplied)
    , (Text
"PPHash Computed from the current Protocol Parameters", (ScriptIntegrityHash -> PDoc)
-> StrictMaybe ScriptIntegrityHash -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe ScriptIntegrityHash -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash StrictMaybe ScriptIntegrityHash
mismatchExpected)
    ]
ppAlonzoUtxowPredFailure (MissingRequiredSigners Set (KeyHash 'Witness)
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MissingRequiredSigners" [(KeyHash 'Witness -> PDoc) -> Set (KeyHash 'Witness) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet KeyHash 'Witness -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Set (KeyHash 'Witness)
x]
ppAlonzoUtxowPredFailure (UnspendableUTxONoDatumHash Set TxIn
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"UnspendableUTxONoDatumHash" [(TxIn -> PDoc) -> Set TxIn -> PDoc
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" [(PlutusPurpose AsIx era -> PDoc)
-> [PlutusPurpose AsIx era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList PlutusPurpose AsIx era -> PDoc
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 = AlonzoUtxowPredFailure era -> PDoc
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" [(VKey 'Witness -> PDoc) -> [VKey 'Witness] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList VKey 'Witness -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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" [Proof era -> PredicateFailure (EraRule "UTXO" era) -> PDoc
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" [(KeyHash 'Witness -> PDoc) -> Set (KeyHash 'Witness) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet KeyHash 'Witness -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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 = ShelleyUtxowPredFailure era -> PDoc
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" [(TxIn -> PDoc) -> Set TxIn -> PDoc
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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Integer
mismatchExpected :: Integer
..} ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"MaxTxSizeUTxO"
      [(Text
"Actual", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
mismatchSupplied), (Text
"max transaction size", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
mismatchExpected)]
  AlonzoUtxoPredFailure era
Alonzo.InputSetEmptyUTxO -> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"InputSetEmptyUTxO"
  Alonzo.FeeTooSmallUTxO Mismatch {Coin
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Coin
mismatchExpected :: Coin
..} ->
    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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Value era
mismatchExpected :: Value era
..} ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ValueNotConservedUTxO"
      [ (Text
"coin consumed", forall era. Proof era -> Value era -> PDoc
pcVal @era Proof era
forall era. Reflect era => Proof era
reify Value era
mismatchSupplied)
      , (Text
"coin produced", forall era. Proof era -> Value era -> PDoc
pcVal @era Proof 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", (Addr -> PDoc) -> Set Addr -> PDoc
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", (RewardAccount -> PDoc) -> Set RewardAccount -> PDoc
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", (TxOut era -> PDoc) -> [TxOut era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
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 Proof 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", (TxOut era -> PDoc) -> [TxOut era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
  AlonzoUtxoPredFailure era
Alonzo.TriesToForgeADA -> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"TriesToForgeADA"
  Alonzo.OutputTooBigUTxO [(Integer, Integer, TxOut era)]
xs ->
    Text -> [PDoc] -> PDoc
ppSexp
      Text
"OutputTooBigUTxO"
      [ ((Integer, Integer, TxOut era) -> PDoc)
-> [(Integer, Integer, TxOut era)] -> PDoc
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", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
a), (Text
"PParam max value", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
b), (Text
"TxOut", Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
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", DeltaCoin -> PDoc
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" [Proof era -> UTxO era -> PDoc
forall era. Proof era -> UTxO era -> PDoc
pcUTxO Proof era
forall era. Reflect era => Proof era
reify UTxO era
u]
  ExUnitsTooBigUTxO Mismatch {ExUnits
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: ExUnits
mismatchExpected :: ExUnits
..} ->
    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" [Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcVal (forall era. Reflect era => Proof era
reify @era) Value era
v]
  WrongNetworkInTxBody Mismatch {Network
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Network
mismatchExpected :: Network
..} ->
    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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Natural
mismatchExpected :: Natural
..} ->
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"TooManyCollateralInputs"
      [ (Text
"Max allowed collateral inputs", Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Natural
mismatchExpected)
      , (Text
"Number of collateral inputs", Natural -> PDoc
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 = AlonzoUtxoPredFailure era -> PDoc
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" [Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred]
  Shelley.StakeKeyNotRegisteredDELEG Credential 'Staking
cred -> Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyNotRegisteredDELEG" [Credential 'Staking -> PDoc
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" [Credential 'Staking -> PDoc
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" [KeyHash 'Genesis -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'Genesis
kh]
  DuplicateGenesisDelegateDELEG KeyHash 'GenesisDelegate
kh -> Text -> [PDoc] -> PDoc
ppSexp Text
"DuplicateGenesisDelegateDELEG" [KeyHash 'GenesisDelegate -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'GenesisDelegate
kh]
  InsufficientForInstantaneousRewardsDELEG MIRPot
pot Mismatch {Coin
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Coin
mismatchExpected :: Coin
..} ->
    Text -> [PDoc] -> PDoc
ppSexp
      Text
"InsufficientForInstantaneousRewardsDELEG"
      [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString (MIRPot -> [Char]
forall a. Show a => a -> [Char]
show MIRPot
pot), Coin -> PDoc
pcCoin Coin
mismatchSupplied, Coin -> PDoc
pcCoin Coin
mismatchExpected]
  MIRCertificateTooLateinEpochDELEG Mismatch {SlotNo
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: SlotNo
mismatchExpected :: SlotNo
..} ->
    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" [VRFVerKeyHash 'GenDelegVRF -> PDoc
forall (r :: KeyRoleVRF). VRFVerKeyHash r -> PDoc
ppVRFHash VRFVerKeyHash 'GenDelegVRF
hash]
  ShelleyDelegPredFailure era
MIRTransferNotCurrentlyAllowed -> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"MIRTransferNotCurrentlyAllowed"
  ShelleyDelegPredFailure era
MIRNegativesNotCurrentlyAllowed -> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
" MIRNegativesNotCurrentlyAllowed"
  InsufficientForTransferDELEG MIRPot
pot Mismatch {Coin
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Coin
mismatchExpected :: Coin
..} ->
    Text -> [PDoc] -> PDoc
ppSexp
      Text
"InsufficientForTransferDELEG"
      [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString (MIRPot -> [Char]
forall a. Show a => a -> [Char]
show MIRPot
pot), Coin -> PDoc
pcCoin Coin
mismatchSupplied, Coin -> PDoc
pcCoin Coin
mismatchExpected]
  ShelleyDelegPredFailure era
MIRProducesNegativeUpdate -> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"MIRProducesNegativeUpdate"
  MIRNegativeTransfer MIRPot
pot Coin
c1 -> Text -> [PDoc] -> PDoc
ppSexp Text
" MIRNegativeTransfer" [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString (MIRPot -> [Char]
forall a. Show a => a -> [Char]
show MIRPot
pot), Coin -> PDoc
pcCoin Coin
c1]

instance PrettyA (ShelleyDelegPredFailure era) where
  prettyA :: ShelleyDelegPredFailure era -> PDoc
prettyA = ShelleyDelegPredFailure era -> PDoc
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) = Proof era -> PredicateFailure (EraRule "POOL" era) -> PDoc
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) = Proof era -> PredicateFailure (EraRule "DELEG" era) -> PDoc
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 = Proof era -> ShelleyDelplPredFailure era -> PDoc
forall era. Proof era -> ShelleyDelplPredFailure era -> PDoc
ppShelleyDelplPredFailure Proof era
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" [Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred]
  ConwayRules.StakeKeyNotRegisteredDELEG Credential 'Staking
cred ->
    Text -> [PDoc] -> PDoc
ppSexp Text
"StakeKeyNotRegisteredDELEG" [Credential 'Staking -> PDoc
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" [Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'DRepRole
cred]
  ConwayRules.DelegateeStakePoolNotRegisteredDELEG KeyHash 'StakePool
kh -> Text -> [PDoc] -> PDoc
ppSexp Text
"DelegateeStakePoolNotRegisteredDELEG" [KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'StakePool
kh]

instance PrettyA (ConwayDelegPredFailure era) where
  prettyA :: ConwayDelegPredFailure era -> PDoc
prettyA = ConwayDelegPredFailure era -> PDoc
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", KeyHash 'StakePool -> PDoc
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", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
curEpoch)
      , (Text
"Pool Retirement Epoch", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
poolRetEpoch)
      , (Text
"First Epoch Too Far", EpochNo -> PDoc
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", KeyHash 'StakePool -> PDoc
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", KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'StakePool
stakePoolId)
      , (Text
"Metadata Hash Size", Int -> PDoc
forall a. Int -> Doc a
ppInt Int
metadataHashSize)
      ]

instance PrettyA (ShelleyPoolPredFailure era) where
  prettyA :: ShelleyPoolPredFailure era -> PDoc
prettyA = ShelleyPoolPredFailure era -> PDoc
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'
    PDoc
forall a. Monoid a => a
mempty
    [
      ( Text
"When collecting inputs for twophase scripts, these went wrong."
      , (CollectError era -> PDoc) -> [CollectError era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList CollectError era -> PDoc
forall era. Reflect era => CollectError era -> PDoc
ppCollectError [CollectError era]
es
      )
    ]
ppUtxosPredicateFailure (Alonzo.UpdateFailure EraRuleFailure "PPUP" era
p) = EraRuleFailure "PPUP" era -> PDoc
forall a. a -> PDoc
ppPPUPPredFailure EraRuleFailure "PPUP" era
p

instance Reflect era => PrettyA (AlonzoUtxosPredFailure era) where
  prettyA :: AlonzoUtxosPredFailure era -> PDoc
prettyA = AlonzoUtxosPredFailure era -> PDoc
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'
        PDoc
forall a. Monoid a => a
mempty
        [
          ( Text
"When collecting inputs for twophase scripts, these went wrong."
          , (CollectError era -> PDoc) -> [CollectError era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList CollectError era -> PDoc
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" [PlutusPurpose AsItem era -> PDoc
forall era. Reflect era => PlutusPurpose AsItem era -> PDoc
ppPlutusPurposeAsItem PlutusPurpose AsItem era
sp]
ppCollectError (NoWitness ScriptHash
sh) = Text -> [PDoc] -> PDoc
ppSexp Text
"NoWitness" [ScriptHash -> PDoc
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" [ContextError era -> PDoc
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 -> [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Allegra -> [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Mary -> [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Alonzo -> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (AlonzoContextError AlonzoEra -> [Char]
forall a. Show a => a -> [Char]
show ContextError era
AlonzoContextError AlonzoEra
e)
    Proof era
Babbage -> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (BabbageContextError BabbageEra -> [Char]
forall a. Show a => a -> [Char]
show ContextError era
BabbageContextError BabbageEra
e)
    Proof era
Conway -> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (ConwayContextError ConwayEra -> [Char]
forall a. Show a => a -> [Char]
show ContextError era
ConwayContextError ConwayEra
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 -> [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Allegra -> [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Mary -> [Char] -> PDoc
forall a. HasCallStack => [Char] -> a
error [Char]
"Unsuported"
    Proof era
Alonzo -> AlonzoPlutusPurpose f AlonzoEra -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA AlonzoPlutusPurpose f AlonzoEra
PlutusPurpose f era
p
    Proof era
Babbage -> AlonzoPlutusPurpose f BabbageEra -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA AlonzoPlutusPurpose f BabbageEra
PlutusPurpose f era
p
    Proof era
Conway -> ConwayPlutusPurpose f ConwayEra -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA PlutusPurpose f era
ConwayPlutusPurpose f ConwayEra
p

instance Reflect era => PrettyA (CollectError era) where
  prettyA :: CollectError era -> PDoc
prettyA = CollectError era -> PDoc
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" [(FailureDescription -> PDoc) -> [FailureDescription] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList FailureDescription -> PDoc
ppFailureDescription (NonEmpty FailureDescription -> [FailureDescription]
forall a. NonEmpty a -> [a]
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", Text -> PDoc
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" [(TxIn -> PDoc) -> Set TxIn -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet TxIn -> PDoc
pcTxIn Set TxIn
x]
ppShelleyUtxoPredFailure (Shelley.ExpiredUTxO Mismatch {SlotNo
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: SlotNo
mismatchExpected :: SlotNo
..}) =
  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", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
actual)
    , (Text
"max transaction size", Integer -> PDoc
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 Proof era
forall era. Reflect era => Proof era
reify Value era
consumed)
    , (Text
"coin produced", forall era. Proof era -> Value era -> PDoc
pcVal @era Proof 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", (Addr -> PDoc) -> Set Addr -> PDoc
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", (RewardAccount -> PDoc) -> Set RewardAccount -> PDoc
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", (TxOut era -> PDoc) -> [TxOut era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
ppShelleyUtxoPredFailure (Shelley.UpdateFailure EraRuleFailure "PPUP" era
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"UpdateFailure" [EraRuleFailure "PPUP" era -> PDoc
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", (TxOut era -> PDoc) -> [TxOut era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]

instance Reflect era => PrettyA (ShelleyUtxoPredFailure era) where
  prettyA :: ShelleyUtxoPredFailure era -> PDoc
prettyA = ShelleyUtxoPredFailure era -> PDoc
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", (KeyHash 'Genesis -> PDoc) -> Set (KeyHash 'Genesis) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet KeyHash 'Genesis -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Set (KeyHash 'Genesis)
x)
    , (Text
"KeyHashes which should be voting", (KeyHash 'Genesis -> PDoc) -> Set (KeyHash 'Genesis) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet KeyHash 'Genesis -> PDoc
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", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
x)
    , (Text
"intended epoch of update", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
y)
    , (Text
"voting period within the epoch", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (VotingPeriod -> [Char]
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 = ShelleyPpupPredFailure era -> PDoc
forall era. ShelleyPpupPredFailure era -> PDoc
ppPpupPredicateFailure

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

ppPPUPPredFailure :: a -> PDoc
ppPPUPPredFailure :: forall a. a -> PDoc
ppPPUPPredFailure a
_ = [Char] -> PDoc
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" [(TxIn -> PDoc) -> Set TxIn -> PDoc
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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Integer
mismatchExpected :: Integer
..}) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"MaxTxSizeUTxO"
    [ (Text
"Actual", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
mismatchSupplied)
    , (Text
"max transaction size", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
mismatchExpected)
    ]
ppAllegraUtxoPredFailure (AllegraUtxoPredFailure era
Allegra.InputSetEmptyUTxO) = Text -> [PDoc] -> PDoc
ppSexp Text
"InputSetEmptyUTxO" []
ppAllegraUtxoPredFailure (Allegra.FeeTooSmallUTxO Mismatch {Coin
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Coin
mismatchExpected :: Coin
..}) =
  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
mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied :: Value era
mismatchExpected :: Value era
..}) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ValueNotConservedUTxO"
    [ (Text
"coin consumed", forall era. Proof era -> Value era -> PDoc
pcVal @era Proof era
forall era. Reflect era => Proof era
reify Value era
mismatchSupplied)
    , (Text
"coin produced", forall era. Proof era -> Value era -> PDoc
pcVal @era Proof 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", (Addr -> PDoc) -> Set Addr -> PDoc
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", (RewardAccount -> PDoc) -> Set RewardAccount -> PDoc
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", (TxOut era -> PDoc) -> [TxOut era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
forall era. Reflect era => Proof era
reify) [TxOut era]
xs)]
ppAllegraUtxoPredFailure (Allegra.UpdateFailure EraRuleFailure "PPUP" era
x) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"UpdateFailure" [EraRuleFailure "PPUP" era -> PDoc
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", (TxOut era -> PDoc) -> [TxOut era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
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", (TxOut era -> PDoc) -> [TxOut era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
forall era. Reflect era => Proof era
reify) [TxOut era]
outs)]

instance Reflect era => PrettyA (AllegraUtxoPredFailure era) where
  prettyA :: AllegraUtxoPredFailure era -> PDoc
prettyA = AllegraUtxoPredFailure era -> PDoc
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 Proof era
forall era. Reflect era => Proof era
reify State (EraRule "LEDGERS" era)
ls)
    , (Text
"blocks made", (KeyHash 'StakePool -> PDoc)
-> (Natural -> PDoc) -> Map (KeyHash 'StakePool) Natural -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) Natural
mp)
    ]

instance Reflect era => PrettyA (ShelleyBbodyState era) where
  prettyA :: ShelleyBbodyState era -> PDoc
prettyA = ShelleyBbodyState era -> PDoc
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", Int -> PDoc
forall a. Int -> Doc a
ppInt (Set TxIn -> Int
forall a. Set a -> Int
Set.size Set TxIn
s))]
  (Collateral Set TxIn
s) -> [(Text
"Collateral", Int -> PDoc
forall a. Int -> Doc a
ppInt (Set TxIn -> Int
forall a. Set a -> Int
Set.size Set TxIn
s))]
  (RefInputs Set TxIn
s) -> [(Text
"RefInputs", Int -> PDoc
forall a. Int -> Doc a
ppInt (Set TxIn -> Int
forall a. Set a -> Int
Set.size Set TxIn
s))]
  (Outputs StrictSeq (TxOut era)
xs) -> [(Text
"Outputs", Int -> PDoc
forall a. Int -> Doc a
ppInt (StrictSeq (TxOut era) -> Int
forall a. StrictSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length StrictSeq (TxOut era)
xs))]
  (CollateralReturn (SJust TxOut era
_)) -> [(Text
"Collateral Return", [Char] -> PDoc
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", Int -> PDoc
forall a. Int -> Doc a
ppInt (StrictSeq (TxCert era) -> Int
forall a. StrictSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length StrictSeq (TxCert era)
xs))]
  (Withdrawals' Withdrawals
x) -> [(Text
"Withdrawals", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map RewardAccount Coin -> Int
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", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"?")]
  (ReqSignerHashes Set (KeyHash 'Witness)
x) -> [(Text
"Required Signer hashes", Int -> PDoc
forall a. Int -> Doc a
ppInt (Set (KeyHash 'Witness) -> Int
forall a. Set a -> Int
Set.size Set (KeyHash 'Witness)
x))]
  (Fields.Mint MultiAsset
ma) -> [(Text
"Mint", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger (MaryValue -> Integer
forall t. Val t => t -> Integer
Val.size (Coin -> MultiAsset -> MaryValue
MaryValue Coin
forall a. Monoid a => a
mempty MultiAsset
ma)) PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
" bytes")]
  (WppHash (SJust ScriptIntegrityHash
_)) -> [(Text
"WppHash", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"?")]
  (AdHash (SJust TxAuxDataHash
_)) -> [(Text
"AdHash", [Char] -> PDoc
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"
    ([[(Text, PDoc)]] -> [(Text, PDoc)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((TxBodyField era -> [(Text, PDoc)])
-> [TxBodyField era] -> [[(Text, PDoc)]]
forall a b. (a -> b) -> [a] -> [b]
map TxBodyField era -> [(Text, PDoc)]
forall era. TxBodyField era -> [(Text, PDoc)]
txBodyFieldSummary (Proof era -> TxBody era -> [TxBodyField era]
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", Int -> PDoc
forall a. Int -> Doc a
ppInt (Set (WitVKey 'Witness) -> Int
forall a. Set a -> Int
Set.size Set (WitVKey 'Witness)
s))
  (BootWits Set BootstrapWitness
s) -> (Text
"BootStrap Witnesses", Int -> PDoc
forall a. Int -> Doc a
ppInt (Set BootstrapWitness -> Int
forall a. Set a -> Int
Set.size Set BootstrapWitness
s))
  (ScriptWits Map ScriptHash (Script era)
s) -> (Text
"Script Witnesses", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map ScriptHash (Script era) -> Int
forall k a. Map k a -> Int
Map.size Map ScriptHash (Script era)
s))
  (DataWits TxDats era
m) -> (Text
"Data Witnesses", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map (SafeHash EraIndependentData) (Data era) -> Int
forall k a. Map k a -> Int
Map.size (TxDats era -> Map (SafeHash EraIndependentData) (Data era)
forall era.
TxDats era -> Map (SafeHash EraIndependentData) (Data era)
unTxDats TxDats era
m)))
  (RdmrWits Redeemers era
redeemers) -> (Text
"Redeemer Witnesses", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Int
forall k a. Map k a -> Int
Map.size (Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
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"
    ((WitnessesField era -> (Text, PDoc))
-> [WitnessesField era] -> [(Text, PDoc)]
forall a b. (a -> b) -> [a] -> [b]
map WitnessesField era -> (Text, PDoc)
forall era. WitnessesField era -> (Text, PDoc)
witnessFieldSummary (Proof era -> TxWits era -> [WitnessesField era]
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) -> [Proof era -> TxBody era -> PDoc
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" ([[(Text, PDoc)]] -> [(Text, PDoc)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((TxBodyField era -> [(Text, PDoc)])
-> [TxBodyField era] -> [[(Text, PDoc)]]
forall a b. (a -> b) -> [a] -> [b]
map TxBodyField era -> [(Text, PDoc)]
forall era. TxBodyField era -> [(Text, PDoc)]
txBodyFieldSummary [TxBodyField era]
xs))]
  (TxWits TxWits era
ws) -> [Proof era -> TxWits era -> PDoc
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" ((WitnessesField era -> (Text, PDoc))
-> [WitnessesField era] -> [(Text, PDoc)]
forall a b. (a -> b) -> [a] -> [b]
map WitnessesField era -> (Text, PDoc)
forall era. WitnessesField era -> (Text, PDoc)
witnessFieldSummary [WitnessesField era]
ws)]
  (AuxData (SJust TxAuxData era
_)) -> [Text -> [PDoc] -> PDoc
ppSexp Text
"AuxData" [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"?"]]
  (Valid (IsValid Bool
b)) -> [Text -> [PDoc] -> PDoc
ppSexp Text
"IsValid" [Bool -> PDoc
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" ([[PDoc]] -> [PDoc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((TxField era -> [PDoc]) -> [TxField era] -> [[PDoc]]
forall a b. (a -> b) -> [a] -> [b]
map (Proof era -> TxField era -> [PDoc]
forall era. Proof era -> TxField era -> [PDoc]
txFieldSummary Proof era
proof) (Proof era -> Tx era -> [TxField era]
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 (SafeHash EraIndependentTxBody -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash SafeHash EraIndependentTxBody
h), Int -> PDoc
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, Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value era
Value ConwayEra
v, Datum ConwayEra -> PDoc
forall era. Era era => Datum era -> PDoc
datumSummary Datum ConwayEra
d, (AlonzoScript ConwayEra -> PDoc)
-> StrictMaybe (AlonzoScript ConwayEra) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (Proof era -> Script era -> PDoc
forall era. Proof era -> Script era -> PDoc
scriptSummary Proof era
p) StrictMaybe (Script ConwayEra)
StrictMaybe (AlonzoScript 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, Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value era
Value BabbageEra
v, Datum BabbageEra -> PDoc
forall era. Era era => Datum era -> PDoc
datumSummary Datum BabbageEra
d, (AlonzoScript BabbageEra -> PDoc)
-> StrictMaybe (AlonzoScript BabbageEra) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe (Proof era -> Script era -> PDoc
forall era. Proof era -> Script era -> PDoc
scriptSummary Proof era
p) StrictMaybe (Script BabbageEra)
StrictMaybe (AlonzoScript BabbageEra)
s]
txOutSummary p :: Proof era
p@Proof era
Alonzo (AlonzoTxOut Addr
addr Value AlonzoEra
v StrictMaybe (SafeHash EraIndependentData)
md) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"TxOut" [Addr -> PDoc
addrSummary Addr
addr, Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value era
Value AlonzoEra
v, (SafeHash EraIndependentData -> PDoc)
-> StrictMaybe (SafeHash EraIndependentData) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe SafeHash EraIndependentData -> PDoc
dataHashSummary StrictMaybe (SafeHash EraIndependentData)
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, Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value era
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, Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value era
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, Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcCoreValue Proof era
p Value era
Value ShelleyEra
v]

datumSummary :: Era era => Datum era -> PDoc
datumSummary :: forall era. Era era => Datum era -> PDoc
datumSummary Datum era
NoDatum = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"NoDatum"
datumSummary (DatumHash SafeHash EraIndependentData
h) = Text -> [PDoc] -> PDoc
ppSexp Text
"DHash" [PDoc -> PDoc
trim (SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash SafeHash EraIndependentData
h)]
datumSummary (Datum BinaryData era
b) = Data era -> PDoc
forall era. Era era => Data era -> PDoc
dataSummary (BinaryData era -> Data era
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) = ([Char] -> PDoc
forall a. [Char] -> Doc a
ppString (Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
n)) PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> (Data -> PDoc) -> [Data] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList Data -> PDoc
plutusDataSummary [Data]
ds
plutusDataSummary (PV1.Map [(Data, Data)]
ds) = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Map" PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> ((Data, Data) -> PDoc) -> [(Data, Data)] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ((Data -> PDoc) -> (Data -> PDoc) -> (Data, Data) -> PDoc
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) = (Data -> PDoc) -> [Data] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList Data -> PDoc
plutusDataSummary [Data]
xs
plutusDataSummary (PV1.I Integer
n) = Integer -> PDoc
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) = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char]
"num tokens = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Map PolicyID (Map AssetName Integer) -> Int
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 = Proof era -> AlonzoScript era -> PDoc
forall era. Proof era -> AlonzoScript era -> PDoc
plutusSummary Proof era
p Script era
AlonzoScript era
script
scriptSummary p :: Proof era
p@Proof era
Babbage Script era
script = Proof era -> AlonzoScript era -> PDoc
forall era. Proof era -> AlonzoScript era -> PDoc
plutusSummary Proof era
p Script era
AlonzoScript era
script
scriptSummary p :: Proof era
p@Proof era
Alonzo Script era
script = Proof era -> AlonzoScript era -> PDoc
forall era. Proof era -> AlonzoScript era -> PDoc
plutusSummary Proof era
p Script era
AlonzoScript era
script
scriptSummary Proof era
Mary Script era
script = Timelock MaryEra -> PDoc
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary Timelock MaryEra
Script era
script
scriptSummary Proof era
Allegra Script era
script = Timelock AllegraEra -> PDoc
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary Timelock AllegraEra
Script era
script
scriptSummary Proof era
Shelley Script era
script = MultiSig ShelleyEra -> PDoc
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> PDoc
multiSigSummary Script era
MultiSig ShelleyEra
script

networkSummary :: Network -> PDoc
networkSummary :: Network -> PDoc
networkSummary Network
Testnet = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Test"
networkSummary Network
Mainnet = [Char] -> PDoc
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, PaymentCredential -> PDoc
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
_))) = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char]
"BootAddr " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
10 (AddressHash Address' -> [Char]
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 (Hash ADDRHASH EraIndependentScript -> PDoc
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 (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> PDoc
forall a b. Hash a b -> PDoc
ppHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
kh)]

stakeSummary :: StakeReference -> PDoc
stakeSummary :: StakeReference -> PDoc
stakeSummary StakeReference
StakeRefNull = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Null"
stakeSummary (StakeRefPtr Ptr
_) = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Ptr"
stakeSummary (StakeRefBase Credential 'Staking
x) = Text -> [PDoc] -> PDoc
ppSexp Text
"Stake" [Credential Any -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
credSummary (Credential 'Staking -> Credential Any
forall (r :: KeyRole) (r' :: KeyRole).
Credential r -> Credential r'
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 = (TxIn -> PDoc)
-> (TxOut era -> PDoc) -> Map TxIn (TxOut era) -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap TxIn -> PDoc
txInSummary (Proof era -> TxOut era -> PDoc
forall era. Proof era -> TxOut era -> PDoc
txOutSummary Proof era
proof) (Map TxIn (TxOut era) -> PDoc)
-> (UTxO era -> Map TxIn (TxOut era)) -> UTxO era -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO era -> Map TxIn (TxOut era)
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 = PDoc -> [Char]
forall a. Show a => a -> [Char]
show (PDoc -> [Char]) -> (UTxO era -> PDoc) -> UTxO era -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> PDoc)
-> (TxOut era -> PDoc) -> Map TxIn (TxOut era) -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap TxIn -> PDoc
txInSummary (Proof era -> TxOut era -> PDoc
forall era. Proof era -> TxOut era -> PDoc
txOutSummary Proof era
proof) (Map TxIn (TxOut era) -> PDoc)
-> (UTxO era -> Map TxIn (TxOut era)) -> UTxO era -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO

scriptHashSummary :: ScriptHash -> PDoc
scriptHashSummary :: ScriptHash -> PDoc
scriptHashSummary (ScriptHash Hash ADDRHASH EraIndependentScript
h) = PDoc -> PDoc
trim (Hash ADDRHASH EraIndependentScript -> PDoc
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 (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> PDoc
forall a b. Hash a b -> PDoc
ppHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
h)

dataHashSummary :: DataHash -> PDoc
dataHashSummary :: SafeHash EraIndependentData -> PDoc
dataHashSummary SafeHash EraIndependentData
dh = PDoc -> PDoc
trim (SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash SafeHash EraIndependentData
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", VKey r -> PDoc
forall (r :: KeyRole). VKey r -> PDoc
vKeySummary VKey r
x), (Text
"sKey", SignKeyDSIGN DSIGN -> PDoc
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) = VerKeyDSIGN DSIGN -> PDoc
forall a ann. Show a => a -> Doc ann
viaShow VerKeyDSIGN DSIGN
x PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
" (hash " PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> KeyHash r -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
keyHashSummary (VKey r -> KeyHash r
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey VKey r
vk) PDoc -> PDoc -> PDoc
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" [KeyHash 'Witness -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
keyHashSummary KeyHash 'Witness
akh]
timelockSummary (RequireAllOf StrictSeq (NativeScript era)
ms) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"AllOf" ((PDoc -> [PDoc] -> [PDoc]) -> [PDoc] -> StrictSeq PDoc -> [PDoc]
forall a b. (a -> b -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] (Timelock era -> PDoc
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary (Timelock era -> PDoc)
-> StrictSeq (Timelock era) -> StrictSeq PDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock era)
StrictSeq (NativeScript era)
ms))
timelockSummary (RequireAnyOf StrictSeq (NativeScript era)
ms) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"AnyOf" ((PDoc -> [PDoc] -> [PDoc]) -> [PDoc] -> StrictSeq PDoc -> [PDoc]
forall a b. (a -> b -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] (Timelock era -> PDoc
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary (Timelock era -> PDoc)
-> StrictSeq (Timelock era) -> StrictSeq PDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock era)
StrictSeq (NativeScript era)
ms))
timelockSummary (RequireMOf Int
m StrictSeq (NativeScript era)
ms) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"MOfN" (Integer -> PDoc
forall a. Integer -> Doc a
ppInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) PDoc -> [PDoc] -> [PDoc]
forall a. a -> [a] -> [a]
: (PDoc -> [PDoc] -> [PDoc]) -> [PDoc] -> StrictSeq PDoc -> [PDoc]
forall a b. (a -> b -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] (Timelock era -> PDoc
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary (Timelock era -> PDoc)
-> StrictSeq (Timelock era) -> StrictSeq PDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock era)
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" [KeyHash 'Witness -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
keyHashSummary KeyHash 'Witness
hk]
multiSigSummary (RequireAllOf StrictSeq (NativeScript era)
ps) = Text -> [PDoc] -> PDoc
ppSexp Text
"AllOf" ((MultiSig era -> PDoc) -> [MultiSig era] -> [PDoc]
forall a b. (a -> b) -> [a] -> [b]
map MultiSig era -> PDoc
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> PDoc
multiSigSummary (StrictSeq (MultiSig era) -> [MultiSig era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
StrictSeq (MultiSig era)
ps))
multiSigSummary (RequireAnyOf StrictSeq (NativeScript era)
ps) = Text -> [PDoc] -> PDoc
ppSexp Text
"AnyOf" ((MultiSig era -> PDoc) -> [MultiSig era] -> [PDoc]
forall a b. (a -> b) -> [a] -> [b]
map MultiSig era -> PDoc
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> PDoc
multiSigSummary (StrictSeq (MultiSig era) -> [MultiSig era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
StrictSeq (MultiSig era)
ps))
multiSigSummary (RequireMOf Int
m StrictSeq (NativeScript era)
ps) = Text -> [PDoc] -> PDoc
ppSexp Text
"MOf" (Int -> PDoc
forall a. Int -> Doc a
ppInt Int
m PDoc -> [PDoc] -> [PDoc]
forall a. a -> [a] -> [a]
: (MultiSig era -> PDoc) -> [MultiSig era] -> [PDoc]
forall a b. (a -> b) -> [a] -> [b]
map MultiSig era -> PDoc
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
MultiSig era -> PDoc
multiSigSummary (StrictSeq (MultiSig era) -> [MultiSig era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era)
StrictSeq (MultiSig era)
ps))
multiSigSummary MultiSig era
_ = [Char] -> PDoc
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) =
  [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (Language -> [Char]
forall a. Show a => a -> [Char]
show (PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ") PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> PDoc
scriptHashSummary (forall era. EraScript era => Script era -> ScriptHash
hashScript @era Script era
AlonzoScript era
s)
plutusSummary Proof era
Conway (TimelockScript Timelock era
x) = Timelock era -> PDoc
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) =
  [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (Language -> [Char]
forall a. Show a => a -> [Char]
show (PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ") PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> PDoc
scriptHashSummary (forall era. EraScript era => Script era -> ScriptHash
hashScript @era Script era
AlonzoScript era
s)
plutusSummary Proof era
Babbage (TimelockScript Timelock era
x) = Timelock era -> PDoc
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) =
  [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (Language -> [Char]
forall a. Show a => a -> [Char]
show (PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ") PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> PDoc
scriptHashSummary (forall era. EraScript era => Script era -> ScriptHash
hashScript @era Script era
AlonzoScript era
s)
plutusSummary Proof era
Alonzo (TimelockScript Timelock era
x) = Timelock era -> PDoc
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
timelockSummary Timelock era
x
plutusSummary Proof era
other AlonzoScript era
_ = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char]
"Plutus script in era " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Proof era -> [Char]
forall a. Show a => a -> [Char]
show Proof era
other [Char] -> [Char] -> [Char]
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", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map FutureGenDeleg GenDelegPair -> Int
forall k a. Map k a -> Int
Map.size Map FutureGenDeleg GenDelegPair
future))
    , (Text
"Genesis key delegations", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map (KeyHash 'Genesis) GenDelegPair -> Int
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", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map (Credential 'Staking) Coin -> Int
forall k a. Map k a -> Int
Map.size Map (Credential 'Staking) Coin
reserves))
    , (Text
"Rewards from treasury", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map (Credential 'Staking) Coin -> Int
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", Int -> PDoc
forall a. Int -> Doc a
ppInt (UView (Credential 'Staking) RDPair -> Int
forall k v. UView k v -> Int
UM.size (UMap -> UView (Credential 'Staking) RDPair
UM.RewDepUView UMap
umap)))
    , (Text
"Ptrs Map", Int -> PDoc
forall a. Int -> Doc a
ppInt (UView Ptr (Credential 'Staking) -> Int
forall k v. UView k v -> Int
UM.size (UMap -> UView Ptr (Credential 'Staking)
UM.PtrUView UMap
umap)))
    , (Text
"SPoolUView Map", Int -> PDoc
forall a. Int -> Doc a
ppInt (UView (Credential 'Staking) (KeyHash 'StakePool) -> Int
forall k v. UView k v -> Int
UM.size (UMap -> UView (Credential 'Staking) (KeyHash 'StakePool)
UM.SPoolUView UMap
umap)))
    , (Text
"DRepUView Map", Int -> PDoc
forall a. Int -> Doc a
ppInt (UView (Credential 'Staking) DRep -> Int
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", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map (KeyHash 'StakePool) PoolParams -> Int
forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool) PoolParams
pp))
    , (Text
"Future pool parameters", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map (KeyHash 'StakePool) PoolParams -> Int
forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool) PoolParams
fpp))
    , (Text
"Retiring stake pools", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map (KeyHash 'StakePool) EpochNo -> Int
forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool) EpochNo
retire))
    , (Text
"Deposits", Int -> PDoc
forall a. Int -> Doc a
ppInt (Map (KeyHash 'StakePool) Coin -> Int
forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool) Coin
deposit))
    ]

dpStateSummary :: ConwayEraCertState era => CertState era -> PDoc
dpStateSummary :: forall era. ConwayEraCertState era => CertState era -> PDoc
dpStateSummary CertState era
certState = [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
vsep [VState era -> PDoc
forall era. VState era -> PDoc
pcVState VState era
v, PState era -> PDoc
forall c. PState c -> PDoc
pStateSummary PState era
p, DState era -> PDoc
forall c. DState c -> PDoc
dStateSummary DState era
d]
  where
    v :: VState era
v = CertState era
certState CertState era
-> Getting (VState era) (CertState era) (VState era) -> VState era
forall s a. s -> Getting a s a -> a
^. Getting (VState era) (CertState era) (VState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL
    p :: PState era
p = CertState era
certState CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
    d :: DState era
d = CertState era
certState CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL

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

pcTxId :: TxId -> PDoc
pcTxId :: TxId -> PDoc
pcTxId (TxId SafeHash EraIndependentTxBody
safehash) = PDoc -> PDoc
trim (SafeHash EraIndependentTxBody -> PDoc
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 Word16
i)) = PDoc -> PDoc
forall ann. Doc ann -> Doc ann
parens ([PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"TxIn", PDoc -> PDoc
trim (SafeHash EraIndependentTxBody -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash SafeHash EraIndependentTxBody
h), Word16 -> PDoc
forall a. Word16 -> Doc a
ppWord16 Word16
i])

instance PrettyA TxIn where prettyA :: TxIn -> PDoc
prettyA = TxIn -> PDoc
pcTxIn

pcNetwork :: Network -> PDoc
pcNetwork :: Network -> PDoc
pcNetwork Network
Testnet = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"TestNet"
pcNetwork Network
Mainnet = [Char] -> PDoc
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 (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> PDoc
forall a b. Hash a b -> PDoc
ppHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
h)

instance PrettyA (KeyHash d) where prettyA :: KeyHash d -> PDoc
prettyA = KeyHash d -> PDoc
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)) = [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"(Script", PDoc -> PDoc
trim (Hash ADDRHASH EraIndependentScript -> PDoc
forall a b. Hash a b -> PDoc
ppHash Hash ADDRHASH EraIndependentScript
h) PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
")"]
pcCredential (KeyHashObj (KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
h)) = [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"(Key", PDoc -> PDoc
trim (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> PDoc
forall a b. Hash a b -> PDoc
ppHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
h) PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
")"]

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

pcStakeReference :: StakeReference -> PDoc
pcStakeReference :: StakeReference -> PDoc
pcStakeReference StakeReference
StakeRefNull = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Null"
pcStakeReference (StakeRefBase Credential 'Staking
cred) = Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred
pcStakeReference (StakeRefPtr Ptr
_) = [Char] -> PDoc
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) =
  PDoc -> PDoc
forall ann. Doc ann -> Doc ann
parens (PDoc -> PDoc) -> PDoc -> PDoc
forall a b. (a -> b) -> a -> b
$
    [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep
      [ [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Addr"
      , Network -> PDoc
pcNetwork Network
nw
      , PaymentCredential -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential PaymentCredential
pay
      , StakeReference -> PDoc
pcStakeReference StakeReference
stk
      ]
pcAddr (AddrBootstrap BootstrapAddress
x) = PDoc
"BootAddr" PDoc -> PDoc -> PDoc
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
_)) = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
10 (AddressHash Address' -> [Char]
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
MaryValue
v
pcCoreValue Proof era
Babbage Value era
v = MaryValue -> PDoc
vSummary Value era
MaryValue
v
pcCoreValue Proof era
Alonzo Value era
v = MaryValue -> PDoc
vSummary Value era
MaryValue
v
pcCoreValue Proof era
Mary Value era
v = MaryValue -> PDoc
vSummary Value era
MaryValue
v
pcCoreValue Proof era
Allegra (Coin Integer
n) = [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"₳", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
n]
pcCoreValue Proof era
Shelley (Coin Integer
n) = [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"₳", Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
n]

pcCoin :: Coin -> PDoc
pcCoin :: Coin -> PDoc
pcCoin (Coin Integer
n) = [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"₳", Integer -> PDoc
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))
      (PolicyID -> PDoc) -> Set PolicyID -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet PolicyID -> PDoc
pcPolicyID (Map PolicyID (Map AssetName Integer) -> Set PolicyID
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
Coin
v
pcVal Proof era
Allegra Value era
v = Coin -> PDoc
pcCoin Value era
Coin
v
pcVal Proof era
Mary Value era
v = MaryValue -> PDoc
pcValue Value era
MaryValue
v
pcVal Proof era
Alonzo Value era
v = MaryValue -> PDoc
pcValue Value era
MaryValue
v
pcVal Proof era
Babbage Value era
v = MaryValue -> PDoc
pcValue Value era
MaryValue
v
pcVal Proof era
Conway Value era
v = MaryValue -> PDoc
pcValue Value era
MaryValue
v

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

instance Era era => PrettyA (Datum era) where prettyA :: Datum era -> PDoc
prettyA = Datum era -> PDoc
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" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
n)) [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash", PDoc -> PDoc
trim (PDoc -> PDoc) -> PDoc -> PDoc
forall a b. (a -> b) -> a -> b
$ SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash (Data era -> SafeHash EraIndependentData
forall era. Data era -> SafeHash EraIndependentData
hashData Data era
d)]
pcData d :: Data era
d@(Data (PV1.Map [(Data, Data)]
_)) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"Map" [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash", PDoc -> PDoc
trim (PDoc -> PDoc) -> PDoc -> PDoc
forall a b. (a -> b) -> a -> b
$ SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash (Data era -> SafeHash EraIndependentData
forall era. Data era -> SafeHash EraIndependentData
hashData Data era
d)]
pcData d :: Data era
d@(Data (PV1.List [Data]
_)) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"List" [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash", PDoc -> PDoc
trim (PDoc -> PDoc) -> PDoc -> PDoc
forall a b. (a -> b) -> a -> b
$ SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash (Data era -> SafeHash EraIndependentData
forall era. Data era -> SafeHash EraIndependentData
hashData Data era
d)]
pcData d :: Data era
d@(Data (PV1.I Integer
n)) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"I" [Integer -> PDoc
forall a. Integer -> Doc a
ppInteger Integer
n, [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash", PDoc -> PDoc
trim (PDoc -> PDoc) -> PDoc -> PDoc
forall a b. (a -> b) -> a -> b
$ SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash (Data era -> SafeHash EraIndependentData
forall era. Data era -> SafeHash EraIndependentData
hashData Data era
d)]
pcData d :: Data era
d@(Data (PV1.B ByteString
bytes)) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"B" [PDoc -> PDoc
trim (ByteString -> PDoc
forall a ann. Show a => a -> Doc ann
viaShow ByteString
bytes), [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash", PDoc -> PDoc
trim (PDoc -> PDoc) -> PDoc -> PDoc
forall a b. (a -> b) -> a -> b
$ SafeHash EraIndependentData -> PDoc
forall index. SafeHash index -> PDoc
ppSafeHash (Data era -> SafeHash EraIndependentData
forall era. Data era -> SafeHash EraIndependentData
hashData Data era
d)]

instance Era era => PrettyA (Data era) where prettyA :: Data era -> PDoc
prettyA = Data era -> PDoc
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" [KeyHash 'Witness -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'Witness
akh]
pcTimelock (RequireAllOf StrictSeq (NativeScript era)
ts) = Text -> [PDoc] -> PDoc
ppSexp Text
"AllOf" [(Timelock era -> PDoc) -> [Timelock era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList Timelock era -> PDoc
forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock (StrictSeq (Timelock era) -> [Timelock era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Timelock era)
StrictSeq (NativeScript era)
ts)]
pcTimelock (RequireAnyOf StrictSeq (NativeScript era)
ts) = Text -> [PDoc] -> PDoc
ppSexp Text
"AnyOf" [(Timelock era -> PDoc) -> [Timelock era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList Timelock era -> PDoc
forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock (StrictSeq (Timelock era) -> [Timelock era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Timelock era)
StrictSeq (NativeScript era)
ts)]
pcTimelock (RequireMOf Int
m StrictSeq (NativeScript era)
ts) = Text -> [PDoc] -> PDoc
ppSexp Text
"MOfN" (Integer -> PDoc
forall a. Integer -> Doc a
ppInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) PDoc -> [PDoc] -> [PDoc]
forall a. a -> [a] -> [a]
: [(Timelock era -> PDoc) -> [Timelock era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList Timelock era -> PDoc
forall era.
(AllegraEraScript era, Reflect era,
 NativeScript era ~ Timelock era) =>
Timelock era -> PDoc
pcTimelock (StrictSeq (Timelock era) -> [Timelock era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Timelock era)
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 = Timelock era -> PDoc
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" [KeyHash 'Witness -> PDoc
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" [Int -> PDoc
forall a. Int -> Doc a
ppInt Int
m, PDoc
h]
pcMultiSig PDoc
_ MultiSig era
_ = [Char] -> PDoc
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 = PDoc -> MultiSig era -> PDoc
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
PDoc -> MultiSig era -> PDoc
pcMultiSig PDoc
forall a. Monoid a => a
mempty

pcScriptHash :: ScriptHash -> PDoc
pcScriptHash :: ScriptHash -> PDoc
pcScriptHash (ScriptHash Hash ADDRHASH EraIndependentScript
h) = PDoc -> PDoc
trim (Hash ADDRHASH EraIndependentScript -> PDoc
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 = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash " PDoc -> PDoc -> PDoc
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 = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash " PDoc -> PDoc -> PDoc
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 = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash " PDoc -> PDoc -> PDoc
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 = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash " PDoc -> PDoc -> PDoc
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 = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash " PDoc -> PDoc -> PDoc
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 = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Hash " PDoc -> PDoc -> PDoc
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 = Proof era -> Script era -> PDoc
forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
forall era. Reflect era => Proof era
reify

instance PrettyA DataHash where
  prettyA :: SafeHash EraIndependentData -> PDoc
prettyA = SafeHash EraIndependentData -> PDoc
pcDataHash

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

instance Reflect era => PrettyA (UTxO era) where prettyA :: UTxO era -> PDoc
prettyA = Proof era -> UTxO era -> PDoc
forall era. Proof era -> UTxO era -> PDoc
pcUTxO Proof era
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", KeyHash 'StakePool -> PDoc
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", (KeyHash 'Staking -> PDoc) -> Set (KeyHash 'Staking) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet KeyHash 'Staking -> PDoc
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" [Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred]
pcDelegCert (ShelleyUnRegCert Credential 'Staking
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"ShelleyUnRegCert" [Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred]
pcDelegCert (ShelleyDelegCert Credential 'Staking
x KeyHash 'StakePool
y) = Text -> [PDoc] -> PDoc
ppSexp Text
"ShelleyDelegCert" [Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
x, KeyHash 'StakePool -> PDoc
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" [KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'StakePool
keyhash, EpochNo -> PDoc
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", KeyHash 'Genesis -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'Genesis
a)
    , (Text
"GenesisDelegate", KeyHash 'GenesisDelegate -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash KeyHash 'GenesisDelegate
b)
    , (Text
"VerKeyVRF", PDoc -> PDoc
trim (VRFVerKeyHash 'GenDelegVRF -> PDoc
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", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (MIRPot -> [Char]
forall a. Show a => a -> [Char]
show MIRPot
x))
    , (Text
"Addresses", (Credential 'Staking -> PDoc)
-> (DeltaCoin -> PDoc)
-> Map (Credential 'Staking) DeltaCoin
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
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", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (MIRPot -> [Char]
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 = ShelleyTxCert c -> PDoc
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 = ConwayTxCert c -> PDoc
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" [Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'DRepRole
cred, Coin -> PDoc
pcCoin Coin
c, (Anchor -> PDoc) -> StrictMaybe Anchor -> PDoc
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" [Credential 'DRepRole -> PDoc
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" [Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'DRepRole
cred, (Anchor -> PDoc) -> StrictMaybe Anchor -> PDoc
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" [Credential 'ColdCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'ColdCommitteeRole
cred1, Credential 'HotCommitteeRole -> PDoc
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", Credential 'ColdCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'ColdCommitteeRole
cred), (Text
"anchor", (Anchor -> PDoc) -> StrictMaybe Anchor -> PDoc
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" [Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred, (Coin -> PDoc) -> StrictMaybe Coin -> PDoc
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" [Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'Staking
cred, (Coin -> PDoc) -> StrictMaybe Coin -> PDoc
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" [Credential 'Staking -> PDoc
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" [Credential 'Staking -> PDoc
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 :: PParams era
cdePools :: Map (KeyHash 'StakePool) PoolParams
cdePParams :: forall era. ConwayDelegEnv era -> PParams era
cdePools :: forall era.
ConwayDelegEnv era -> Map (KeyHash 'StakePool) PoolParams
..} =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"ConwayDelegEnv"
      [ (Text
"cdePParams", PParams era -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA PParams era
cdePParams)
      , (Text
"cdePools", Map (KeyHash 'StakePool) PoolParams -> PDoc
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" [KeyHash 'StakePool -> PDoc
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" [KeyHash 'StakePool -> PDoc
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 = ShelleyTxCert ShelleyEra -> PDoc
forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert TxCert era
ShelleyTxCert ShelleyEra
x
pcTxCert Proof era
Allegra TxCert era
x = ShelleyTxCert AllegraEra -> PDoc
forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert TxCert era
ShelleyTxCert AllegraEra
x
pcTxCert Proof era
Mary TxCert era
x = ShelleyTxCert MaryEra -> PDoc
forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert TxCert era
ShelleyTxCert MaryEra
x
pcTxCert Proof era
Alonzo TxCert era
x = ShelleyTxCert AlonzoEra -> PDoc
forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert TxCert era
ShelleyTxCert AlonzoEra
x
pcTxCert Proof era
Babbage TxCert era
x = ShelleyTxCert BabbageEra -> PDoc
forall c. ShelleyTxCert c -> PDoc
pcShelleyTxCert TxCert era
ShelleyTxCert BabbageEra
x
pcTxCert Proof era
Conway TxCert era
x = ConwayTxCert ConwayEra -> PDoc
forall c. ConwayTxCert c -> PDoc
pcConwayTxCert TxCert era
ConwayTxCert ConwayEra
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", VotingProcedures era -> PDoc
forall era. VotingProcedures era -> PDoc
pcVotingProcedures VotingProcedures era
vote)
    , (Text
"proposal", (ProposalProcedure era -> PDoc) -> [ProposalProcedure era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ProposalProcedure era -> PDoc
forall era. ProposalProcedure era -> PDoc
pcProposalProcedure (OSet (ProposalProcedure era) -> [ProposalProcedure era]
forall a. OSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OSet (ProposalProcedure era)
proposal))
    , (Text
"certificates", (TxCert era -> PDoc) -> [TxCert era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxCert era -> PDoc
forall era. Proof era -> TxCert era -> PDoc
pcTxCert (forall era. Reflect era => Proof era
reify @era)) (StrictSeq (TxCert era) -> [TxCert era]
forall a. StrictSeq a -> [a]
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 = GovSignal era -> PDoc
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" [(Voter -> PDoc)
-> (Map GovActionId (VotingProcedure era) -> PDoc)
-> Map Voter (Map GovActionId (VotingProcedure era))
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Voter -> PDoc
pcVoter ((GovActionId -> PDoc)
-> (VotingProcedure era -> PDoc)
-> Map GovActionId (VotingProcedure era)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap GovActionId -> PDoc
pcGovActionId VotingProcedure era -> PDoc
forall era. VotingProcedure era -> PDoc
pcVotingProcedure) Map Voter (Map GovActionId (VotingProcedure era))
m]

instance PrettyA (VotingProcedures era) where
  prettyA :: VotingProcedures era -> PDoc
prettyA = VotingProcedures era -> PDoc
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", GovAction era -> PDoc
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 = ProposalProcedure era -> PDoc
forall era. ProposalProcedure era -> PDoc
pcProposalProcedure

pcVoter :: Voter -> PDoc
pcVoter :: Voter -> PDoc
pcVoter (CommitteeVoter Credential 'HotCommitteeRole
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"CommitteeVoter" [Credential 'HotCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'HotCommitteeRole
cred]
pcVoter (DRepVoter Credential 'DRepRole
cred) = Text -> [PDoc] -> PDoc
ppSexp Text
"DRepVoter" [Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'DRepRole
cred]
pcVoter (StakePoolVoter KeyHash 'StakePool
keyhash) = Text -> [PDoc] -> PDoc
ppSexp Text
"StakePoolVoter" [KeyHash 'StakePool -> PDoc
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", (Anchor -> PDoc) -> StrictMaybe Anchor -> PDoc
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 = VotingProcedure era -> PDoc
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, Credential 'Staking -> PDoc
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" [Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Natural
mem, Natural -> PDoc
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) = PDoc -> PDoc
forall ann. Doc ann -> Doc ann
parens ([PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [t1 -> PDoc
pp1 t1
x, [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
",", t2 -> PDoc
pp2 t2
y])

pcWitVKey ::
  forall era keyrole.
  Proof era ->
  WitVKey keyrole ->
  PDoc
pcWitVKey :: forall era (keyrole :: 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"
    [ [Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char]
" VerKey=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
10 (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
19 [Char]
keystring))
    , [Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char]
" SignKey=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
10 (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
29 [Char]
sigstring))
    , PDoc
" VerKeyHash=" PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> PDoc
hash
    ]
  where
    keystring :: [Char]
keystring = VerKeyDSIGN DSIGN -> [Char]
forall a. Show a => a -> [Char]
show VerKeyDSIGN DSIGN
x
    hash :: PDoc
hash = KeyHash keyrole -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (VKey keyrole -> KeyHash keyrole
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey VKey keyrole
vk)
    sigstring :: [Char]
sigstring = SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> [Char]
forall a. Show a => a -> [Char]
show SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig

instance Reflect era => PrettyA (WitVKey keyrole) where
  prettyA :: WitVKey keyrole -> PDoc
prettyA = forall era (keyrole :: KeyRole).
Proof era -> WitVKey keyrole -> PDoc
pcWitVKey @era Proof 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 Proof era -> GovStateWit era
forall era. Proof era -> GovStateWit era
whichGovState Proof era
p of
  GovStateWit era
GovStateShelleyToBabbage -> Proof era -> ShelleyGovState era -> PDoc
forall era. Proof era -> ShelleyGovState era -> PDoc
pcShelleyGovState Proof era
p GovState era
ShelleyGovState era
x
  GovStateWit era
GovStateConwayToConway -> (Reflect era => Proof era -> ConwayGovState era -> PDoc)
-> Proof era -> ConwayGovState era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> ConwayGovState era -> PDoc
Proof era -> ConwayGovState era -> PDoc
forall era. Reflect era => Proof era -> ConwayGovState era -> PDoc
pcConwayGovState Proof era
p GovState era
ConwayGovState 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"
    [ (Text
"proposals", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"(Proposals ...)")
    , (Text
"futureProposals", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"(Proposals ...)")
    , (Text
"pparams", Proof era -> PParams era -> PDoc
forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p PParams era
pp)
    , (Text
"prevParams", Proof era -> PParams era -> PDoc
forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p PParams era
prevpp)
    , (Text
"futureParams", Proof era -> FuturePParams era -> PDoc
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" [(PParams era -> PDoc) -> Maybe (PParams era) -> PDoc
forall x ann. (x -> Doc ann) -> Maybe x -> Doc ann
ppMaybe (Proof era -> PParams era -> PDoc
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" [Proof era -> PParams era -> PDoc
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 = Proof era -> ShelleyGovState era -> PDoc
forall era. Proof era -> ShelleyGovState era -> PDoc
pcShelleyGovState Proof era
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
StrictMaybe (Committee era)
PParams era
Constitution era
GovRelation StrictMaybe era
Coin
ensCommittee :: StrictMaybe (Committee era)
ensConstitution :: Constitution era
ensCurPParams :: PParams era
ensPrevPParams :: PParams era
ensTreasury :: Coin
ensWithdrawals :: Map (Credential 'Staking) Coin
ensPrevGovActionIds :: GovRelation StrictMaybe era
ensCommittee :: forall era. EnactState era -> StrictMaybe (Committee era)
ensConstitution :: forall era. EnactState era -> Constitution era
ensCurPParams :: forall era. EnactState era -> PParams era
ensPrevPParams :: forall era. EnactState era -> PParams era
ensTreasury :: forall era. EnactState era -> Coin
ensWithdrawals :: forall era. EnactState era -> Map (Credential 'Staking) Coin
ensPrevGovActionIds :: forall era. EnactState era -> GovRelation StrictMaybe era
..} = EnactState era
ens
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"EnactState"
        [ (Text
"Constitutional Committee", (Committee era -> PDoc) -> StrictMaybe (Committee era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Committee era -> PDoc
forall era. Committee era -> PDoc
pcCommittee StrictMaybe (Committee era)
ensCommittee)
        , (Text
"Constitution", Constitution era -> PDoc
forall c. Constitution c -> PDoc
pcConstitution Constitution era
ensConstitution)
        , (Text
"CurPParams", Proof era -> PParams era -> PDoc
forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p PParams era
ensCurPParams)
        , (Text
"PrevPParams", Proof era -> PParams era -> PDoc
forall era. Proof era -> PParams era -> PDoc
pcPParamsSynopsis Proof era
p PParams era
ensPrevPParams)
        , (Text
"Treasury", Coin -> PDoc
pcCoin Coin
ensTreasury)
        , (Text
"Withdrawals", (Credential 'Staking -> PDoc)
-> (Coin -> PDoc) -> Map (Credential 'Staking) Coin -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Coin -> PDoc
pcCoin Map (Credential 'Staking) Coin
ensWithdrawals)
        , (Text
"PrevGovActionIds", GovRelation StrictMaybe era -> PDoc
forall era. GovRelation StrictMaybe era -> PDoc
pcPrevGovActionIds GovRelation StrictMaybe era
ensPrevGovActionIds)
        ]

instance Reflect era => PrettyA (EnactState era) where
  prettyA :: EnactState era -> PDoc
prettyA = Proof era -> EnactState era -> PDoc
forall era. Proof era -> EnactState era -> PDoc
pcEnactState Proof era
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, Word16 -> PDoc
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 :: StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate, StrictMaybe (GovPurposeId 'HardForkPurpose era)
grHardFork :: StrictMaybe (GovPurposeId 'HardForkPurpose era)
grHardFork :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
grHardFork, StrictMaybe (GovPurposeId 'CommitteePurpose era)
grCommittee :: StrictMaybe (GovPurposeId 'CommitteePurpose era)
grCommittee :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
grCommittee, StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
grConstitution :: StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
grConstitution :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
grConstitution} =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"PrevGovActionIds"
    [ (Text
"LastPParamUpdate", (GovPurposeId 'PParamUpdatePurpose era -> PDoc)
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId 'PParamUpdatePurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate)
    , (Text
"LastHardFork", (GovPurposeId 'HardForkPurpose era -> PDoc)
-> StrictMaybe (GovPurposeId 'HardForkPurpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId 'HardForkPurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'HardForkPurpose era)
grHardFork)
    , (Text
"LastCommittee", (GovPurposeId 'CommitteePurpose era -> PDoc)
-> StrictMaybe (GovPurposeId 'CommitteePurpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId 'CommitteePurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'CommitteePurpose era)
grCommittee)
    , (Text
"LastConstitution", (GovPurposeId 'ConstitutionPurpose era -> PDoc)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId 'ConstitutionPurpose era -> PDoc
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 = GovRelation StrictMaybe era -> PDoc
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", Proposals era -> PDoc
forall era. Proposals era -> PDoc
pcProposals Proposals era
ss)
    , (Text
"committee", (Committee era -> PDoc) -> StrictMaybe (Committee era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Committee era -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA StrictMaybe (Committee era)
cmt)
    , (Text
"constitution", Constitution era -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA Constitution era
con)
    , (Text
"currentPParams", PParams era -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA PParams era
cpp)
    , (Text
"prevPParams", PParams era -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA PParams era
ppp)
    , (Text
"futurePParams", Proof era -> FuturePParams era -> PDoc
forall era. Proof era -> FuturePParams era -> PDoc
pcFuturePParams Proof era
p FuturePParams era
fpp)
    , (Text
"drepPulsingState", Proof era -> DRepPulsingState era -> PDoc
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 = Proof era -> ConwayGovState era -> PDoc
forall era. Reflect era => Proof era -> ConwayGovState era -> PDoc
pcConwayGovState Proof era
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", (GovActionState era -> PDoc)
-> StrictSeq (GovActionState era) -> PDoc
forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq GovActionState era -> PDoc
forall era. GovActionState era -> PDoc
pcGovActionState StrictSeq (GovActionState era)
ps)
    , (Text
"drepDistr", (DRep -> PDoc)
-> (CompactForm Coin -> PDoc)
-> Map DRep (CompactForm Coin)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap DRep -> PDoc
pcDRep (Coin -> PDoc
pcCoin (Coin -> PDoc)
-> (CompactForm Coin -> Coin) -> CompactForm Coin -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact) Map DRep (CompactForm Coin)
dd)
    , (Text
"drepState", (Credential 'DRepRole -> PDoc)
-> (DRepState -> PDoc)
-> Map (Credential 'DRepRole) DRepState
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential DRepState -> PDoc
pcDRepState Map (Credential 'DRepRole) DRepState
ds)
    , (Text
"poolDistr", (KeyHash 'StakePool -> PDoc)
-> (CompactForm Coin -> PDoc)
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (Coin -> PDoc
pcCoin (Coin -> PDoc)
-> (CompactForm Coin -> Coin) -> CompactForm Coin -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact) Map (KeyHash 'StakePool) (CompactForm Coin)
pd)
    ]

instance PrettyA (PulsingSnapshot era) where
  prettyA :: PulsingSnapshot era -> PDoc
prettyA = PulsingSnapshot era -> PDoc
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", PulsingSnapshot era -> PDoc
forall era. PulsingSnapshot era -> PDoc
pcPulsingSnapshot PulsingSnapshot era
x)
    , (Text
"ratifyState", Proof era -> RatifyState era -> PDoc
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" [DRepPulser era Identity (RatifyState era) -> PDoc
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 = Proof era -> DRepPulsingState era -> PDoc
forall era. Proof era -> DRepPulsingState era -> PDoc
pcDRepPulsingState Proof era
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", Proof era -> EnactState era -> PDoc
forall era. Proof era -> EnactState era -> PDoc
pcEnactState Proof era
p EnactState era
enactedState)
    , (Text
"enacted", (GovActionState era -> PDoc) -> Seq (GovActionState era) -> PDoc
forall a ann. (a -> Doc ann) -> Seq a -> Doc ann
ppSeq GovActionState era -> PDoc
forall era. GovActionState era -> PDoc
pcGovActionState Seq (GovActionState era)
enactedPs)
    , (Text
"expired", (GovActionId -> PDoc) -> Set GovActionId -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet GovActionId -> PDoc
pcGovActionId Set GovActionId
expiredPs)
    , (Text
"delayed", Bool -> PDoc
forall a. Bool -> Doc a
ppBool Bool
delayedPs)
    ]

instance Reflect era => PrettyA (RatifyState era) where
  prettyA :: RatifyState era -> PDoc
prettyA = Proof era -> RatifyState era -> PDoc
forall era. Proof era -> RatifyState era -> PDoc
pcRatifyState Proof era
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", (GovActionId -> PDoc)
-> (GovActionState era -> PDoc)
-> Map GovActionId (GovActionState era)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap GovActionId -> PDoc
pcGovActionId GovActionState era -> PDoc
forall era. GovActionState era -> PDoc
pcGovActionState (Proposals era -> Map GovActionId (GovActionState era)
forall era. Proposals era -> Map GovActionId (GovActionState era)
proposalsActionsMap Proposals era
p))
    , (Text
"pRoots", GovRelation StrictMaybe era -> PDoc
forall era. GovRelation StrictMaybe era -> PDoc
pcPrevGovActionIds (GovRelation PRoot era -> GovRelation StrictMaybe era
forall era. GovRelation PRoot era -> GovRelation StrictMaybe era
toPrevGovActionIds (Proposals era
p Proposals era
-> Getting
     (GovRelation PRoot era) (Proposals era) (GovRelation PRoot era)
-> GovRelation PRoot era
forall s a. s -> Getting a s a -> a
^. Getting
  (GovRelation PRoot era) (Proposals era) (GovRelation PRoot era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot era -> f (GovRelation PRoot era))
-> Proposals era -> f (Proposals era)
pRootsL)))
    , (Text
"pGraph", GovRelation PGraph era -> PDoc
forall era. GovRelation PGraph era -> PDoc
pcForest (Proposals era
p Proposals era
-> Getting
     (GovRelation PGraph era) (Proposals era) (GovRelation PGraph era)
-> GovRelation PGraph era
forall s a. s -> Getting a s a -> a
^. Getting
  (GovRelation PGraph era) (Proposals era) (GovRelation PGraph era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PGraph era -> f (GovRelation PGraph era))
-> Proposals era -> f (Proposals 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", (GovPurposeId purpose era -> PDoc)
-> StrictMaybe (GovPurposeId purpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId purpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId purpose era)
x)
    , (Text
"children", (GovPurposeId purpose era -> PDoc)
-> Set (GovPurposeId purpose era) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet GovPurposeId purpose era -> PDoc
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", (GovPurposeId 'PParamUpdatePurpose era -> PDoc)
-> (PEdges (GovPurposeId 'PParamUpdatePurpose era) -> PDoc)
-> Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era))
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap GovPurposeId 'PParamUpdatePurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId PEdges (GovPurposeId 'PParamUpdatePurpose era) -> PDoc
forall (purpose :: GovActionPurpose) era.
PEdges (GovPurposeId purpose era) -> PDoc
pcPEdges (PGraph (GovPurposeId 'PParamUpdatePurpose era)
-> Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era))
forall a. PGraph a -> Map a (PEdges a)
unPGraph PGraph (GovPurposeId 'PParamUpdatePurpose era)
a))
    , (Text
"hardfork", (GovPurposeId 'HardForkPurpose era -> PDoc)
-> (PEdges (GovPurposeId 'HardForkPurpose era) -> PDoc)
-> Map
     (GovPurposeId 'HardForkPurpose era)
     (PEdges (GovPurposeId 'HardForkPurpose era))
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap GovPurposeId 'HardForkPurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId PEdges (GovPurposeId 'HardForkPurpose era) -> PDoc
forall (purpose :: GovActionPurpose) era.
PEdges (GovPurposeId purpose era) -> PDoc
pcPEdges (PGraph (GovPurposeId 'HardForkPurpose era)
-> Map
     (GovPurposeId 'HardForkPurpose era)
     (PEdges (GovPurposeId 'HardForkPurpose era))
forall a. PGraph a -> Map a (PEdges a)
unPGraph PGraph (GovPurposeId 'HardForkPurpose era)
b))
    , (Text
"committee", (GovPurposeId 'CommitteePurpose era -> PDoc)
-> (PEdges (GovPurposeId 'CommitteePurpose era) -> PDoc)
-> Map
     (GovPurposeId 'CommitteePurpose era)
     (PEdges (GovPurposeId 'CommitteePurpose era))
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap GovPurposeId 'CommitteePurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId PEdges (GovPurposeId 'CommitteePurpose era) -> PDoc
forall (purpose :: GovActionPurpose) era.
PEdges (GovPurposeId purpose era) -> PDoc
pcPEdges (PGraph (GovPurposeId 'CommitteePurpose era)
-> Map
     (GovPurposeId 'CommitteePurpose era)
     (PEdges (GovPurposeId 'CommitteePurpose era))
forall a. PGraph a -> Map a (PEdges a)
unPGraph PGraph (GovPurposeId 'CommitteePurpose era)
c))
    , (Text
"constitution", (GovPurposeId 'ConstitutionPurpose era -> PDoc)
-> (PEdges (GovPurposeId 'ConstitutionPurpose era) -> PDoc)
-> Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era))
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap GovPurposeId 'ConstitutionPurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId PEdges (GovPurposeId 'ConstitutionPurpose era) -> PDoc
forall (purpose :: GovActionPurpose) era.
PEdges (GovPurposeId purpose era) -> PDoc
pcPEdges (PGraph (GovPurposeId 'ConstitutionPurpose era)
-> Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era))
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 = Proposals era -> PDoc
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
gasId :: GovActionId
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole) Vote
gasDRepVotes :: Map (Credential 'DRepRole) Vote
gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasProposalProcedure :: ProposalProcedure era
gasProposedIn :: EpochNo
gasExpiresAfter :: EpochNo
gasId :: forall era. GovActionState era -> GovActionId
gasCommitteeVotes :: forall era.
GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
gasDRepVotes :: forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasStakePoolVotes :: forall era. GovActionState era -> Map (KeyHash 'StakePool) Vote
gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasProposedIn :: forall era. GovActionState era -> EpochNo
gasExpiresAfter :: forall era. GovActionState era -> EpochNo
..} = GovActionState era
gas
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"GovActionState"
        [ (Text
"Id", GovActionId -> PDoc
pcGovActionId GovActionId
gasId)
        , (Text
"CommitteVotes", (Credential 'HotCommitteeRole -> PDoc)
-> (Vote -> PDoc)
-> Map (Credential 'HotCommitteeRole) Vote
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'HotCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Vote -> PDoc
pcVote Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes)
        , (Text
"DRepVotes", (Credential 'DRepRole -> PDoc)
-> (Vote -> PDoc) -> Map (Credential 'DRepRole) Vote -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Vote -> PDoc
pcVote Map (Credential 'DRepRole) Vote
gasDRepVotes)
        , (Text
"StakePoolVotes", (KeyHash 'StakePool -> PDoc)
-> (Vote -> PDoc) -> Map (KeyHash 'StakePool) Vote -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Vote -> PDoc
pcVote Map (KeyHash 'StakePool) Vote
gasStakePoolVotes)
        , (Text
"Procedure", ProposalProcedure era -> PDoc
forall era. ProposalProcedure era -> PDoc
pcProposalProcedure ProposalProcedure era
gasProposalProcedure)
        , (Text
"Proposed In", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
gasProposedIn)
        , (Text
"Expires After", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
gasExpiresAfter)
        ]

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

pcVote :: Vote -> PDoc
pcVote :: Vote -> PDoc
pcVote Vote
x = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (Vote -> [Char]
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", (Credential 'ColdCommitteeRole -> PDoc)
-> (EpochNo -> PDoc)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'ColdCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential EpochNo -> PDoc
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 = Committee era -> PDoc
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", (GovPurposeId 'PParamUpdatePurpose era -> PDoc)
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId 'PParamUpdatePurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
pgaid)
      , (Text
"PPUpdate", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"(PParamsUpdate ...)")
      , (Text
"Policy", (ScriptHash -> PDoc) -> StrictMaybe ScriptHash -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe ScriptHash -> PDoc
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", (GovPurposeId 'HardForkPurpose era -> PDoc)
-> StrictMaybe (GovPurposeId 'HardForkPurpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId 'HardForkPurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'HardForkPurpose era)
pgaid)
      , (Text
"ProtVer", [Char] -> PDoc
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", (RewardAccount -> PDoc)
-> (Coin -> PDoc) -> Map RewardAccount Coin -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap RewardAccount -> PDoc
pcRewardAccount Coin -> PDoc
pcCoin Map RewardAccount Coin
ws)
      , (Text
"Policy", (ScriptHash -> PDoc) -> StrictMaybe ScriptHash -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe ScriptHash -> PDoc
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", (GovPurposeId 'CommitteePurpose era -> PDoc)
-> StrictMaybe (GovPurposeId 'CommitteePurpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId 'CommitteePurpose era -> PDoc
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", (GovPurposeId 'CommitteePurpose era -> PDoc)
-> StrictMaybe (GovPurposeId 'CommitteePurpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId 'CommitteePurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'CommitteePurpose era)
pgaid)
      , (Text
"membersToRemove", (Credential 'ColdCommitteeRole -> PDoc)
-> Set (Credential 'ColdCommitteeRole) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet Credential 'ColdCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Set (Credential 'ColdCommitteeRole)
toRemove)
      , (Text
"membersToAdd", (Credential 'ColdCommitteeRole -> PDoc)
-> (EpochNo -> PDoc)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'ColdCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential EpochNo -> PDoc
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", (GovPurposeId 'ConstitutionPurpose era -> PDoc)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe GovPurposeId 'ConstitutionPurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
pgaid)
      , (Text
"Constitution", Constitution era -> PDoc
forall c. Constitution c -> PDoc
pcConstitution Constitution era
c)
      ]
  GovAction era
InfoAction -> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"InfoAction"

instance PrettyA (GovAction era) where
  prettyA :: GovAction era -> PDoc
prettyA = GovAction era -> PDoc
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", (ScriptHash -> PDoc) -> StrictMaybe ScriptHash -> PDoc
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 = Constitution c -> PDoc
forall c. Constitution c -> PDoc
pcConstitution

ppCommitteeAuthorization :: CommitteeAuthorization -> PDoc
ppCommitteeAuthorization :: CommitteeAuthorization -> PDoc
ppCommitteeAuthorization =
  \case
    CommitteeHotCredential Credential 'HotCommitteeRole
hk -> Text -> [PDoc] -> PDoc
ppSexp Text
"CommitteeHotCredential" [Credential 'HotCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'HotCommitteeRole
hk]
    CommitteeMemberResigned StrictMaybe Anchor
anchor -> Text -> [PDoc] -> PDoc
ppSexp Text
"CommitteeMemberResigned" [(Anchor -> PDoc) -> StrictMaybe Anchor -> PDoc
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 = (Credential 'ColdCommitteeRole -> PDoc)
-> (CommitteeAuthorization -> PDoc)
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'ColdCommitteeRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential CommitteeAuthorization -> PDoc
ppCommitteeAuthorization (CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds CommitteeState era
x)

instance (PrettyA (CommitteeState era)) where
  prettyA :: CommitteeState era -> PDoc
prettyA = CommitteeState era -> PDoc
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", KeyHash 'StakePool -> PDoc
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", Word64 -> PDoc
forall a. Word64 -> Doc a
ppWord64 Word64
x)
    , (Text
"keyHash", KeyHash 'Genesis -> PDoc
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 :: forall era. Reflect era => CertState era -> PDoc
pcCertState :: forall era. Reflect era => CertState era -> PDoc
pcCertState CertState era
certState = case Proof era -> CertStateWit era
forall era. Proof era -> CertStateWit era
whichCertState (forall era. Reflect era => Proof era
reify @era) of
  CertStateWit era
CertStateShelleyToBabbage -> ShelleyCertState era -> PDoc
forall era. ShelleyCertState era -> PDoc
pcShelleyCertState CertState era
ShelleyCertState era
certState
  CertStateWit era
CertStateConwayToConway -> ConwayCertState era -> PDoc
forall era. ConwayCertState era -> PDoc
pcConwayCertState CertState era
ConwayCertState era
certState

pcShelleyCertState :: ShelleyCertState era -> PDoc
pcShelleyCertState :: forall era. ShelleyCertState era -> PDoc
pcShelleyCertState (ShelleyCertState {PState era
DState era
shelleyCertPState :: PState era
shelleyCertDState :: DState era
shelleyCertPState :: forall era. ShelleyCertState era -> PState era
shelleyCertDState :: forall era. ShelleyCertState era -> DState era
..}) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ShelleyCertState"
    [ (Text
"pstate", PState era -> PDoc
forall c. PState c -> PDoc
pcPState PState era
shelleyCertPState)
    , (Text
"dstate", DState era -> PDoc
forall c. DState c -> PDoc
pcDState DState era
shelleyCertDState)
    ]

pcConwayCertState :: ConwayCertState era -> PDoc
pcConwayCertState :: forall era. ConwayCertState era -> PDoc
pcConwayCertState (ConwayCertState {PState era
DState era
VState era
conwayCertVState :: VState era
conwayCertPState :: PState era
conwayCertDState :: DState era
conwayCertVState :: forall era. ConwayCertState era -> VState era
conwayCertPState :: forall era. ConwayCertState era -> PState era
conwayCertDState :: forall era. ConwayCertState era -> DState era
..}) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"ConwayCertState"
    [ (Text
"pstate", PState era -> PDoc
forall c. PState c -> PDoc
pcPState PState era
conwayCertPState)
    , (Text
"vstate", VState era -> PDoc
forall era. VState era -> PDoc
pcVState VState era
conwayCertVState)
    , (Text
"dstate", DState era -> PDoc
forall c. DState c -> PDoc
pcDState DState era
conwayCertDState)
    ]

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", (Credential 'DRepRole -> PDoc)
-> (DRepState -> PDoc)
-> Map (Credential 'DRepRole) DRepState
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential DRepState -> PDoc
pcDRepState Map (Credential 'DRepRole) DRepState
dreps)
    , (Text
"CC Hot Keys", CommitteeState era -> PDoc
forall era. CommitteeState era -> PDoc
pcCommitteeState CommitteeState era
committeeState)
    , (Text
"Number of dormant epochs", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
numDormantEpochs)
    ]

instance PrettyA (VState era) where
  prettyA :: VState era -> PDoc
prettyA VState era
st = VState era -> PDoc
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", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (Url -> [Char]
forall a. Show a => a -> [Char]
show Url
u))
    , (Text
"datahash", PDoc -> PDoc
trim (PDoc -> PDoc) -> PDoc -> PDoc
forall a b. (a -> b) -> a -> b
$ SafeHash AnchorData -> PDoc
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", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
expire)
    , (Text
"anchor", (Anchor -> PDoc) -> StrictMaybe Anchor -> PDoc
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", (Credential 'Staking -> PDoc) -> Set (Credential 'Staking) -> PDoc
forall x ann. (x -> Doc ann) -> Set x -> Doc ann
ppSet Credential 'Staking -> PDoc
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" [Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Credential 'DRepRole
cred]
pcDRep DRep
DRepAlwaysAbstain = Text -> [PDoc] -> PDoc
ppSexp Text
"DRep" [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Abstain"]
pcDRep DRep
DRepAlwaysNoConfidence = Text -> [PDoc] -> PDoc
ppSexp Text
"DRep" [[Char] -> PDoc
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Stake", (Credential 'Staking -> PDoc)
-> (CompactForm Coin -> PDoc)
-> Map (Credential 'Staking) (CompactForm Coin)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential (Coin -> PDoc
pcCoin (Coin -> PDoc)
-> (CompactForm Coin -> Coin) -> CompactForm Coin -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact) (VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> Map (Credential 'Staking) (CompactForm Coin)
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Delegs", (Credential 'Staking -> PDoc)
-> (KeyHash 'StakePool -> PDoc)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Pools", (KeyHash 'StakePool -> PDoc)
-> (PoolParams -> PDoc)
-> Map (KeyHash 'StakePool) PoolParams
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash PoolParams -> PDoc
pcPoolParams (VMap VB VB (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PoolParams
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", Rational -> PDoc
forall a. Rational -> Doc a
ppRational (IndividualPoolStake -> Rational
individualPoolStake IndividualPoolStake
x))
    , (Text
"vrf", PDoc -> PDoc
trim (VRFVerKeyHash 'StakePoolVRF -> PDoc
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
"" ([(Text, PDoc)] -> PDoc) -> [(Text, PDoc)] -> PDoc
forall a b. (a -> b) -> a -> b
$
    Text -> SnapShot -> [(Text, PDoc)]
pcSnapShotL Text
"mark" (SnapShots -> SnapShot
ssStakeMark SnapShots
sss)
      [(Text, PDoc)] -> [(Text, PDoc)] -> [(Text, PDoc)]
forall a. [a] -> [a] -> [a]
++ [(Text
"markPoolDistr", PoolDistr -> PDoc
pcPoolDistr (SnapShots -> PoolDistr
ssStakeMarkPoolDistr SnapShots
sss))]
      [(Text, PDoc)] -> [(Text, PDoc)] -> [(Text, PDoc)]
forall a. [a] -> [a] -> [a]
++ Text -> SnapShot -> [(Text, PDoc)]
pcSnapShotL Text
"set" (SnapShots -> SnapShot
ssStakeSet SnapShots
sss)
      [(Text, PDoc)] -> [(Text, PDoc)] -> [(Text, PDoc)]
forall a. [a] -> [a] -> [a]
++ Text -> SnapShot -> [(Text, PDoc)]
pcSnapShotL Text
"go" (SnapShots -> SnapShot
ssStakeGo SnapShots
sss)
      [(Text, PDoc)] -> [(Text, PDoc)] -> [(Text, PDoc)]
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) =
  (KeyHash 'StakePool -> PDoc)
-> (IndividualPoolStake -> PDoc)
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash IndividualPoolStake -> PDoc
pcIndividualPoolStake Map (KeyHash 'StakePool) IndividualPoolStake
pdistr
    PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
" total = "
    PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> Rational -> PDoc
forall a. Rational -> Doc a
ppRational ((Rational -> Rational -> Rational)
-> Rational -> Map (KeyHash 'StakePool) Rational -> Rational
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+) Rational
0 ((IndividualPoolStake -> Rational)
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> Map (KeyHash 'StakePool) Rational
forall a b.
(a -> b)
-> Map (KeyHash 'StakePool) a -> Map (KeyHash 'StakePool) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IndividualPoolStake -> Rational
individualPoolStake Map (KeyHash 'StakePool) IndividualPoolStake
pdistr))
    PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
" actualTotal = "
    PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> Coin -> PDoc
pcCoin (CompactForm Coin -> Coin
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 = a
EraPParams era => a
x
withEraPParams Proof era
Mary EraPParams era => a
x = a
EraPParams era => a
x
withEraPParams Proof era
Allegra EraPParams era => a
x = a
EraPParams era => a
x
withEraPParams Proof era
Alonzo EraPParams era => a
x = a
EraPParams era => a
x
withEraPParams Proof era
Babbage EraPParams era => a
x = a
EraPParams era => a
x
withEraPParams Proof era
Conway EraPParams era => a
x = a
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 = Proof era -> (EraPParams era => PDoc) -> PDoc
forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p PDoc
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", Word32 -> PDoc
forall a. Word32 -> Doc a
ppWord32 (PParams era
x PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
Core.ppMaxBBSizeL))
        , (Text
"maxBHSize", Word16 -> PDoc
forall a. Word16 -> Doc a
ppWord16 (PParams era
x PParams era -> Getting Word16 (PParams era) Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. Getting Word16 (PParams era) Word16
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams era) Word16
Core.ppMaxBHSizeL))
        , (Text
"maxTxSize", Word32 -> PDoc
forall a. Word32 -> Doc a
ppWord32 (PParams era
x PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
Core.ppMaxTxSizeL))
        , (Text
"poolDeposit", Coin -> PDoc
pcCoin (PParams era
x PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
Core.ppPoolDepositL))
        , (Text
"keyDeposit", Coin -> PDoc
pcCoin (PParams era
x PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
Core.ppKeyDepositL))
        , (Text
"protVer", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString (ProtVer -> [Char]
showProtver (PParams era
x PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
Core.ppProtocolVersionL)))
        ]

showProtver :: ProtVer -> String
showProtver :: ProtVer -> [Char]
showProtver (ProtVer Version
x Natural
y) = [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
forall a. Show a => a -> [Char]
show Version
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Natural -> [Char]
forall a. Show a => a -> [Char]
show Natural
y [Char] -> [Char] -> [Char]
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 (ChainAccountState Coin
tre Coin
res) LedgerState era
ls SnapShots
sss NonMyopic
nonmy) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"EpochState"
    [ (Text
"ChainAccountState", PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' PDoc
"" [(Text
"treasury", Coin -> PDoc
pcCoin Coin
tre), (Text
"reserves", Coin -> PDoc
pcCoin Coin
res)])
    , (Text
"LedgerState", Proof era -> LedgerState era -> PDoc
forall era. Reflect 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", EpochState era -> PDoc
forall era.
(EraTxOut era, EraGov era, EraCertState era) =>
EpochState era -> PDoc
pcAdaPot EpochState era
es)
    ]

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

pcChainAccountState :: ChainAccountState -> PDoc
pcChainAccountState :: ChainAccountState -> PDoc
pcChainAccountState (ChainAccountState 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 ChainAccountState where
  prettyA :: ChainAccountState -> PDoc
prettyA = ChainAccountState -> PDoc
pcChainAccountState

-- | 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 (ChainAccountState Coin
tre Coin
res) LedgerState era
ls SnapShots
sss NonMyopic
_) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"EpochState"
    [ (Text
"ChainAccountState", PDoc -> [(Text, PDoc)] -> PDoc
ppRecord' PDoc
"" [(Text
"treasury", Coin -> PDoc
pcCoin Coin
tre), (Text
"reserves", Coin -> PDoc
pcCoin Coin
res)])
    , (Text
"LedgerState", Proof era -> LedgerState era -> PDoc
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", EpochState era -> PDoc
forall era.
(EraTxOut era, EraGov era, EraCertState 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", Proof era -> EpochState era -> PDoc
forall era. Reflect era => Proof era -> EpochState era -> PDoc
pcEpochState Proof era
proof EpochState era
es)
    , (Text
"PoolDistr", (KeyHash 'StakePool -> PDoc)
-> (IndividualPoolStake -> PDoc)
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash IndividualPoolStake -> PDoc
pcIndividualPoolStake Map (KeyHash 'StakePool) IndividualPoolStake
pd)
    , (Text
"Prev Blocks", (KeyHash 'StakePool -> PDoc)
-> (Natural -> PDoc) -> Map (KeyHash 'StakePool) Natural -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) Natural
pbm)
    , (Text
"Current Blocks", (KeyHash 'StakePool -> PDoc)
-> (Natural -> PDoc) -> Map (KeyHash 'StakePool) Natural -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) Natural
cbm)
    , (Text
"EpochNo", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
en)
    ]

instance Reflect era => PrettyA (NewEpochState era) where
  prettyA :: NewEpochState era -> PDoc
prettyA = Proof era -> NewEpochState era -> PDoc
forall era. Reflect era => Proof era -> NewEpochState era -> PDoc
pcNewEpochState Proof era
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", Proof era -> EpochState era -> PDoc
forall era. Reflect era => Proof era -> EpochState era -> PDoc
psEpochState Proof era
proof EpochState era
es)
    , (Text
"PoolDistr", (KeyHash 'StakePool -> PDoc)
-> (IndividualPoolStake -> PDoc)
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash IndividualPoolStake -> PDoc
pcIndividualPoolStake Map (KeyHash 'StakePool) IndividualPoolStake
pd)
    , (Text
"Prev Blocks", (KeyHash 'StakePool -> PDoc)
-> (Natural -> PDoc) -> Map (KeyHash 'StakePool) Natural -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) Natural
pbm)
    , (Text
"Current Blocks", (KeyHash 'StakePool -> PDoc)
-> (Natural -> PDoc) -> Map (KeyHash 'StakePool) Natural -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) Natural
cbm)
    , (Text
"EpochNo", EpochNo -> PDoc
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 InstantStake era
_ Coin
don) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"UTxOState"
    [ (Text
"utxo", Proof era -> UTxO era -> PDoc
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", Proof era -> GovState era -> PDoc
forall era. Proof era -> GovState era -> PDoc
pcGovState Proof era
proof GovState era
gs)
    , (Text
"donation", Coin -> PDoc
pcCoin Coin
don)
    ]

instance Reflect era => PrettyA (UTxOState era) where
  prettyA :: UTxOState era -> PDoc
prettyA = Proof era -> UTxOState era -> PDoc
forall era. Proof era -> UTxOState era -> PDoc
pcUTxOState Proof era
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 InstantStake era
_ Coin
don) =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"UTxOState"
    [ (Text
"utxo", Map TxIn (CompactForm Coin) -> PDoc
forall a. Map a (CompactForm Coin) -> PDoc
summaryMapCompact ((TxOut era -> CompactForm Coin)
-> Map TxIn (TxOut era) -> Map TxIn (CompactForm Coin)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\TxOut era
x -> TxOut era
x TxOut era
-> Getting (CompactForm Coin) (TxOut era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (TxOut era) (CompactForm Coin)
forall era.
(HasCallStack, EraTxOut era) =>
Lens' (TxOut era) (CompactForm Coin)
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", Proof era -> GovState era -> PDoc
forall era. Proof era -> GovState era -> PDoc
pcGovState Proof era
proof GovState era
gs)
    , (Text
"donation", Coin -> PDoc
pcCoin Coin
don)
    ]

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

instance Reflect era => PrettyA (LedgerState era) where
  prettyA :: LedgerState era -> PDoc
prettyA = Proof era -> LedgerState era -> PDoc
forall era. Reflect era => Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
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", Proof era -> UTxOState era -> PDoc
forall era. Reflect era => Proof era -> UTxOState era -> PDoc
psUTxOState Proof era
proof (LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls))
    , (Text
"certState", CertState era -> PDoc
forall era. Reflect era => CertState era -> PDoc
pcCertState (LedgerState era -> CertState era
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", (KeyHash 'StakePool -> PDoc)
-> (PoolParams -> PDoc)
-> Map (KeyHash 'StakePool) PoolParams
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash PoolParams -> PDoc
pcPoolParams Map (KeyHash 'StakePool) PoolParams
regP)
    , (Text
"futureRegPools", (KeyHash 'StakePool -> PDoc)
-> (PoolParams -> PDoc)
-> Map (KeyHash 'StakePool) PoolParams
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash PoolParams -> PDoc
pcPoolParams Map (KeyHash 'StakePool) PoolParams
fregP)
    , (Text
"retiring", (KeyHash 'StakePool -> PDoc)
-> (EpochNo -> PDoc) -> Map (KeyHash 'StakePool) EpochNo -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo Map (KeyHash 'StakePool) EpochNo
ret)
    , (Text
"poolDeposits", (KeyHash 'StakePool -> PDoc)
-> (Coin -> PDoc) -> Map (KeyHash 'StakePool) Coin -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
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 = PState era -> PDoc
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", (Credential 'Staking -> PDoc)
-> (Coin -> PDoc) -> Map (Credential 'Staking) Coin -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Coin -> PDoc
pcCoin (UMap -> Map (Credential 'Staking) Coin
rewardMap (DState c -> UMap
forall era. DState era -> UMap
dsUnified DState c
ds)))
    , (Text
"deposits", (Credential 'Staking -> PDoc)
-> (Coin -> PDoc) -> Map (Credential 'Staking) Coin -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Coin -> PDoc
pcCoin (UMap -> Map (Credential 'Staking) Coin
depositMap (DState c -> UMap
forall era. DState era -> UMap
dsUnified DState c
ds)))
    , (Text
"delegate", (Credential 'Staking -> PDoc)
-> (KeyHash 'StakePool -> PDoc)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential KeyHash 'StakePool -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap (DState c -> UMap
forall era. DState era -> UMap
dsUnified DState c
ds)))
    , (Text
"drepDeleg", (Credential 'Staking -> PDoc)
-> (DRep -> PDoc) -> Map (Credential 'Staking) DRep -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential DRep -> PDoc
pcDRep (UMap -> Map (Credential 'Staking) DRep
dRepMap (DState c -> UMap
forall era. DState era -> UMap
dsUnified DState c
ds)))
    , (Text
"ptrs", (Ptr -> PDoc)
-> (Credential 'Staking -> PDoc)
-> Map Ptr (Credential 'Staking)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Ptr -> PDoc
ppPtr Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential (UMap -> Map Ptr (Credential 'Staking)
ptrMap (DState c -> UMap
forall era. DState era -> UMap
dsUnified DState c
ds)))
    , (Text
"fGenDel", (FutureGenDeleg -> PDoc)
-> (GenDelegPair -> PDoc)
-> Map FutureGenDeleg GenDelegPair
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap FutureGenDeleg -> PDoc
pcFutureGenDeleg GenDelegPair -> PDoc
pcGenDelegPair (DState c -> Map FutureGenDeleg GenDelegPair
forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs DState c
ds))
    , (Text
"GenDel", (KeyHash 'Genesis -> PDoc)
-> (GenDelegPair -> PDoc)
-> Map (KeyHash 'Genesis) GenDelegPair
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'Genesis -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash GenDelegPair -> PDoc
pcGenDelegPair (GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair
unGenDelegs (DState c -> GenDelegs
forall era. DState era -> GenDelegs
dsGenDelegs DState c
ds)))
    , (Text
"iRewards", InstantaneousRewards -> PDoc
pcIRewards (DState c -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState c
ds))
    ]

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

pcGenDelegPair :: GenDelegPair -> PDoc
pcGenDelegPair :: GenDelegPair -> PDoc
pcGenDelegPair GenDelegPair
x =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord
    Text
"GDPair"
    [ (Text
"keyhash", KeyHash 'GenesisDelegate -> PDoc
forall (discriminator :: KeyRole). KeyHash discriminator -> PDoc
pcKeyHash (GenDelegPair -> KeyHash 'GenesisDelegate
genDelegKeyHash GenDelegPair
x))
    , (Text
"vrfhash", PDoc -> PDoc
trim (VRFVerKeyHash 'GenDelegVRF -> PDoc
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", (Credential 'Staking -> PDoc)
-> (Coin -> PDoc) -> Map (Credential 'Staking) Coin -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential Coin -> PDoc
pcCoin (InstantaneousRewards -> Map (Credential 'Staking) Coin
DP.iRReserves InstantaneousRewards
xs))
    , (Text
"treasury", (Credential 'Staking -> PDoc)
-> (Coin -> PDoc) -> Map (Credential 'Staking) Coin -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
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) = [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [[Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"▵₳", Integer -> PDoc
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) = Word64 -> PDoc
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 = Obligations -> PDoc
forall a ann. Show a => a -> Doc ann
viaShow

pcAdaPot ::
  ( EraTxOut era
  , EraGov era
  , EraCertState era
  ) =>
  EpochState era ->
  PDoc
pcAdaPot :: forall era.
(EraTxOut era, EraGov era, EraCertState era) =>
EpochState era -> PDoc
pcAdaPot EpochState era
es =
  let x :: AdaPots
x = EpochState era -> AdaPots
forall era.
(EraTxOut era, EraGov era, EraCertState 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", Obligations -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA (AdaPots -> Obligations
obligationsPot AdaPots
x))
        , (Text
"totalAda", Coin -> PDoc
pcCoin (EpochState era -> Coin
forall era.
(EraTxOut era, EraGov era, EraCertState 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 (AssetName -> PDoc
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 = ((PolicyID, AssetName, Integer) -> PDoc)
-> [(PolicyID, AssetName, Integer)] -> PDoc
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) = [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
hsep [PDoc
"(", PolicyID -> PDoc
pcPolicyID PolicyID
i, AssetName -> PDoc
pcAssetName AssetName
asset, Integer -> PDoc
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" [ix -> PDoc
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" [it -> PDoc
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" [ix -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA ix
ix, it -> PDoc
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" [f Word32 PolicyID -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA f Word32 PolicyID
i]
    AlonzoSpending f Word32 TxIn
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoSpending" [f Word32 TxIn -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA f Word32 TxIn
i]
    AlonzoRewarding f Word32 RewardAccount
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoRewarding" [f Word32 RewardAccount -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA f Word32 RewardAccount
i]
    AlonzoCertifying f Word32 (TxCert era)
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"AlonzoCertifying" [f Word32 (TxCert era) -> PDoc
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" [f Word32 PolicyID -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA f Word32 PolicyID
i]
    ConwaySpending f Word32 TxIn
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwaySpending" [f Word32 TxIn -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA f Word32 TxIn
i]
    ConwayRewarding f Word32 RewardAccount
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayRewarding" [f Word32 RewardAccount -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA f Word32 RewardAccount
i]
    ConwayCertifying f Word32 (TxCert era)
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayCertifying" [f Word32 (TxCert era) -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA f Word32 (TxCert era)
i]
    ConwayVoting f Word32 Voter
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayVoting" [f Word32 Voter -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA f Word32 Voter
i]
    ConwayProposing f Word32 (ProposalProcedure era)
i -> Text -> [PDoc] -> PDoc
ppSexp Text
"ConwayProposing" [f Word32 (ProposalProcedure era) -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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" [(ScriptHash -> PDoc) -> Set ScriptHash -> PDoc
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" [((AlonzoPlutusPurpose AsIxItem AlonzoEra, ScriptHash) -> PDoc)
-> [(AlonzoPlutusPurpose AsIxItem AlonzoEra, ScriptHash)] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ((AlonzoPlutusPurpose AsIxItem AlonzoEra -> PDoc)
-> (ScriptHash -> PDoc)
-> (AlonzoPlutusPurpose AsIxItem AlonzoEra, ScriptHash)
-> PDoc
forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair AlonzoPlutusPurpose AsIxItem AlonzoEra -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA ScriptHash -> PDoc
pcScriptHash) [(AlonzoPlutusPurpose AsIxItem AlonzoEra, ScriptHash)]
[(PlutusPurpose AsIxItem AlonzoEra, ScriptHash)]
pl]
pcScriptsNeeded Proof era
Babbage (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem BabbageEra, ScriptHash)]
pl) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [((AlonzoPlutusPurpose AsIxItem BabbageEra, ScriptHash) -> PDoc)
-> [(AlonzoPlutusPurpose AsIxItem BabbageEra, ScriptHash)] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ((AlonzoPlutusPurpose AsIxItem BabbageEra -> PDoc)
-> (ScriptHash -> PDoc)
-> (AlonzoPlutusPurpose AsIxItem BabbageEra, ScriptHash)
-> PDoc
forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair AlonzoPlutusPurpose AsIxItem BabbageEra -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA ScriptHash -> PDoc
pcScriptHash) [(AlonzoPlutusPurpose AsIxItem BabbageEra, ScriptHash)]
[(PlutusPurpose AsIxItem BabbageEra, ScriptHash)]
pl]
pcScriptsNeeded Proof era
Conway (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem ConwayEra, ScriptHash)]
pl) =
  Text -> [PDoc] -> PDoc
ppSexp Text
"ScriptsNeeded" [((ConwayPlutusPurpose AsIxItem ConwayEra, ScriptHash) -> PDoc)
-> [(ConwayPlutusPurpose AsIxItem ConwayEra, ScriptHash)] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList ((ConwayPlutusPurpose AsIxItem ConwayEra -> PDoc)
-> (ScriptHash -> PDoc)
-> (ConwayPlutusPurpose AsIxItem ConwayEra, ScriptHash)
-> PDoc
forall t1 t2. (t1 -> PDoc) -> (t2 -> PDoc) -> (t1, t2) -> PDoc
ppPair ConwayPlutusPurpose AsIxItem ConwayEra -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA ScriptHash -> PDoc
pcScriptHash) [(PlutusPurpose AsIxItem ConwayEra, ScriptHash)]
[(ConwayPlutusPurpose 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", Int -> PDoc
forall a. Int -> Doc a
ppInt (DRepPulser era Identity (RatifyState era) -> Int
forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpPulseSize DRepPulser era Identity (RatifyState era)
x))
    , (Text
"DRepUView Map", (Credential 'Staking -> PDoc)
-> (DRep -> PDoc) -> Map (Credential 'Staking) DRep -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential DRep -> PDoc
pcDRep (UMap -> Map (Credential 'Staking) DRep
dRepMap (DRepPulser era Identity (RatifyState era) -> UMap
forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpUMap DRepPulser era Identity (RatifyState era)
x)))
    , (Text
"index", Int -> PDoc
forall a. Int -> Doc a
ppInt (DRepPulser era Identity (RatifyState era) -> Int
forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpIndex DRepPulser era Identity (RatifyState era)
x))
    , (Text
"poolDistr", PoolDistr -> PDoc
pcPoolDistr (DRepPulser era Identity (RatifyState era) -> PoolDistr
forall era ans (m :: * -> *). DRepPulser era m ans -> PoolDistr
dpStakePoolDistr DRepPulser era Identity (RatifyState era)
x))
    , (Text
"partialDrepDistr", Map DRep (CompactForm Coin) -> PDoc
forall a. Map a (CompactForm Coin) -> PDoc
summaryMapCompact (DRepPulser era Identity (RatifyState era)
-> Map DRep (CompactForm Coin)
forall era ans (m :: * -> *).
DRepPulser era m ans -> Map DRep (CompactForm Coin)
dpDRepDistr DRepPulser era Identity (RatifyState era)
x))
    , (Text
"drepState", (Credential 'DRepRole -> PDoc)
-> (DRepState -> PDoc)
-> Map (Credential 'DRepRole) DRepState
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential DRepState -> PDoc
pcDRepState (DRepPulser era Identity (RatifyState era)
-> Map (Credential 'DRepRole) DRepState
forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (Credential 'DRepRole) DRepState
dpDRepState DRepPulser era Identity (RatifyState era)
x))
    , (Text
"epoch", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo (DRepPulser era Identity (RatifyState era) -> EpochNo
forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpCurrentEpoch DRepPulser era Identity (RatifyState era)
x))
    , (Text
"committeeState", CommitteeState era -> PDoc
forall era. CommitteeState era -> PDoc
pcCommitteeState (DRepPulser era Identity (RatifyState era) -> CommitteeState era
forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpCommitteeState DRepPulser era Identity (RatifyState era)
x))
    , (Text
"proposals", (GovActionState era -> PDoc)
-> StrictSeq (GovActionState era) -> PDoc
forall a ann. (a -> Doc ann) -> StrictSeq a -> Doc ann
ppStrictSeq GovActionState era -> PDoc
forall era. GovActionState era -> PDoc
pcGovActionState (DRepPulser era Identity (RatifyState era)
-> StrictSeq (GovActionState era)
forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpProposals DRepPulser era Identity (RatifyState era)
x))
    , (Text
"globals", [Char] -> PDoc
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 = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char]
"Count " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Map a (CompactForm Coin) -> Int
forall k a. Map k a -> Int
Map.size Map a (CompactForm Coin)
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", Total " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CompactForm Coin -> [Char]
forall a. Show a => a -> [Char]
show ((CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> CompactForm Coin -> Map a (CompactForm Coin) -> CompactForm Coin
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a. Semigroup a => a -> a -> a
(<>) CompactForm Coin
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 Proof era
forall era. Reflect era => Proof era
reify PParams era
pp
    , EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
ce
    , (Committee era -> PDoc) -> StrictMaybe (Committee era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Committee era -> PDoc
forall era. Committee era -> PDoc
pcCommittee StrictMaybe (Committee era)
cc
    , (GovActionId -> PDoc)
-> (GovActionState era -> PDoc)
-> Map GovActionId (GovActionState era)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap GovActionId -> PDoc
pcGovActionId GovActionState era -> PDoc
forall era. GovActionState era -> PDoc
pcGovActionState (Map GovActionId (GovActionState era) -> PDoc)
-> Map GovActionId (GovActionState era) -> PDoc
forall a b. (a -> b) -> a -> b
$ (GovPurposeId 'CommitteePurpose era -> GovActionId)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> Map GovActionId (GovActionState era)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys GovPurposeId 'CommitteePurpose era -> GovActionId
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 = ConwayGovCertEnv era -> PDoc
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" [EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
en, Proof era -> PParams era -> PDoc
forall era. Proof era -> PParams era -> PDoc
pcPParams Proof era
forall era. Reflect era => Proof era
reify PParams era
pp]

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

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

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

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

instance PrettyA (RatifySignal era) where
  prettyA :: RatifySignal era -> PDoc
prettyA = RatifySignal era -> PDoc
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 'DRepRole) DRepState
PoolDistr
CommitteeState era
InstantStake era
EpochNo
reInstantStake :: InstantStake era
reStakePoolDistr :: PoolDistr
reDRepDistr :: Map DRep (CompactForm Coin)
reDRepState :: Map (Credential 'DRepRole) DRepState
reCurrentEpoch :: EpochNo
reCommitteeState :: CommitteeState era
reDelegatees :: Map (Credential 'Staking) DRep
rePoolParams :: Map (KeyHash 'StakePool) PoolParams
reInstantStake :: forall era. RatifyEnv era -> InstantStake era
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
..} = RatifyEnv era
rs
   in Text -> [(Text, PDoc)] -> PDoc
ppRecord
        Text
"RatifyEnv"
        [ (Text
"StakePoolDistr", PoolDistr -> PDoc
pcPoolDistr PoolDistr
reStakePoolDistr)
        , (Text
"DRepDistr", (DRep -> PDoc)
-> (CompactForm Coin -> PDoc)
-> Map DRep (CompactForm Coin)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap DRep -> PDoc
pcDRep (Coin -> PDoc
pcCoin (Coin -> PDoc)
-> (CompactForm Coin -> Coin) -> CompactForm Coin -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact) Map DRep (CompactForm Coin)
reDRepDistr)
        , (Text
"DRepState", (Credential 'DRepRole -> PDoc)
-> (DRepState -> PDoc)
-> Map (Credential 'DRepRole) DRepState
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'DRepRole -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential DRepState -> PDoc
pcDRepState Map (Credential 'DRepRole) DRepState
reDRepState)
        , (Text
"CurrentEpoch", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
reCurrentEpoch)
        , (Text
"CommitteeState", CommitteeState era -> PDoc
forall era. CommitteeState era -> PDoc
pcCommitteeState CommitteeState era
reCommitteeState)
        ]

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

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

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

instance Reflect era => PrettyA (LedgerEnv era) where
  prettyA :: LedgerEnv era -> PDoc
prettyA LedgerEnv {Maybe EpochNo
PParams era
ChainAccountState
TxIx
SlotNo
ledgerSlotNo :: SlotNo
ledgerEpochNo :: Maybe EpochNo
ledgerIx :: TxIx
ledgerPp :: PParams era
ledgerAccount :: ChainAccountState
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 -> ChainAccountState
..} =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"LedgerEnv"
      [ (Text
"slot no", SlotNo -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA SlotNo
ledgerSlotNo)
      , (Text
"epoch no", (EpochNo -> PDoc) -> Maybe EpochNo -> PDoc
forall x ann. (x -> Doc ann) -> Maybe x -> Doc ann
ppMaybe EpochNo -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA Maybe EpochNo
ledgerEpochNo)
      , (Text
"ix", Int -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA (TxIx -> Int
txIxToInt TxIx
ledgerIx))
      , (Text
"pparams", PParams era -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA PParams era
ledgerPp)
      , (Text
"account", ChainAccountState -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA ChainAccountState
ledgerAccount)
      ]

instance (Reflect era, PrettyA (CertState era)) => PrettyA (UtxoEnv era) where
  prettyA :: UtxoEnv era -> PDoc
prettyA UtxoEnv {PParams era
CertState era
SlotNo
ueSlot :: SlotNo
uePParams :: PParams era
ueCertState :: CertState era
ueSlot :: forall era. UtxoEnv era -> SlotNo
uePParams :: forall era. UtxoEnv era -> PParams era
ueCertState :: forall era. UtxoEnv era -> CertState era
..} =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"UtxoEnv"
      [ (Text
"slot no", SlotNo -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA SlotNo
ueSlot)
      , (Text
"pparams", PParams era -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA PParams era
uePParams)
      , (Text
"certState", CertState era -> PDoc
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)
StrictMaybe (Committee era)
PParams era
EpochNo
cePParams :: PParams era
ceCurrentEpoch :: EpochNo
ceCurrentCommittee :: StrictMaybe (Committee era)
ceCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
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)
..} =
    Text -> [(Text, PDoc)] -> PDoc
ppRecord
      Text
"CertEnv"
      [ (Text
"slot no", EpochNo -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA EpochNo
ceCurrentEpoch)
      , (Text
"pparams", PParams era -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA PParams era
cePParams)
      , (Text
"currentEpoch", EpochNo -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA EpochNo
ceCurrentEpoch)
      ]

instance Reflect era => PrettyA (ShelleyCertState era) where
  prettyA :: ShelleyCertState era -> PDoc
prettyA = ShelleyCertState era -> PDoc
forall era. ShelleyCertState era -> PDoc
pcShelleyCertState

instance Reflect era => PrettyA (ConwayCertState era) where
  prettyA :: ConwayCertState era -> PDoc
prettyA = ConwayCertState era -> PDoc
forall era. ConwayCertState era -> PDoc
pcConwayCertState

instance PrettyA x => PrettyA (Seq x) where
  prettyA :: Seq x -> PDoc
prettyA Seq x
x = [x] -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA (Seq x -> [x]
forall a. Seq a -> [a]
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", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"Tx")
      , (Text
"pparams", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"PParams")
      , (Text
"epoch", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
epoch)
      , (Text
"committee", (Committee era -> PDoc) -> StrictMaybe (Committee era) -> PDoc
forall x ann. (x -> Doc ann) -> StrictMaybe x -> Doc ann
ppStrictMaybe Committee era -> PDoc
forall era. Committee era -> PDoc
pcCommittee StrictMaybe (Committee era)
com)
      , (Text
"proposals", (GovPurposeId 'CommitteePurpose era -> PDoc)
-> (GovActionState era -> PDoc)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap GovPurposeId 'CommitteePurpose era -> PDoc
forall (p :: GovActionPurpose) era. GovPurposeId p era -> PDoc
pcGovPurposeId GovActionState era -> PDoc
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) = (Coin, Coin) -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
x, CompactForm Coin -> Coin
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) = (Credential 'Staking -> PDoc)
-> (CompactForm Coin -> PDoc)
-> Map (Credential 'Staking) (CompactForm Coin)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential (Coin -> PDoc
pcCoin (Coin -> PDoc)
-> (CompactForm Coin -> Coin) -> CompactForm Coin -> PDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact) (VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> Map (Credential 'Staking) (CompactForm Coin)
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Proof era -> [Char]
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 = Proof era -> TxBody era -> [TxBodyField era]
forall era. Proof era -> TxBody era -> [TxBodyField era]
abstractTxBody Proof era
proof TxBody era
txbody
    pairs :: [(Text, PDoc)]
pairs = (TxBodyField era -> [(Text, PDoc)])
-> [TxBodyField era] -> [(Text, PDoc)]
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 PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> Map TxIn Coin -> PDoc
forall a. Map a Coin -> PDoc
summaryMap ((TxOut era -> Coin) -> Map TxIn (TxOut era) -> Map TxIn Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\TxOut era
x -> TxOut era
x TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL) Map TxIn (TxOut era)
subutxo))]
      where
        subutxo :: Map TxIn (TxOut era)
subutxo = Map TxIn (TxOut era) -> Set TxIn -> Map TxIn (TxOut era)
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 = Map TxIn (TxOut era) -> Set TxIn -> Map TxIn (TxOut era)
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 = Map TxIn (TxOut era) -> Set TxIn -> Map TxIn (TxOut era)
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", [PDoc] -> PDoc
forall ann. [Doc ann] -> Doc ann
sep ((TxOut era -> PDoc) -> [TxOut era] -> [PDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof) [TxOut era]
outs) PDoc -> PDoc -> PDoc
forall a. Semigroup a => a -> a -> a
<> [Coin] -> PDoc
summaryList ((TxOut era -> Coin) -> [TxOut era] -> [Coin]
forall a b. (a -> b) -> [a] -> [b]
map (\TxOut era
v -> TxOut era
v TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL) [TxOut era]
outs))]
      where
        outs :: [TxOut era]
outs = StrictSeq (TxOut era) -> [TxOut era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxOut era)
x
    f TxBodyField era
x = Proof era -> TxBodyField era -> [(Text, PDoc)]
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 = (TxIn -> PDoc)
-> (TxOut era -> PDoc) -> Map TxIn (TxOut era) -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap TxIn -> PDoc
pcTxIn (Proof era -> TxOut era -> PDoc
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 = [Char] -> PDoc
forall a. [Char] -> Doc a
ppString ([Char]
" Count " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Map a Coin -> Int
forall k a. Map k a -> Int
Map.size Map a Coin
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", Total " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Coin -> [Char]
forall a. Show a => a -> [Char]
show ((Coin -> Coin -> Coin) -> Coin -> Map a Coin -> Coin
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>) Coin
forall a. Monoid a => a
mempty Map a Coin
x))

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