{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module implements 'PrettyCooked', 'PrettyCookedList' and
-- 'PrettyCookedMaybe' instances for data types returned by a @MockChain@ run.
module Cooked.Pretty.MockChain () where

import Cooked.MockChain.BlockChain
import Cooked.MockChain.Direct
import Cooked.MockChain.UtxoState
import Cooked.Pretty.Class
import Cooked.Pretty.Options
import Cooked.Pretty.Skeleton
import Cooked.Wallet
import Data.Function (on)
import Data.List qualified as List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes)
import Data.Set qualified as Set
import Plutus.Script.Utils.Value qualified as Script
import PlutusLedgerApi.V1.Value qualified as Api
import PlutusLedgerApi.V3 qualified as Api
import Prettyprinter ((<+>))
import Prettyprinter qualified as PP

instance (Show a) => PrettyCooked [MockChainReturn a] where
  prettyCookedOpt :: PrettyCookedOpts -> [MockChainReturn a] -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts = PrettyCookedOpts
-> DocCooked -> DocCooked -> [MockChainReturn a] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"Results:" DocCooked
"-"

instance (Show a) => PrettyCooked (MockChainReturn a) where
  prettyCookedOpt :: PrettyCookedOpts -> MockChainReturn a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts' (MockChainReturn Either MockChainError a
res Map TxOutRef (TxSkelOut, Bool)
outputs UtxoState
utxoState [MockChainLogEntry]
entries ((Map BuiltinByteString String
-> PrettyCookedOpts -> PrettyCookedOpts
`addHashNames` PrettyCookedOpts
opts') -> PrettyCookedOpts
opts)) =
    [DocCooked] -> DocCooked
forall ann. [Doc ann] -> Doc ann
PP.vsep ([DocCooked] -> DocCooked) -> [DocCooked] -> DocCooked
forall a b. (a -> b) -> a -> b
$
      [PrettyCookedOpts -> Contextualized [MockChainLogEntry] -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Map TxOutRef (TxSkelOut, Bool)
-> [MockChainLogEntry] -> Contextualized [MockChainLogEntry]
forall a. Map TxOutRef (TxSkelOut, Bool) -> a -> Contextualized a
Contextualized Map TxOutRef (TxSkelOut, Bool)
outputs [MockChainLogEntry]
entries) | PrettyCookedOpts -> Bool
pcOptPrintLog PrettyCookedOpts
opts]
        [DocCooked] -> [DocCooked] -> [DocCooked]
