{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module provides 'PrettyCooked' instances of plutus types
module Cooked.Pretty.Plutus where

import Cooked.Pretty.Class
import Ledger.Index qualified as Ledger
import Ledger.Scripts qualified as Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger
import PlutusLedgerApi.V1.Value qualified as Api
import PlutusLedgerApi.V3 qualified as Api
import Prettyprinter ((<+>))
import Prettyprinter qualified as PP

-- * Pretty instances for data types coming from plutus-ledger-api

instance PrettyCooked Api.BuiltinData where
  prettyCookedOpt :: PrettyCookedOpts -> BuiltinData -> DocCooked
prettyCookedOpt PrettyCookedOpts
_ = BuiltinData -> DocCooked
forall a ann. Pretty a => a -> Doc ann
forall ann. BuiltinData -> Doc ann
PP.pretty

instance PrettyCooked Api.TxOutRef where
  prettyCookedOpt :: PrettyCookedOpts -> TxOutRef -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Api.TxOutRef TxId
txId Integer
index) =
    PrettyCookedOpts -> TxId -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts TxId
txId DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
"!" DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> PrettyCookedOpts -> Integer -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Integer
index

instance PrettyCooked Api.Address where
  prettyCookedOpt :: PrettyCookedOpts -> Address -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Api.Address Credential
addrCr Maybe StakingCredential
Nothing) = PrettyCookedOpts -> Credential -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Credential
addrCr
  prettyCookedOpt PrettyCookedOpts
opts (Api.Address Credential
addrCr (Just (Api.StakingHash Credential
stakCr))) =
    PrettyCookedOpts -> Credential -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Credential
addrCr DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann
PP.angles (DocCooked
"staking:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Credential -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Credential
stakCr)
  prettyCookedOpt PrettyCookedOpts
opts (Api.Address Credential
addrCr (Just (Api.StakingPtr Integer
p1 Integer
p2 Integer
p3))) =
    PrettyCookedOpts -> Credential -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Credential
addrCr DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann
PP.angles (DocCooked
"staking:" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (Integer, Integer, Integer) -> DocCooked
forall ann. (Integer, Integer, Integer) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty (Integer
p1, Integer
p2, Integer
p3))

instance PrettyCooked Api.Credential where
  prettyCookedOpt :: PrettyCookedOpts -> Credential -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Api.ScriptCredential ScriptHash
vh) = 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
vh
  prettyCookedOpt PrettyCookedOpts
opts (Api.PubKeyCredential PubKeyHash
pkh) = DocCooked
"pubkey" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> PubKeyHash -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts PubKeyHash
pkh

instance PrettyCooked Api.Value where
  -- Example output:
  --
  -- > Value:
  -- >   - Lovelace: 45_000_000
  -- >   - Quick "hello": 3
  -- >   - #12bc3d "usertoken": 1
  --
  -- In case of an empty value (even though not an empty map):
  -- > Empty value
  prettyCookedOpt :: PrettyCookedOpts -> Value -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts =
    [DocCooked] -> DocCooked
prettySingletons
      ([DocCooked] -> DocCooked)
-> (Value -> [DocCooked]) -> Value -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CurrencySymbol, TokenName, Integer) -> DocCooked)
-> [(CurrencySymbol, TokenName, Integer)] -> [DocCooked]
forall a b. (a -> b) -> [a] -> [b]
map (CurrencySymbol, TokenName, Integer) -> DocCooked
prettySingletonValue
      ([(CurrencySymbol, TokenName, Integer)] -> [DocCooked])
-> (Value -> [(CurrencySymbol, TokenName, Integer)])
-> Value
-> [DocCooked]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CurrencySymbol, TokenName, Integer) -> Bool)
-> [(CurrencySymbol, TokenName, Integer)]
-> [(CurrencySymbol, TokenName, Integer)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CurrencySymbol
_, TokenName
_, Integer
n) -> Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)
      ([(CurrencySymbol, TokenName, Integer)]
 -> [(CurrencySymbol, TokenName, Integer)])
