From 8375ed64c2002df765ac2eb520f0dd88bf2d0c26 Mon Sep 17 00:00:00 2001 From: hsloan Date: Wed, 7 Jul 2021 20:06:13 +0000 Subject: [PATCH] move websocket parsing functions to their own module --- use-case-2/frontend/frontend.cabal | 1 + use-case-2/frontend/src/Frontend.hs | 39 +-------------- .../frontend/src/Frontend/WebsocketParse.hs | 50 +++++++++++++++++++ 3 files changed, 53 insertions(+), 37 deletions(-) create mode 100644 use-case-2/frontend/src/Frontend/WebsocketParse.hs diff --git a/use-case-2/frontend/frontend.cabal b/use-case-2/frontend/frontend.cabal index 112844a66..bfa702751 100644 --- a/use-case-2/frontend/frontend.cabal +++ b/use-case-2/frontend/frontend.cabal @@ -28,6 +28,7 @@ library , vessel exposed-modules: Frontend + Frontend.WebsocketParse ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits executable frontend diff --git a/use-case-2/frontend/src/Frontend.hs b/use-case-2/frontend/src/Frontend.hs index 8995c1cde..d12ebf094 100644 --- a/use-case-2/frontend/src/Frontend.hs +++ b/use-case-2/frontend/src/Frontend.hs @@ -21,9 +21,8 @@ import Control.Monad import Control.Monad.IO.Class (MonadIO) import qualified Data.Aeson as Aeson import Data.Aeson.Lens -import Data.Maybe (fromMaybe, catMaybes) +import Data.Maybe (fromMaybe) import qualified Data.Map as Map -import qualified Data.HashMap.Lazy as HMap import Data.Semigroup (First(..)) import Data.Text (Text) import qualified Data.Text as T @@ -45,6 +44,7 @@ import Common.Route import Common.Plutus.Contracts.Uniswap.Types import Common.Plutus.Contracts.Uniswap.Estimates import Common.Schema +import Frontend.WebsocketParse -- This runs in a monad that can be run on the client or the server. @@ -624,41 +624,6 @@ poolDashboard wid = Workflow $ do return () return ((), leftmost [swapDashboard wid <$ swapEv, portfolioDashboard wid <$ portfolioEv]) --- TODO: Create a websocket parsing module for this -parseTokensToMap :: V.Vector Aeson.Value -> Map.Map Text (Integer, Text) -parseTokensToMap cd = mconcat $ catMaybes $ V.toList $ ffor cd $ \case - Aeson.Array xs -> case V.toList xs of - symbol:(Aeson.Array tokens):_ -> - let currencySymbol = symbol ^. key "unCurrencySymbol" . _String - tokens' = ffor tokens $ \case - Aeson.Array xs' -> case V.toList xs' of - tokenName:tokenAmount:_ -> Just - ( tokenName ^. key "unTokenName" . _String - , (fromMaybe 0 $ tokenAmount ^? _Integer, currencySymbol) - ) - _ -> Nothing - _ -> Nothing - in Just $ Map.fromList $ catMaybes $ V.toList tokens' - _ -> Nothing - _ -> Just Map.empty - --- returns Map of TokenName (LiquidityAmount, ((CoinA, CoinAPoolAmount), (CoinB, CoinBPoolAmount))) -parseLiquidityTokensToMap :: V.Vector Aeson.Value -> Map.Map Text (Integer, ((Text,Integer), (Text, Integer))) -parseLiquidityTokensToMap cd = mconcat $ catMaybes $ V.toList $ ffor cd $ \case - Aeson.Array xs -> case V.toList xs of - coinA:coinB:(Aeson.Array liquidityCoin):_-> case V.toList liquidityCoin of - (Aeson.Object obj):(Aeson.Number lqAmount):_ -> case HMap.toList obj of - (_, Aeson.String lqTokenName):_ -> do - let tna = coinA ^. nth 0 . key "unAssetClass" . values . key "unTokenName" . _String - tnaPool = fromMaybe 0 $ coinA ^? nth 1 . _Integer - tnb = coinB ^. nth 0 . key "unAssetClass" . values . key "unTokenName" . _String - tnbPool = fromMaybe 0 $ coinB ^? nth 1 . _Integer - Just $ Map.singleton lqTokenName ((fromMaybe 0 $ lqAmount ^? _Integer), ((tna, tnaPool),(tnb, tnbPool))) - _ -> Nothing - _ -> Nothing - _ -> Nothing - _ -> Just Map.empty - viewContracts :: (MonadQuery t (Vessel Q (Const SelectedCount)) m, Reflex t) => m (Dynamic t (Maybe (Maybe [Text]))) viewContracts = (fmap.fmap.fmap) (getFirst . runIdentity) $ queryViewMorphism 1 $ constDyn $ vessel Q_ContractList . identityV diff --git a/use-case-2/frontend/src/Frontend/WebsocketParse.hs b/use-case-2/frontend/src/Frontend/WebsocketParse.hs new file mode 100644 index 000000000..26322df07 --- /dev/null +++ b/use-case-2/frontend/src/Frontend/WebsocketParse.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Frontend.WebsocketParse where + +import Control.Lens +import qualified Data.Aeson as Aeson +import Data.Aeson.Lens +import qualified Data.HashMap.Lazy as HMap +import qualified Data.Map as Map +import Data.Maybe (fromMaybe, catMaybes) +import Data.Text (Text) +import qualified Data.Vector as V +import Reflex.Dom.Core + +-- TODO: Create a websocket parsing module for this +parseTokensToMap :: V.Vector Aeson.Value -> Map.Map Text (Integer, Text) +parseTokensToMap cd = mconcat $ catMaybes $ V.toList $ ffor cd $ \case + Aeson.Array xs -> case V.toList xs of + symbol:(Aeson.Array tokens):_ -> + let currencySymbol = symbol ^. key "unCurrencySymbol" . _String + tokens' = ffor tokens $ \case + Aeson.Array xs' -> case V.toList xs' of + tokenName:tokenAmount:_ -> Just + ( tokenName ^. key "unTokenName" . _String + , (fromMaybe 0 $ tokenAmount ^? _Integer, currencySymbol) + ) + _ -> Nothing + _ -> Nothing + in Just $ Map.fromList $ catMaybes $ V.toList tokens' + _ -> Nothing + _ -> Just Map.empty + +-- returns Map of TokenName (LiquidityAmount, ((CoinA, CoinAPoolAmount), (CoinB, CoinBPoolAmount))) +parseLiquidityTokensToMap :: V.Vector Aeson.Value -> Map.Map Text (Integer, ((Text,Integer), (Text, Integer))) +parseLiquidityTokensToMap cd = mconcat $ catMaybes $ V.toList $ ffor cd $ \case + Aeson.Array xs -> case V.toList xs of + coinA:coinB:(Aeson.Array liquidityCoin):_-> case V.toList liquidityCoin of + (Aeson.Object obj):(Aeson.Number lqAmount):_ -> case HMap.toList obj of + (_, Aeson.String lqTokenName):_ -> do + let tna = coinA ^. nth 0 . key "unAssetClass" . values . key "unTokenName" . _String + tnaPool = fromMaybe 0 $ coinA ^? nth 1 . _Integer + tnb = coinB ^. nth 0 . key "unAssetClass" . values . key "unTokenName" . _String + tnbPool = fromMaybe 0 $ coinB ^? nth 1 . _Integer + Just $ Map.singleton lqTokenName ((fromMaybe 0 $ lqAmount ^? _Integer), ((tna, tnaPool),(tnb, tnbPool))) + _ -> Nothing + _ -> Nothing + _ -> Nothing + _ -> Just Map.empty +