forall a. Semigroup a => a -> a -> a
<> PrettyCookedOpts -> UtxoState -> [DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts UtxoState
utxoState
        [DocCooked] -> [DocCooked] -> [DocCooked]
forall a. Semigroup a => a -> a -> a
<> [ case Either MockChainError a
res of
               Left MockChainError
err -> DocCooked
"🔴 Error:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> MockChainError -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts MockChainError
err
               Right a
a -> DocCooked
"🟢 Returned value:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> DocCooked
forall a ann. Show a => a -> Doc ann
PP.viaShow a
a
           ]

instance PrettyCooked MockChainError where
  prettyCookedOpt :: PrettyCookedOpts -> MockChainError -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (MCEValidationError ValidationPhase
plutusPhase ValidationError
plutusError) =
    [DocCooked] -> DocCooked
forall ann. [Doc ann] -> Doc ann
PP.vsep [DocCooked
"Validation error " DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> ValidationPhase -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts ValidationPhase
plutusPhase, Int -> DocCooked -> DocCooked
forall ann. Int -> Doc ann -> Doc ann
PP.indent Int
2 (PrettyCookedOpts -> ValidationError -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts ValidationError
plutusError)]
  prettyCookedOpt PrettyCookedOpts
_ (MCEMissingBalancingWallet String
msg) = DocCooked
"Missing balancing wallet:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty String
msg
  prettyCookedOpt PrettyCookedOpts
opts (MCEUnbalanceable Wallet
balWallet Value
missingValue) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      DocCooked
"Unbalanceable:"
      DocCooked
"-"
      [ PrettyCookedOpts -> Wallet -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Wallet
balWallet DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
"does not have enough funds",
        if Value
missingValue Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
forall a. Monoid a => a
mempty
          then DocCooked
"Not enough funds to sustain the minimal ada of the return utxo"
          else DocCooked
"Unable to find" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Value -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Value
missingValue
      ]
  prettyCookedOpt PrettyCookedOpts
opts (MCENoSuitableCollateral Integer
fee Integer
percentage Value
colVal) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      DocCooked
"No suitable collateral"
      DocCooked
"-"
      [ DocCooked
"Fee was" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Integer -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Integer
fee,
        DocCooked
"Percentage in params was" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Integer -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Integer
percentage,
        DocCooked
"Resulting minimal collateral value was" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Value -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Value
colVal
      ]
  prettyCookedOpt PrettyCookedOpts
opts (MCEToCardanoError String
msg ToCardanoError
cardanoError) =
    forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize @[DocCooked]
      PrettyCookedOpts
opts
      DocCooked
"Transaction generation error:"
      DocCooked
"-"
      [String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty String
msg, ToCardanoError -> DocCooked
forall a ann. Pretty a => a -> Doc ann
forall ann. ToCardanoError -> Doc ann
PP.pretty ToCardanoError
cardanoError]
  prettyCookedOpt PrettyCookedOpts
opts (MCEUnknownOutRef TxOutRef
txOutRef) = DocCooked
"Unknown transaction output ref:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> TxOutRef -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts TxOutRef
txOutRef
  prettyCookedOpt PrettyCookedOpts
opts (MCEWrongReferenceScriptError TxOutRef
oRef ScriptHash
expected Maybe ScriptHash
got) =
    DocCooked
"Unable to fetch the following reference script:"
      DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> ScriptHash -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts ScriptHash
expected
      DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
"in the following UTxO:"
      DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> TxOutRef -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts TxOutRef
oRef
      DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
"but instead got:"
      DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (case Maybe ScriptHash
got of Maybe ScriptHash
Nothing -> DocCooked
"none"; Just ScriptHash
sHash -> PrettyCookedOpts -> ScriptHash -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts ScriptHash
sHash)
  prettyCookedOpt PrettyCookedOpts
_ (MCEUnsupportedFeature String
feature) = DocCooked
"Unsupported feature:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty String
feature
  prettyCookedOpt PrettyCookedOpts
_ (MCEPastSlot Slot
current Slot
target) =
    DocCooked
"Unable to move back in time; current slot:"
      DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Slot -> DocCooked
forall a ann. Show a => a -> Doc ann
PP.viaShow Slot
current
      DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
"; target slot:"
      DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Slot -> DocCooked
forall a ann. Show a => a -> Doc ann
PP.viaShow Slot
target
  prettyCookedOpt PrettyCookedOpts
_ (FailWith String
msg) = DocCooked
"Failed with:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty String
msg

instance PrettyCooked (Contextualized [MockChainLogEntry]) where
  prettyCookedOpt :: PrettyCookedOpts -> Contextualized [MockChainLogEntry] -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Contextualized Map TxOutRef (TxSkelOut, Bool)
outputs [MockChainLogEntry]
entries) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"📖 MockChain run log:" DocCooked
"⁍" ((MockChainLogEntry -> DocCooked)
-> [MockChainLogEntry] -> [DocCooked]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrettyCookedOpts -> Contextualized MockChainLogEntry -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Contextualized MockChainLogEntry -> DocCooked)
-> (MockChainLogEntry -> Contextualized MockChainLogEntry)
-> MockChainLogEntry
-> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef (TxSkelOut, Bool)
-> MockChainLogEntry -> Contextualized MockChainLogEntry
forall a. Map TxOutRef (TxSkelOut, Bool) -> a -> Contextualized a
Contextualized Map TxOutRef (TxSkelOut, Bool)
outputs) [MockChainLogEntry]
entries)

