Skip to content

Commit

Permalink
Pretty-print value in balancing logs
Browse files Browse the repository at this point in the history
  • Loading branch information
klntsky committed Sep 20, 2023
1 parent bc82c39 commit 996934e
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 13 deletions.
23 changes: 11 additions & 12 deletions src/Internal/BalanceTx/BalanceTx.purs
Original file line number Diff line number Diff line change
Expand Up @@ -119,6 +119,7 @@ import Ctl.Internal.Cardano.Types.Value
, minus
, mkValue
, posNonAdaAsset
, pprintValue
, valueToCoin'
)
import Ctl.Internal.Cardano.Types.Value as Value
Expand Down Expand Up @@ -158,9 +159,10 @@ import Data.BigInt (BigInt)
import Data.Either (Either, hush, note)
import Data.Foldable (fold, foldMap, foldr, length, null, sum)
import Data.Function (on)
import Data.Lens ((%~), (.~), (?~), (^.))
import Data.Log.Tag (TagSet)
import Data.Log.Tag (fromArray, tag) as TagSet
import Data.Lens.Getter ((^.))
import Data.Lens.Setter ((%~), (.~), (?~))
import Data.Log.Tag (TagSet, tag)
import Data.Log.Tag (fromArray) as TagSet
import Data.Map (Map)
import Data.Map (empty, insert, lookup, toUnfoldable, union) as Map
import Data.Maybe (Maybe(Just, Nothing), fromMaybe, isJust, maybe)
Expand Down Expand Up @@ -871,23 +873,20 @@ logTransactionWithChange message utxos mChangeOutputs tx =
txBody :: TxBody
txBody = tx ^. _body

tag :: forall (a :: Type). Show a => String -> a -> TagSet
tag title = TagSet.tag title <<< show

outputValuesTagSet :: Maybe (Array TransactionOutput) -> Array TagSet
outputValuesTagSet Nothing =
[ "Output Value" `tag` outputValue txBody ]
[ "Output Value" `tag` pprintValue (outputValue txBody) ]
outputValuesTagSet (Just changeOutputs) =
[ "Output Value without change" `tag` outputValue txBody
, "Change Value" `tag` foldMap getAmount changeOutputs
[ "Output Value without change" `tag` pprintValue (outputValue txBody)
, "Change Value" `tag` pprintValue (foldMap getAmount changeOutputs)
]

transactionInfo :: Value -> TagSet
transactionInfo inputValue =
TagSet.fromArray $
[ "Input Value" `tag` inputValue
, "Mint Value" `tag` mintValue txBody
, "Fees" `tag` (txBody ^. _fee)
[ "Input Value" `tag` pprintValue inputValue
, "Mint Value" `tag` pprintValue (mintValue txBody)
, "Fees" `tag` show (txBody ^. _fee)
] <> outputValuesTagSet mChangeOutputs
in
except (getInputValue utxos txBody)
Expand Down
20 changes: 19 additions & 1 deletion src/Internal/Cardano/Types/Value.purs
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,8 @@ module Ctl.Internal.Cardano.Types.Value
, numNonAdaCurrencySymbols
, numTokenNames
, posNonAdaAsset
, pprintNonAdaAsset
, pprintValue
, scriptHashAsCurrencySymbol
, split
, sumTokenNameLengths
Expand Down Expand Up @@ -90,16 +92,18 @@ import Ctl.Internal.Types.Scripts (MintingPolicyHash(MintingPolicyHash))
import Ctl.Internal.Types.TokenName
( TokenName
, adaToken
, fromTokenName
, getTokenName
, mkTokenName
, mkTokenNames
)
import Data.Array (cons, filter)
import Data.Array (cons, filter, intercalate)
import Data.Array (fromFoldable) as Array
import Data.Array.NonEmpty (NonEmptyArray)
import Data.Array.NonEmpty (replicate, singleton, zipWith) as NEArray
import Data.Bifunctor (bimap)
import Data.BigInt (BigInt, fromInt, toNumber)
import Data.BigInt as BigInt
import Data.Bitraversable (bitraverse, ltraverse)
import Data.Either (Either(Left), note)
import Data.Foldable (any, fold, foldl, length)
Expand Down Expand Up @@ -338,6 +342,15 @@ instance Equipartition NonAdaAsset where
map (mkSingletonNonAdaAsset cs tn)
(equipartition tokenQuantity numParts)

pprintNonAdaAsset :: NonAdaAsset -> String
pprintNonAdaAsset mp = intercalate "\n" $
Map.toUnfoldable (unwrapNonAdaAsset mp) <#> \(currency /\ tokens) ->
byteArrayToHex (getCurrencySymbol currency) <> ":\n" <>
( intercalate "\n" $ Map.toUnfoldable tokens <#> \(tokenName /\ amount) ->
" " <> fromTokenName byteArrayToHex show tokenName <> ": "
<> BigInt.toString amount
)

-- | Partitions a `NonAdaAsset` into smaller `NonAdaAsset`s, where the
-- | quantity of each token is equipartitioned across the resultant
-- | `NonAdaAsset`s, with the goal that no token quantity in any of the
Expand Down Expand Up @@ -483,6 +496,11 @@ instance Equipartition Value where
(equipartition coin numParts)
(equipartition nonAdaAssets numParts)

pprintValue :: Value -> String
pprintValue value =
"ADA: " <> BigInt.toString (unwrap (valueToCoin value)) <> "\n" <>
pprintNonAdaAsset (getNonAdaAsset value)

-- | Partitions a `Value` into smaller `Value`s, where the Ada amount and the
-- | quantity of each token is equipartitioned across the resultant `Value`s,
-- | with the goal that no token quantity in any of the resultant `Value`s
Expand Down
1 change: 1 addition & 0 deletions src/Internal/Types/TokenName.purs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ module Ctl.Internal.Types.TokenName
, mkTokenNames
, tokenNameFromAssetName
, assetNameName
, fromTokenName
) where

import Prelude
Expand Down

0 comments on commit 996934e

Please sign in to comment.