From 996934e6b6b8548b04091d4b115ae36e753e155f Mon Sep 17 00:00:00 2001
From: Vladimir Kalnitsky <vladimir@mlabs.city>
Date: Wed, 20 Sep 2023 15:55:40 +0400
Subject: [PATCH] Pretty-print value in balancing logs

---
 src/Internal/BalanceTx/BalanceTx.purs | 23 +++++++++++------------
 src/Internal/Cardano/Types/Value.purs | 20 +++++++++++++++++++-
 src/Internal/Types/TokenName.purs     |  1 +
 3 files changed, 31 insertions(+), 13 deletions(-)

diff --git a/src/Internal/BalanceTx/BalanceTx.purs b/src/Internal/BalanceTx/BalanceTx.purs
index fb57302d28..538eb92659 100644
--- a/src/Internal/BalanceTx/BalanceTx.purs
+++ b/src/Internal/BalanceTx/BalanceTx.purs
@@ -119,6 +119,7 @@ import Ctl.Internal.Cardano.Types.Value
   , minus
   , mkValue
   , posNonAdaAsset
+  , pprintValue
   , valueToCoin'
   )
 import Ctl.Internal.Cardano.Types.Value as Value
@@ -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)
@@ -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)
diff --git a/src/Internal/Cardano/Types/Value.purs b/src/Internal/Cardano/Types/Value.purs
index ace38f6898..dacabfca17 100644
--- a/src/Internal/Cardano/Types/Value.purs
+++ b/src/Internal/Cardano/Types/Value.purs
@@ -43,6 +43,8 @@ module Ctl.Internal.Cardano.Types.Value
   , numNonAdaCurrencySymbols
   , numTokenNames
   , posNonAdaAsset
+  , pprintNonAdaAsset
+  , pprintValue
   , scriptHashAsCurrencySymbol
   , split
   , sumTokenNameLengths
@@ -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)
@@ -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
@@ -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
diff --git a/src/Internal/Types/TokenName.purs b/src/Internal/Types/TokenName.purs
index a68dfe869a..1219262cc2 100644
--- a/src/Internal/Types/TokenName.purs
+++ b/src/Internal/Types/TokenName.purs
@@ -6,6 +6,7 @@ module Ctl.Internal.Types.TokenName
   , mkTokenNames
   , tokenNameFromAssetName
   , assetNameName
+  , fromTokenName
   ) where
 
 import Prelude