-- | This prints a 'MockChainLogEntry'. In the log, we know a transaction has
-- been validated if the 'MCLogSubmittedTxSkel' is followed by a 'MCLogNewTx'.
instance PrettyCooked (Contextualized MockChainLogEntry) where
  prettyCookedOpt :: PrettyCookedOpts -> Contextualized MockChainLogEntry -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Contextualized Map TxOutRef (TxSkelOut, Bool)
_ (MCLogAdjustedTxSkelOut TxSkelOut
skelOut Lovelace
newAda)) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> TxSkelOut -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      (DocCooked
"New ADA adjustment of" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Value -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Lovelace -> Value
forall a. ToValue a => a -> Value
Script.toValue Lovelace
newAda) DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
"performed for output:")
      DocCooked
"-"
      TxSkelOut
skelOut
  prettyCookedOpt PrettyCookedOpts
opts (Contextualized Map TxOutRef (TxSkelOut, Bool)
outputs (MCLogSubmittedTxSkel TxSkel
skel)) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> Contextualized TxSkel -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      DocCooked
"New raw skeleton submitted to the adjustment pipeline:"
      DocCooked
"-"
      (Map TxOutRef (TxSkelOut, Bool) -> TxSkel -> Contextualized TxSkel
forall a. Map TxOutRef (TxSkelOut, Bool) -> a -> Contextualized a
Contextualized Map TxOutRef (TxSkelOut, Bool)
outputs TxSkel
skel)
  prettyCookedOpt PrettyCookedOpts
opts (Contextualized Map TxOutRef (TxSkelOut, Bool)
outputs (MCLogAdjustedTxSkel TxSkel
skel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals)) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      DocCooked
"New adjusted skeleton submitted for validation:"
      DocCooked
