Fix #909 - Incorrect balances when the first wallet's balance is empty.

plutus-playground-client/src/Chain.purs

@@ -2,6 +2,7 @@ module Chain
        ( mockchainChartOptions
        , balancesChartOptions
        , evaluationPane
+       , extractAmount
        ) where
 
 import Bootstrap (empty, nbsp)
@@ -11,7 +12,7 @@ import Control.Monad.Aff.Class (class MonadAff)
 import Data.Array as Array
 import Data.Generic (gShow)
 import Data.Int as Int
-import Data.Lens (_Just, to, toListOf, traversed, view)
+import Data.Lens (_Just, preview, toListOf, traversed, view)
 import Data.Lens.At (at)
 import Data.List (List)
 import Data.Maybe (Maybe(..), maybe)
@@ -39,7 +40,7 @@ import Ledger.Slot (Slot(..))
 import Ledger.TxId (TxIdOf(TxIdOf))
 import Ledger.Value.TH (CurrencySymbol, TokenName)
 import Playground.API (EvaluationResult(EvaluationResult), SimulatorWallet)
-import Prelude (class Monad, Unit, discard, map, show, unit, ($), (<$>), (<<<), (<>))
+import Prelude (class Monad, Unit, discard, map, show, unit, ($), (<$>), (<<<), (<>), (>>>))
 import Types (BalancesChartSlot(BalancesChartSlot), ChildQuery, ChildSlot, Query(HandleBalancesChartMessage), _simulatorWalletBalance, _simulatorWalletWallet, _tokenName, _value, _walletId, cpBalancesChart)
 import Wallet.Emulator.Types (EmulatorEvent(..), Wallet(..))
 import Wallet.Graph (FlowGraph(FlowGraph), FlowLink(FlowLink), TxRef(TxRef))
@@ -201,7 +202,7 @@ balancesChartOptions wallets = do
     E.axisType E.Value
     axisLineStyle
   E.series do
-    traverse_ (currencySeries wallets) allCurrencies
+    traverse_ (buildCurrencySeries wallets) allCurrencies
   where
     axisLineStyle :: forall i. E.DSL (axisLine :: I, splitLine :: I | i) m
     axisLineStyle = do
@@ -226,20 +227,23 @@ balancesChartOptions wallets = do
 formatWalletId :: SimulatorWallet -> String
 formatWalletId wallet = "Wallet #" <> show (view (_simulatorWalletWallet <<< _walletId) wallet)
 
-currencySeries :: forall m i. Monad m => Array SimulatorWallet -> Tuple CurrencySymbol TokenName -> E.CommandsT (bar :: I | i) m Unit
-currencySeries wallets (Tuple currencySymbol tokenName) =
+buildCurrencySeries :: forall m i. Monad m => Array SimulatorWallet -> Tuple CurrencySymbol TokenName -> E.CommandsT (bar :: I | i) m Unit
+buildCurrencySeries wallets token@(Tuple currencySymbol tokenName) =
   E.bar do
     -- Optionally: `E.stack "One bar"`
     E.name $ view _tokenName tokenName
-    E.items
-      $ toListOf (traversed
-                  <<< _simulatorWalletBalance
-                  <<< _value
-                  <<< at currencySymbol
-                  <<< _Just
-                  <<< at tokenName
-                  <<< to (maybe nullItem (E.numItem <<< Int.toNumber)))
-        wallets
+    E.items $ map (extractAmount token
+                   >>> maybe nullItem (E.numItem <<< Int.toNumber))
+                   wallets
 
 nullItem :: Item
 nullItem = Item undefinedValue
+
+extractAmount :: Tuple CurrencySymbol TokenName -> SimulatorWallet -> Maybe Int
+extractAmount (Tuple currencySymbol tokenName) =
+  preview (_simulatorWalletBalance
+           <<< _value
+           <<< at currencySymbol
+           <<< _Just
+           <<< at tokenName
+           <<< _Just)

