Skip to content
Permalink
Browse files

Merge pull request #915 from input-output-hk/issue-909

Fix #909 - Incorrect balances when the first wallet's balance is empty.
  • Loading branch information...
krisajenkins committed Apr 15, 2019
2 parents 44f7761 + 34f15b8 commit 4beea94e39adddb6513af6c0d8338e74e34264c9
@@ -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)
@@ -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"}
@@ -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

0 comments on commit 4beea94

Please sign in to comment.
You can’t perform that action at this time.