"-"
      ( PrettyCookedOpts -> Contextualized TxSkel -> [DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts (Map TxOutRef (TxSkelOut, Bool) -> TxSkel -> Contextualized TxSkel
forall a. Map TxOutRef (TxSkelOut, Bool) -> a -> Contextualized a
Contextualized Map TxOutRef (TxSkelOut, Bool)
outputs TxSkel
skel)
          [DocCooked] -> [DocCooked] -> [DocCooked]
forall a. [a] -> [a] -> [a]
++ ( (DocCooked
"Fee:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Value -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Integer -> Value
Script.lovelace Integer
fee))
                 DocCooked -> [DocCooked] -> [DocCooked]
forall a. a -> [a] -> [a]
: [DocCooked]
-> ((Set TxOutRef, Wallet) -> [DocCooked])
-> Maybe (Set TxOutRef, Wallet)
-> [DocCooked]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                   [DocCooked
"No collateral required"]
                   ( \(Set TxOutRef
collaterals, Wallet
returnWallet) ->
                       [ PrettyCookedOpts
-> DocCooked
-> DocCooked
-> [Contextualized CollateralInput]
-> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"Collateral inputs:" DocCooked
"-" (Map TxOutRef (TxSkelOut, Bool)
-> CollateralInput -> Contextualized CollateralInput
forall a. Map TxOutRef (TxSkelOut, Bool) -> a -> Contextualized a
Contextualized Map TxOutRef (TxSkelOut, Bool)
outputs (CollateralInput -> Contextualized CollateralInput)
-> (TxOutRef -> CollateralInput)
-> TxOutRef
-> Contextualized CollateralInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> CollateralInput
CollateralInput (TxOutRef -> Contextualized CollateralInput)
-> [TxOutRef] -> [Contextualized CollateralInput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Set TxOutRef
collaterals),
                         DocCooked
"Return collateral target:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Wallet -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Wallet
returnWallet
                       ]
                   )
                   Maybe (Set TxOutRef, Wallet)
mCollaterals
             )
      )
  prettyCookedOpt PrettyCookedOpts
opts (Contextualized Map TxOutRef (TxSkelOut, Bool)
_ (MCLogNewTx TxId
txId Integer
nb)) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      DocCooked
"New transaction successfully validated:"
      DocCooked
"-"
      [ DocCooked
"Transaction id:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> TxId -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts TxId
txId,
        DocCooked
"Number of new outputs:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> DocCooked
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty Integer
nb
      ]
  prettyCookedOpt PrettyCookedOpts
opts (Contextualized Map TxOutRef (TxSkelOut, Bool)
_ (MCLogDiscardedUtxos Integer
n String
s)) =
    forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize @[DocCooked]
      PrettyCookedOpts
opts
      DocCooked
"Warning:"
      DocCooked
"-"
      [ Integer -> DocCooked
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty Integer
n DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
"balancing UTxOs were discarded",
        String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty String
s
      ]
  prettyCookedOpt PrettyCookedOpts
opts (Contextualized Map TxOutRef (TxSkelOut, Bool)
_ (MCLogUnusedCollaterals Either Wallet (Set TxOutRef)
source)) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      DocCooked
"Warning"
      DocCooked
"-"
      [ DocCooked
"Request for using specific collateral inputs was disregarded",
        DocCooked
"Source:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (Wallet -> DocCooked)
-> (Set TxOutRef -> DocCooked)
-> Either Wallet (Set TxOutRef)
-> DocCooked
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PrettyCookedOpts -> Wallet -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts) ((DocCooked
"Given set of size" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (DocCooked -> DocCooked)
-> (Set TxOutRef -> DocCooked) -> Set TxOutRef -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DocCooked
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty (Int -> DocCooked)
-> (Set TxOutRef -> Int) -> Set TxOutRef -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TxOutRef -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) Either Wallet (Set TxOutRef)
source,
        DocCooked
"The transaction does not require any collateral"
      ]
  prettyCookedOpt PrettyCookedOpts
opts (Contextualized Map TxOutRef (TxSkelOut, Bool)
_ (MCLogAddedReferenceScript TxSkelRedeemer
red TxOutRef
oRef ScriptHash
sHash)) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      DocCooked
"New automated attachment of a reference script:"
      DocCooked
"-"
      ( [ DocCooked
"Input" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> TxOutRef -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts TxOutRef
oRef,
          DocCooked
"Script:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> ScriptHash -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts ScriptHash
sHash
        ]
          [DocCooked] -> [DocCooked] -> [DocCooked]
forall a. [a] -> [a] -> [a]
++ PrettyCookedOpts -> TxSkelRedeemer -> [DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts TxSkelRedeemer
red
      )

instance PrettyCookedList UtxoState where
  prettyCookedOptList :: PrettyCookedOpts -> UtxoState -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts (UtxoState Map Address UtxoPayloadSet
available Map Address UtxoPayloadSet
consumed) =
    DocCooked
"✅" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Map Address UtxoPayloadSet -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Map Address UtxoPayloadSet
available DocCooked -> [DocCooked] -> [DocCooked]
forall a. a -> [a] -> [a]
: [DocCooked
"❎" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Map Address UtxoPayloadSet -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Map Address UtxoPayloadSet
consumed | PrettyCookedOpts -> Bool
pcOptPrintConsumedUTxOs PrettyCookedOpts
opts]

-- | Pretty print a 'UtxoState'. Print the known wallets first, then unknown
-- pubkeys, then scripts.
instance PrettyCooked (Map Api.Address UtxoPayloadSet) where
  prettyCookedOpt :: PrettyCookedOpts -> Map Address UtxoPayloadSet -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"UTxO state:" DocCooked
"•"
      ([DocCooked] -> DocCooked)
-> (Map Address UtxoPayloadSet -> [DocCooked])
-> Map Address UtxoPayloadSet
-> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Address, UtxoPayloadSet) -> DocCooked)
-> [(Address, UtxoPayloadSet)] -> [DocCooked]
forall a b. (a -> b) -> [a] -> [b]
map (\(Address
addr, UtxoPayloadSet
plSet) -> PrettyCookedOpts
-> DocCooked -> DocCooked -> UtxoPayloadSet -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts (PrettyCookedOpts -> Address -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Address
addr) DocCooked
"-" UtxoPayloadSet
plSet)
      ([(Address, UtxoPayloadSet)] -> [DocCooked])