plutus-playground-client/test/ChainTests.purs

@@ -0,0 +1,81 @@
+module ChainTests
+       ( all
+       ) where
+
+import Prelude
+
+import Chain (extractAmount)
+import Control.Monad.Eff.Exception (EXCEPTION)
+import Control.Monad.Eff.Random (RANDOM)
+import Data.Array (mapWithIndex)
+import Data.Maybe (Maybe(..))
+import Data.Tuple.Nested ((/\))
+import Ledger.Extra (LedgerMap(..))
+import Ledger.Value.TH (CurrencySymbol(..), TokenName(..), Value(..))
+import Node.FS (FS)
+import Playground.API (SimulatorWallet(..))
+import Test.Unit (TestSuite, suite, test)
+import Test.Unit.Assert (equal)
+import Wallet.Emulator.Types (Wallet(..))
+
+
+all :: forall eff. TestSuite (exception :: EXCEPTION, fs :: FS, random :: RANDOM | eff)
+all =
+  suite "Chain" do
+    extractAmountsTests
+
+extractAmountsTests :: forall eff. TestSuite eff
+extractAmountsTests =
+  suite "extractAmount" do
+    test "All present" $
+      equal [ Just 10, Just 40, Just 70 ]
+       (map (extractAmount (currencies /\ usdToken)) wallets)
+    test "All missing" $
+      equal [ Nothing, Nothing, Nothing ]
+        (map (extractAmount (currencies /\ adaToken)) wallets)
+    test "Mixed" do
+      equal [ Just 20, Just 50, Nothing ]
+        (map (extractAmount (currencies /\ eurToken)) wallets)
+      equal [ Nothing, Just 30, Just 60 ]
+        (map (extractAmount (ada /\ adaToken)) wallets)
+
+
+wallets :: Array SimulatorWallet
+wallets =
+  mapWithIndex
+    (\id value -> SimulatorWallet { simulatorWalletWallet: Wallet { getWallet: id }
+                                  , simulatorWalletBalance: value
+                                  })
+    values
+
+values :: Array Value
+values =
+  [ Value { getValue: LedgerMap [ currencies /\ LedgerMap [ usdToken /\ 10
+                                                          , eurToken /\ 20
+                                                          ]
+                                ] }
+  , Value { getValue: LedgerMap [ ada /\ LedgerMap [ adaToken /\ 30 ]
+                                , currencies /\ LedgerMap [ usdToken /\ 40
+                                                          , eurToken /\ 50
+                                                          ]
+                                ] }
+  , Value { getValue: LedgerMap [ ada /\ LedgerMap [ adaToken /\ 60 ]
+                                , currencies /\ LedgerMap [ usdToken /\ 70
+                                                          ]
+                                ] }
+  ]
+
+ada :: CurrencySymbol
+ada = CurrencySymbol { unCurrencySymbol: ""}
+
+currencies :: CurrencySymbol
+currencies = CurrencySymbol { unCurrencySymbol: "Currency"}
+
+adaToken :: TokenName
+adaToken = TokenName { unTokenName: ""}
+
+usdToken :: TokenName
+usdToken = TokenName { unTokenName: "USDToken"}
+
+eurToken :: TokenName
+eurToken = TokenName { unTokenName: "EURToken"}

plutus-playground-client/test/Main.purs

@@ -13,6 +13,7 @@ import Data.String.ExtraTests as Data.String.ExtraTests
 import Ledger.ExtraTests as Ledger.ExtraTests
 import FileEvents (FILE)
 import GistsTests as GistsTests
+import ChainTests as ChainTests
 import MainFrameTests as MainFrameTests
 import Node.FS (FS)
 import Test.Unit.Console (TESTOUTPUT)
@@ -26,6 +27,7 @@ main = runTest do
   AjaxUtilsTests.all
   TypesTests.all
   GistsTests.all
+  ChainTests.all
   CursorTests.all
   MainFrameTests.all
   Data.String.ExtraTests.all