{-# 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 qualified as Map
import Data.Maybe (catMaybes, fromMaybe)
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 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)]
  -- Here we don't print the skel because we lack its context and this error is
  -- printed alongside the skeleton when a test fails
  prettyCookedOpt PrettyCookedOpts
opts (MCEUnbalanceable Wallet
balWallet Value
missingValue TxSkel
_) =
    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 (MCEGenerationError (ToCardanoError 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 (MCEGenerationError (GenerateTxErrorGeneral String
msgs)) =
    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
msgs]
  prettyCookedOpt PrettyCookedOpts
opts (MCEGenerationError (TxBodyError String
msg TxBodyError
err)) =
    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, TxBodyError -> DocCooked
forall a ann. Show a => a -> Doc ann
PP.viaShow TxBodyError
err]
  prettyCookedOpt PrettyCookedOpts
opts (MCEUnknownOutRefError String
msg TxOutRef
txOutRef) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"Unknown transaction output ref:" DocCooked
"-" [String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty String
msg, PrettyCookedOpts -> TxOutRef -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts TxOutRef
txOutRef]
  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
  prettyCookedOpt PrettyCookedOpts
opts (MCEUnknownValidator String
msg ValidatorHash
valHash) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      DocCooked
"Unknown validator hash:"
      DocCooked
"-"
      [String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty String
msg, DocCooked
"hash:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> ValidatorHash -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts ValidatorHash
valHash]
  prettyCookedOpt PrettyCookedOpts
opts (MCEUnknownDatum String
msg DatumHash
dHash) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      DocCooked
"Unknown datum hash:"
      DocCooked
"-"
      [String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty String
msg, DocCooked
"hash:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> DatumHash -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts DatumHash
dHash]

instance (Show a) => PrettyCooked (a, UtxoState) where
  prettyCookedOpt :: PrettyCookedOpts -> (a, UtxoState) -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (a
res, UtxoState
state) =
    PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize
      PrettyCookedOpts
opts
      DocCooked
"End state:"
      DocCooked
"-"
      [DocCooked
"Returns:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> DocCooked
forall a ann. Show a => a -> Doc ann
PP.viaShow a
res, PrettyCookedOpts -> UtxoState -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts UtxoState
state]

instance (Show a) => PrettyCooked (MockChainReturn a UtxoState) where
  prettyCookedOpt :: PrettyCookedOpts -> MockChainReturn a UtxoState -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts' (Either MockChainError (a, UtxoState)
res, MockChainBook [MockChainLogEntry]
entries ((Map BuiltinByteString String
-> PrettyCookedOpts -> PrettyCookedOpts
`addHashNames` PrettyCookedOpts
opts') -> PrettyCookedOpts
opts)) =
    let mcEndResult :: DocCooked
mcEndResult = case Either MockChainError (a, UtxoState)
res of
          Left MockChainError
err -> DocCooked
"🔴" 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, UtxoState
s) -> DocCooked
"🟢" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> (a, UtxoState) -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (a
a, UtxoState
s)
     in [DocCooked] -> DocCooked
forall ann. [Doc ann] -> Doc ann
PP.vsep ([DocCooked] -> DocCooked) -> [DocCooked] -> DocCooked
forall a b. (a -> b) -> a -> b
$ if PrettyCookedOpts -> Bool
pcOptPrintLog PrettyCookedOpts
opts then [PrettyCookedOpts -> [MockChainLogEntry] -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts [MockChainLogEntry]
entries, DocCooked
mcEndResult] else [DocCooked
mcEndResult]

instance PrettyCooked [MockChainLogEntry] where
  prettyCookedOpt :: PrettyCookedOpts -> [MockChainLogEntry] -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts = (DocCooked
"📘" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (DocCooked -> DocCooked)
-> ([MockChainLogEntry] -> DocCooked)
-> [MockChainLogEntry]
-> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyCookedOpts
-> DocCooked -> DocCooked -> [MockChainLogEntry] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"MockChain run log:" DocCooked
"⁍"

-- | This prints a 'MockChainLogEntry'. In the log, we know a transaction has
-- been validated if the 'MCLogSubmittedTxSkel' is followed by a 'MCLogNewTx'.
instance PrettyCooked MockChainLogEntry where
  prettyCookedOpt :: PrettyCookedOpts -> MockChainLogEntry -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (MCLogAdjustedTxSkelOut TxSkelOut
skelOut Lovelace
newAda) =
    DocCooked
"The ADA amount of "
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> PrettyCookedOpts -> TxSkelOut -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts TxSkelOut
skelOut
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
" has been automatically adjusted to "
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> 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)
  prettyCookedOpt PrettyCookedOpts
opts (MCLogSubmittedTxSkel Map TxOutRef TxOut
outputs Map DatumHash TxSkelOutDatum
datums TxSkel
skel) = PrettyCookedOpts
-> DocCooked -> DocCooked -> Contextualized TxSkel -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"Submitted skeleton:" DocCooked
"-" (Contextualized TxSkel -> DocCooked)
-> Contextualized TxSkel -> DocCooked
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxOut
-> Map DatumHash TxSkelOutDatum -> TxSkel -> Contextualized TxSkel
forall a.
Map TxOutRef TxOut
-> Map DatumHash TxSkelOutDatum -> a -> Contextualized a
Contextualized Map TxOutRef TxOut
outputs Map DatumHash TxSkelOutDatum
datums TxSkel
skel
  prettyCookedOpt PrettyCookedOpts
opts (MCLogAdjustedTxSkel Map TxOutRef TxOut
outputs Map DatumHash TxSkelOutDatum
datums TxSkel
skel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals) =
    let mCollateralsDoc :: Maybe [DocCooked]