-> (Map Address UtxoPayloadSet -> [(Address, UtxoPayloadSet)])
-> Map Address UtxoPayloadSet
-> [DocCooked]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Address, UtxoPayloadSet)
 -> (Address, UtxoPayloadSet) -> Ordering)
-> [(Address, UtxoPayloadSet)] -> [(Address, UtxoPayloadSet)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (Address, UtxoPayloadSet) -> (Address, UtxoPayloadSet) -> Ordering
forall a. (Address, a) -> (Address, a) -> Ordering
addressOrdering
      ([(Address, UtxoPayloadSet)] -> [(Address, UtxoPayloadSet)])
-> (Map Address UtxoPayloadSet -> [(Address, UtxoPayloadSet)])
-> Map Address UtxoPayloadSet
-> [(Address, UtxoPayloadSet)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Address UtxoPayloadSet -> [(Address, UtxoPayloadSet)]
forall k a. Map k a -> [(k, a)]
Map.toList
    where
      addressOrdering :: (Api.Address, a) -> (Api.Address, a) -> Ordering
      addressOrdering :: forall a. (Address, a) -> (Address, a) -> Ordering
addressOrdering
        (a1 :: Address
a1@(Api.Address (Api.PubKeyCredential PubKeyHash
pkh1) Maybe StakingCredential
_), a
_)
        (a2 :: Address
a2@(Api.Address (Api.PubKeyCredential PubKeyHash
pkh2) Maybe StakingCredential
_), a
_) =
          case (PubKeyHash -> Maybe Int
walletPKHashToId PubKeyHash
pkh1, PubKeyHash -> Maybe Int
walletPKHashToId PubKeyHash
pkh2) of
            (Just Int
i, Just Int
j) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
            (Just Int
_, Maybe Int
Nothing) -> Ordering
LT
            (Maybe Int
Nothing, Just Int
_) -> Ordering
GT
            (Maybe Int
Nothing, Maybe Int
Nothing) -> Address -> Address -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Address
a1 Address
a2
      addressOrdering
        (Api.Address (Api.PubKeyCredential PubKeyHash
_) Maybe StakingCredential
_, a
_)
        (Api.Address (Api.ScriptCredential ScriptHash
_) Maybe StakingCredential
_, a
_) = Ordering
LT
      addressOrdering (Address
a1, a
_) (Address
a2, a
_) = Address -> Address -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Address
a1 Address
a2

-- | Pretty prints the state of an address, that is the list of UTxOs (including
-- value and datum), grouped
instance PrettyCookedList UtxoPayloadSet where
  prettyCookedOptListMaybe :: PrettyCookedOpts -> UtxoPayloadSet -> [Maybe DocCooked]
prettyCookedOptListMaybe PrettyCookedOpts
opts =
    ([UtxoPayload] -> Maybe DocCooked
prettyPayloadGrouped ([UtxoPayload] -> Maybe DocCooked)
-> [[UtxoPayload]] -> [Maybe DocCooked]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
      ([[UtxoPayload]] -> [Maybe DocCooked])
-> (UtxoPayloadSet -> [[UtxoPayload]])
-> UtxoPayloadSet
-> [Maybe DocCooked]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UtxoPayload] -> [[UtxoPayload]]
group
      ([UtxoPayload] -> [[UtxoPayload]])
-> (UtxoPayloadSet -> [UtxoPayload])
-> UtxoPayloadSet
-> [[UtxoPayload]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoPayload -> UtxoPayload -> Ordering)
-> [UtxoPayload] -> [UtxoPayload]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (Lovelace -> Lovelace -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Lovelace -> Lovelace -> Ordering)
-> (UtxoPayload -> Lovelace)
-> UtxoPayload
-> UtxoPayload
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Value -> Lovelace
Api.lovelaceValueOf (Value -> Lovelace)
-> (UtxoPayload -> Value) -> UtxoPayload -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoPayload -> Value
utxoPayloadValue))
      ([UtxoPayload] -> [UtxoPayload])
