diff --git a/plutus-playground-client/src/Chain.purs b/plutus-playground-client/src/Chain.purs index 671a68c76f6..233c81af123 100644 --- a/plutus-playground-client/src/Chain.purs +++ b/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) diff --git a/plutus-playground-client/test/ChainTests.purs b/plutus-playground-client/test/ChainTests.purs new file mode 100644 index 00000000000..9bffa826966 --- /dev/null +++ b/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"} diff --git a/plutus-playground-client/test/Main.purs b/plutus-playground-client/test/Main.purs index 085b71d425d..818dcb96697 100644 --- a/plutus-playground-client/test/Main.purs +++ b/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