mCollateralsDoc =
          ( \(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 TxOut
-> Map DatumHash TxSkelOutDatum
-> CollateralInput
-> Contextualized CollateralInput
forall a.
Map TxOutRef TxOut
-> Map DatumHash TxSkelOutDatum -> a -> Contextualized a
Contextualized Map TxOutRef TxOut
outputs Map DatumHash TxSkelOutDatum
datums (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
              ]
          )
            ((Set TxOutRef, Wallet) -> [DocCooked])
-> Maybe (Set TxOutRef, Wallet) -> Maybe [DocCooked]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Set TxOutRef, Wallet)
mCollaterals
     in PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"Adjusted skeleton:" DocCooked
"-" ([DocCooked] -> DocCooked) -> [DocCooked] -> DocCooked
forall a b. (a -> b) -> a -> b
$
          PrettyCookedOpts -> Contextualized TxSkel -> [DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts (Map TxOutRef TxOut
-> Map DatumHash TxSkelOutDatum -> TxSkel -> Contextualized TxSkel
forall a.
Map TxOutRef TxOut
-> Map DatumHash TxSkelOutDatum -> a -> Contextualized a
Contextualized Map TxOutRef TxOut
outputs Map DatumHash TxSkelOutDatum
datums 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] -> Maybe [DocCooked] -> [DocCooked]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [DocCooked]
mCollateralsDoc)
  prettyCookedOpt PrettyCookedOpts
opts (MCLogNewTx TxId
txId) = DocCooked
"New transaction:" 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
  prettyCookedOpt PrettyCookedOpts
opts (MCLogDiscardedUtxos Integer
n String
s) = PrettyCookedOpts -> Integer -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Integer
n DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
"balancing utxos were discarded:" 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
s
  prettyCookedOpt PrettyCookedOpts
opts (MCLogUnusedCollaterals (Left Wallet
cWallet)) =
    DocCooked
"Specific request to fetch collateral utxos from "
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> PrettyCookedOpts -> Wallet -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Wallet
cWallet
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
" has been disregarded because the transaction does not require collaterals"
  prettyCookedOpt PrettyCookedOpts
opts (MCLogUnusedCollaterals (Right (Set TxOutRef -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Int
n))) =
    DocCooked
"Specific request to fetch collateral utxos from the given set of "
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> PrettyCookedOpts -> Int -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Int
n
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
" elements has been disregarded because the transaction does not require collaterals"
  prettyCookedOpt PrettyCookedOpts
opts (MCLogAddedReferenceScript TxSkelRedeemer
red TxOutRef
oRef ScriptHash
sHash) =
    DocCooked
"A reference script located in "
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> PrettyCookedOpts -> TxOutRef -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts TxOutRef
oRef
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
" has been automatically associated to redeemer "
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> PrettyCookedOpts -> DocCooked -> TxSkelRedeemer -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> a -> DocCooked
prettyItemizeNoTitle PrettyCookedOpts
opts DocCooked
"-" TxSkelRedeemer
red
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
" for script "
      DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> PrettyCookedOpts -> ScriptHash -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts ScriptHash
sHash

-- | Pretty print a 'UtxoState'. Print the known wallets first, then unknown
-- pubkeys, then scripts.
instance PrettyCooked UtxoState where
  prettyCookedOpt :: PrettyCookedOpts -> UtxoState -> 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)
-> (UtxoState -> [DocCooked]) -> UtxoState -> 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])
-> (UtxoState -> [(Address, UtxoPayloadSet)])
-> UtxoState
-> [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)])
-> (UtxoState -> [(Address, UtxoPayloadSet)])
-> UtxoState
-> [(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
      (Map Address UtxoPayloadSet -> [(Address, UtxoPayloadSet)])
-> (UtxoState -> Map Address UtxoPayloadSet)
-> UtxoState
-> [(Address, UtxoPayloadSet)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoState -> Map Address UtxoPayloadSet
utxoState
    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 TxSkelOutDatum
skelOutDatum1 Maybe ScriptHash
refScript1)
        (UtxoPayload TxOutRef
_ Value
value2 TxSkelOutDatum
skelOutDatum2 Maybe ScriptHash
refScript2) =
          Value
value1 Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
value2
            Bool -> Bool -> Bool
&& TxSkelOutDatum
skelOutDatum1 TxSkelOutDatum -> TxSkelOutDatum -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkelOutDatum
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 ScriptHash
TxOutRef
Value
TxSkelOutDatum
utxoPayloadValue :: UtxoPayload -> Value
utxoPayloadTxOutRef :: TxOutRef
utxoPayloadValue :: Value
utxoPayloadSkelOutDatum :: TxSkelOutDatum
utxoPayloadReferenceScript :: Maybe ScriptHash
utxoPayloadTxOutRef :: UtxoPayload -> TxOutRef
utxoPayloadSkelOutDatum :: UtxoPayload -> TxSkelOutDatum
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),
            PrettyCookedOpts -> TxSkelOutDatum -> Maybe DocCooked
forall a.
PrettyCookedMaybe a =>
PrettyCookedOpts -> a -> Maybe DocCooked
prettyCookedOptMaybe PrettyCookedOpts
opts TxSkelOutDatum
utxoPayloadSkelOutDatum,
            (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 TxOut
_ Map DatumHash TxSkelOutDatum
_ (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
valueDoc : [DocCooked]
otherDocs) ->
        PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts (DocCooked
"Belonging to" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
addressDoc) DocCooked
"-" (DocCooked
valueDoc DocCooked -> [DocCooked] -> [DocCooked]
forall a. a -> [a] -> [a]
: [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)"