-> (UtxoPayloadSet -> [UtxoPayload])
-> UtxoPayloadSet
-> [UtxoPayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoPayloadSet -> [UtxoPayload]
utxoPayloadSet
    where
      similar :: UtxoPayload -> UtxoPayload -> Bool
      similar :: UtxoPayload -> UtxoPayload -> Bool
similar
        (UtxoPayload TxOutRef
_ Value
value1 Maybe (DatumContent, Bool)
skelOutDatum1 Maybe ScriptHash
refScript1)
        (UtxoPayload TxOutRef
_ Value
value2 Maybe (DatumContent, Bool)
skelOutDatum2 Maybe ScriptHash
refScript2) =
          Value
value1 Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
value2
            Bool -> Bool -> Bool
&& Maybe (DatumContent, Bool)
skelOutDatum1 Maybe (DatumContent, Bool) -> Maybe (DatumContent, Bool) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (DatumContent, Bool)
skelOutDatum2
            Bool -> Bool -> Bool
&& Maybe ScriptHash
refScript1 Maybe ScriptHash -> Maybe ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ScriptHash
refScript2

      group :: [UtxoPayload] -> [[UtxoPayload]]
      group :: [UtxoPayload] -> [[UtxoPayload]]
group =
        case PrettyCookedOpts -> PCOptTxOutRefs
pcOptPrintTxOutRefs PrettyCookedOpts
opts of
          PCOptTxOutRefs
PCOptTxOutRefsFull -> (UtxoPayload -> [UtxoPayload]) -> [UtxoPayload] -> [[UtxoPayload]]
forall a b. (a -> b) -> [a] -> [b]
map (UtxoPayload -> [UtxoPayload] -> [UtxoPayload]
forall a. a -> [a] -> [a]
: [])
          PCOptTxOutRefs
_ -> (UtxoPayload -> UtxoPayload -> Bool)
-> [UtxoPayload] -> [[UtxoPayload]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy UtxoPayload -> UtxoPayload -> Bool
similar

      -- Pretty prints payloads (datum and value corresponding to 1 UTxO)
      -- grouped together when they carry same value and datum
      prettyPayloadGrouped :: [UtxoPayload] -> Maybe DocCooked
      prettyPayloadGrouped :: [UtxoPayload] -> Maybe DocCooked
prettyPayloadGrouped [] = Maybe DocCooked
forall a. Maybe a
Nothing
      prettyPayloadGrouped [UtxoPayload
payload] = Bool -> UtxoPayload -> Maybe DocCooked
prettyPayload (PrettyCookedOpts -> PCOptTxOutRefs
pcOptPrintTxOutRefs PrettyCookedOpts
opts PCOptTxOutRefs -> PCOptTxOutRefs -> Bool
forall a. Eq a => a -> a -> Bool
/= PCOptTxOutRefs
PCOptTxOutRefsHidden) UtxoPayload
payload
      prettyPayloadGrouped (UtxoPayload
payload : [UtxoPayload]
rest) =
        (DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann
PP.parens (DocCooked
"×" DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> PrettyCookedOpts -> Int -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [UtxoPayload] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UtxoPayload]
rest)) DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+>)
          (DocCooked -> DocCooked) -> Maybe DocCooked -> Maybe DocCooked
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> UtxoPayload -> Maybe DocCooked
prettyPayload Bool
False UtxoPayload
payload

      -- Optionally prints a 'UtxoPayload' with an option piloting whether
      -- 'Api.TxOutRef's should be shown.
      prettyPayload :: Bool -> UtxoPayload -> Maybe DocCooked
      prettyPayload :: Bool -> UtxoPayload -> Maybe DocCooked
prettyPayload Bool
showTxOutRef UtxoPayload {Maybe (DatumContent, Bool)
Maybe ScriptHash
TxOutRef
Value
utxoPayloadValue :: UtxoPayload -> Value
utxoPayloadTxOutRef :: TxOutRef
utxoPayloadValue :: Value
utxoPayloadDatum :: Maybe (DatumContent, Bool)
utxoPayloadReferenceScript :: Maybe ScriptHash
utxoPayloadTxOutRef :: UtxoPayload -> TxOutRef
utxoPayloadDatum :: UtxoPayload -> Maybe (DatumContent, Bool)
utxoPayloadReferenceScript :: UtxoPayload -> Maybe ScriptHash
..} =
        case [Maybe DocCooked] -> [DocCooked]