-> (Value -> [(CurrencySymbol, TokenName, Integer)])
-> Value
-> [(CurrencySymbol, TokenName, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [(CurrencySymbol, TokenName, Integer)]
Api.flattenValue
    where
      prettySingletons :: [DocCooked] -> DocCooked
      prettySingletons :: [DocCooked] -> DocCooked
prettySingletons [] = DocCooked
"Empty value"
      prettySingletons [DocCooked
doc] = DocCooked
doc
      prettySingletons [DocCooked]
docs = PrettyCookedOpts
-> DocCooked -> DocCooked -> [DocCooked] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"Value:" DocCooked
"-" [DocCooked]
docs
      prettySingletonValue :: (Api.CurrencySymbol, Api.TokenName, Integer) -> DocCooked
      prettySingletonValue :: (CurrencySymbol, TokenName, Integer) -> DocCooked
prettySingletonValue (CurrencySymbol
symbol, TokenName
name, Integer
amount) =
        PrettyCookedOpts -> AssetClass -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts ((CurrencySymbol, TokenName) -> AssetClass
Api.AssetClass (CurrencySymbol
symbol, TokenName
name)) DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
":" 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
amount

instance PrettyCooked Api.AssetClass where
  prettyCookedOpt :: PrettyCookedOpts -> AssetClass -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Api.AssetClass (CurrencySymbol
symbol, TokenName
_)) | CurrencySymbol
symbol CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CurrencySymbol
Api.adaSymbol = PrettyCookedOpts -> CurrencySymbol -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts CurrencySymbol
symbol
  prettyCookedOpt PrettyCookedOpts
opts (Api.AssetClass (CurrencySymbol
symbol, TokenName
name)) = PrettyCookedOpts -> CurrencySymbol -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts CurrencySymbol
symbol DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> TokenName -> DocCooked
forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash PrettyCookedOpts
opts TokenName
name

instance PrettyCooked Api.POSIXTime where
  prettyCookedOpt :: PrettyCookedOpts -> POSIXTime -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Api.POSIXTime Integer
n) = DocCooked
"POSIXTime" 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
n

-- * Pretty instances for evalution error coming from plutus-ledger

instance PrettyCooked Ledger.ValidationPhase where
  prettyCookedOpt :: PrettyCookedOpts -> ValidationPhase -> DocCooked
prettyCookedOpt PrettyCookedOpts
_ ValidationPhase
Ledger.Phase1 = DocCooked
"Phase 1"
  prettyCookedOpt PrettyCookedOpts
_ ValidationPhase
Ledger.Phase2 = DocCooked
"Phase 2"

instance PrettyCooked Ledger.ValidationError where
  prettyCookedOpt :: PrettyCookedOpts -> ValidationError -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Ledger.TxOutRefNotFound TxIn
txIn) = DocCooked
"TxOutRef not found" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> TxOutRef -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (TxIn -> TxOutRef
Ledger.fromCardanoTxIn TxIn
txIn)
  prettyCookedOpt PrettyCookedOpts
opts (Ledger.ScriptFailure ScriptError
scriptError) = DocCooked
"Script failure" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> ScriptError -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts ScriptError
scriptError
  prettyCookedOpt PrettyCookedOpts
_ (Ledger.CardanoLedgerValidationError Text
text) = DocCooked
"Cardano ledger validation error " DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> DocCooked
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty Text
text
  prettyCookedOpt PrettyCookedOpts
_ ValidationError
Ledger.MaxCollateralInputsExceeded = DocCooked
"Max collateral inputs exceeded"

instance PrettyCooked Ledger.ScriptError where
  prettyCookedOpt :: PrettyCookedOpts -> ScriptError -> DocCooked
prettyCookedOpt PrettyCookedOpts
_ (Ledger.EvaluationError [Text]
text String
string) = DocCooked
"Evaluation error" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Text] -> DocCooked
forall ann. [Text] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty [Text]
text 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
string
  prettyCookedOpt PrettyCookedOpts
_ (Ledger.EvaluationException String
string1 String
string2) = DocCooked
"Evaluation exception" 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
string1 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
string2