forall a. [Maybe a] -> [a]
catMaybes
          [ if Bool
showTxOutRef
              then DocCooked -> Maybe DocCooked
forall a. a -> Maybe a
Just (DocCooked -> Maybe DocCooked) -> DocCooked -> Maybe DocCooked
forall a b. (a -> b) -> a -> b
$ PrettyCookedOpts -> TxOutRef -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts TxOutRef
utxoPayloadTxOutRef
              else Maybe DocCooked
forall a. Maybe a
Nothing,
            DocCooked -> Maybe DocCooked
forall a. a -> Maybe a
Just (PrettyCookedOpts -> Value -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Value
utxoPayloadValue),
            (\(DatumContent
dat, Bool
hashed) -> DocCooked
"Datum (" DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> (if Bool
hashed then DocCooked
"hashed" else DocCooked
"inline") DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
"):" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> DatumContent -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts DatumContent
dat) ((DatumContent, Bool) -> DocCooked)
-> Maybe (DatumContent, Bool) -> Maybe DocCooked
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (DatumContent, Bool)
utxoPayloadDatum,
            (DocCooked
"Reference script hash:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (DocCooked -> DocCooked)
-> (ScriptHash -> DocCooked) -> ScriptHash -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyCookedOpts -> ScriptHash -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts (ScriptHash -> DocCooked) -> Maybe ScriptHash -> Maybe DocCooked
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScriptHash
utxoPayloadReferenceScript
          ] of
          [] -> Maybe DocCooked
forall a. Maybe a
Nothing
          [DocCooked
doc] -> DocCooked -> Maybe DocCooked
forall a. a -> Maybe a
Just (DocCooked -> Maybe DocCooked) -> DocCooked -> Maybe DocCooked
forall a b. (a -> b) -> a -> b
$ DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann
PP.align DocCooked
doc
          [DocCooked]
docs -> DocCooked -> Maybe DocCooked
forall a. a -> Maybe a
Just (DocCooked -> Maybe DocCooked)
-> ([DocCooked] -> DocCooked) -> [DocCooked] -> Maybe DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann
PP.align (DocCooked -> DocCooked)
-> ([DocCooked] -> DocCooked) -> [DocCooked] -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DocCooked] -> DocCooked
forall ann. [Doc ann] -> Doc ann
PP.vsep ([DocCooked] -> Maybe DocCooked) -> [DocCooked] -> Maybe DocCooked
forall a b. (a -> b) -> a -> b
$ [DocCooked]
docs

newtype CollateralInput = CollateralInput {CollateralInput -> TxOutRef
unCollateralInput :: Api.TxOutRef}

instance PrettyCooked (Contextualized CollateralInput) where
  prettyCookedOpt :: PrettyCookedOpts -> Contextualized CollateralInput -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts cColIn :: Contextualized CollateralInput
cColIn@(Contextualized Map TxOutRef (TxSkelOut, Bool)
_ (CollateralInput TxOutRef
txOutRef)) =
    case PrettyCookedOpts -> Contextualized TxOutRef -> [DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts (CollateralInput -> TxOutRef
unCollateralInput (CollateralInput -> TxOutRef)
-> Contextualized CollateralInput -> Contextualized TxOutRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Contextualized CollateralInput
cColIn) of
      (DocCooked
addressDoc : [DocCooked]
otherDocs) ->
        PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
          PrettyCookedOpts
opts
          ( DocCooked
"Uses"
              DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> TxOutRef -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts TxOutRef
txOutRef
              DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
"belonging to"
              DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
addressDoc
          )
          DocCooked
"-"
          [DocCooked]
otherDocs
      [DocCooked]
_ -> DocCooked
"Uses" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> TxOutRef -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts TxOutRef
txOutRef DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
"(non resolved)"