Form refactors

frontend/src/Frontend/UI/Dialogs/CallFunction.hs

@@ -83,8 +83,7 @@ uiCallFunction m mModule func _onClose
             { _deploymentSettingsConfig_userTab = parametersTab m func
             , _deploymentSettingsConfig_chainId = \_ -> pure $ pure $ Just $ _chainRef_chain . _moduleRef_source $ moduleRef
             , _deploymentSettingsConfig_code = fromMaybe (pure $ buildCall func []) mPactCall
-            , _deploymentSettingsConfig_sender = \_ _ _ -> uiAccountAny
-            -- , _deploymentSettingsConfig_sender = uiAccountDropdown def (pure $ \_ _ -> True) (pure id)
+            , _deploymentSettingsConfig_sender = \m' _ _ -> uiAccountComboBox m' Nothing
             , _deploymentSettingsConfig_data = Nothing
             , _deploymentSettingsConfig_ttl = Nothing
             , _deploymentSettingsConfig_nonce = Nothing

frontend/src/Frontend/UI/Dialogs/DeployConfirmation.hs

@@ -64,6 +64,7 @@ import Frontend.Crypto.Class
 import Frontend.JsonData
 import Frontend.Network
 import Frontend.UI.DeploymentSettings
+import Frontend.UI.FormWidget
 import Frontend.UI.Modal
 import Frontend.UI.Widgets
 import Frontend.UI.Widgets.Helpers (dialogSectionHeading)
@@ -377,7 +378,7 @@ uiDeployConfirmation code model = fullDeployFlow def model $ do
     { _deploymentSettingsConfig_chainId = fmap value . userChainIdSelect . getChainsFromHomogenousNetwork
     , _deploymentSettingsConfig_userTab = Nothing
     , _deploymentSettingsConfig_code = pure code
-    , _deploymentSettingsConfig_sender = \_ _ _ -> uiAccountAny
+    , _deploymentSettingsConfig_sender = \_ _ _ -> uiAccountComboBox model Nothing
     , _deploymentSettingsConfig_data = Nothing
     , _deploymentSettingsConfig_ttl = Nothing
     , _deploymentSettingsConfig_nonce = Nothing

frontend/src/Frontend/UI/Dialogs/Send.hs

@@ -76,8 +76,6 @@ import Frontend.UI.Widgets
 import Frontend.UI.Widgets.Helpers (dialogSectionHeading)
 import Frontend.Wallet
 
-import Frontend.UI.Dialogs.Send.ManualTxBuilder (uiExplodedTxBuilder, recipientMatchesSenderTxBuilder)
-
 type SendConstraints model mConf key t m
   = ( Monoid mConf, HasNetwork model t, HasNetworkCfg mConf t, HasWallet model key t, HasWalletCfg mConf key t
     , MonadWidget t m, PostBuild t m, HasCrypto key m

frontend/src/Frontend/UI/Dialogs/Send/ManualTxBuilder.hs

@@ -16,7 +16,7 @@
 
 module Frontend.UI.Dialogs.Send.ManualTxBuilder
   ( uiManualTxBuilderInput
-  , uiExplodedTxBuilder
+  -- , uiExplodedTxBuilder
   , recipientMatchesSenderTxBuilder
   ) where
 
@@ -111,107 +111,107 @@ uiManualTxBuilderInput onReset fromName fromChain mUcct mInitToAddress = do
     & textAreaElementConfig_initialValue .~ (maybe "" renderTxBuilder mInitToAddress)
     & textAreaElementConfig_setValue .~ (mempty <$ onReset)
 
-uiExplodedChainSelect
-  :: forall t m model
-     . ( MonadWidget t m
-       , HasNetwork model t
-       )
-  => model
-  -> Maybe UnfinishedCrossChainTransfer
-  -> Event t (Maybe AccountName)
-  -> Dynamic t (Maybe AccountName)
-  -> AccountName
-  -> ChainId
-  -> Event t (Maybe ChainId)
-  -> m ( Dropdown t (Maybe ChainId) )
-uiExplodedChainSelect model mUcct onFromName dFromName fromName fromChain onTxChainId = do
-  let
-    chainSelect _ = elClass' "div" "segment_type_tertiary" $
-      mkLabeledClsInput False "Chain ID" (uiChainSelectionWithUpdate (getChainsFromHomogenousNetwork model) onTxChainId)
-
-    onNameChainUpdated (_, chainE) = leftmost
-      [ (,) <$> current dFromName <@> _dropdown_change chainE
-      , flip (,) <$> current (value chainE) <@> onFromName
-      ]
-
-    showPopover e = pure $ onNameChainUpdated e <&> \case
-      (Just toName, Just toChain) ->
-        showManualTxBuilderPopover mUcct (fromName, fromChain) (toName, toChain)
-      _ ->
-        PopoverState_Disabled
-
-  fmap snd $ uiInputWithPopover chainSelect (_element_raw . fst) showPopover (def :: DropdownConfig t k)
-
-uiExplodedTxBuilder
-  :: forall t m model key
-     . ( MonadWidget t m
-       , HasWallet model key t
-       , HasJsonData model t
-       , HasNetwork model t
-       )
-  => model
-  -> AccountName
-  -> ChainId
-  -> Maybe UnfinishedCrossChainTransfer
-  -> Maybe TxBuilder
-  -> m (Dynamic t (Maybe TxBuilder))
-uiExplodedTxBuilder model fromName fromChain mUcct mInitToAddress = do
-  let
-    mkAlteredTxB mname mchain intKeys extKeys mPredicate = TxBuilder <$> mname <*> mchain
-      <*> pure (fmap (\p -> toPactKeyset $ KeySetHeritage (intKeys <> extKeys) p Nothing) mPredicate)
-
-    explodedTxB onTxAccountName onTxChainId keysetsPresets = do
-      (onNameInput, dname) <- uiAccountNameInput "Account Name" False Nothing onTxAccountName noValidation
-
-      chainE <- uiExplodedChainSelect model
-        mUcct
-        onNameInput
-        dname
-        fromName
-        fromChain
-        onTxChainId
-
-      keyset <- fmap snd $ uiDefineKeyset model keysetsPresets
-
-      let onKeysetChange = mconcat
-            [ () <$ _keysetInputs_rowAddDelete (_definedKeyset_internalKeys keyset)
-            , () <$ _keysetInputs_rowAddDelete (_definedKeyset_externalKeys keyset)
-            , () <$ _keysetInputs_rowChange (_definedKeyset_internalKeys keyset)
-            , () <$ _keysetInputs_rowChange (_definedKeyset_externalKeys keyset)
-            , () <$ _definedKeyset_predicateChange keyset
-            , () <$ onNameInput
-            , () <$ _dropdown_change chainE
-            ]
-
-      pure $ (,) onKeysetChange $ mkAlteredTxB
-        <$> dname
-        <*> value chainE
-        <*> _keysetInputs_set (_definedKeyset_internalKeys keyset)
-        <*> _keysetInputs_set (_definedKeyset_externalKeys keyset)
-        <*> _definedKeyset_predicate keyset
-
-  rec
-    onEitherTxB <- fmap (fst . snd) $
-      uiManualTxBuilderInput onKeysetChange fromName fromChain mUcct mInitToAddress
-
-    let
-      onTxBAccountName = fmap (^? _Right . to _txBuilder_accountName) onEitherTxB
-      onTxBChainId = fmap (^? _Right . to _txBuilder_chainId) onEitherTxB
-      onTxBPredicate = fmap
-        (^? _Right . to _txBuilder_keyset . _Just . to Pact._ksPredFun . to Pact.renderCompactText)
-        onEitherTxB
-
-      (onInternalKeys, onExternalKeys) = splitE $ attachWithMaybe
-        (\keys -> either (const Nothing) (Just . mkKeysets keys))
-        (current $ model ^. wallet_keys)
-        onEitherTxB
-
-    (onKeysetChange, dKeyset) <- explodedTxB onTxBAccountName onTxBChainId $ emptyKeysetPresets
-      & definedKeyset_internalKeys . keysetInputs_rowAddDelete .~ onInternalKeys
-      & definedKeyset_externalKeys . keysetInputs_rowAddDelete .~ onExternalKeys
-      & definedKeyset_predicateChange .~ onTxBPredicate
-
-  pure dKeyset
+-- uiExplodedChainSelect
+--   :: forall t m model
+--      . ( MonadWidget t m
+--        , HasNetwork model t
+--        )
+--   => model
+--   -> Maybe UnfinishedCrossChainTransfer
+--   -> Event t (Maybe AccountName)
+--   -> Dynamic t (Maybe AccountName)
+--   -> AccountName
+--   -> ChainId
+--   -> Event t (Maybe ChainId)
+--   -> m ( Dropdown t (Maybe ChainId) )
+-- uiExplodedChainSelect model mUcct onFromName dFromName fromName fromChain onTxChainId = do
+--   let
+--     chainSelect _ = elClass' "div" "segment_type_tertiary" $
+--       mkLabeledClsInput False "Chain ID" (uiChainSelectionWithUpdate (getChainsFromHomogenousNetwork model) onTxChainId)
+
+--     onNameChainUpdated (_, chainE) = leftmost
+--       [ (,) <$> current dFromName <@> _dropdown_change chainE
+--       , flip (,) <$> current (value chainE) <@> onFromName
+--       ]
+
+--     showPopover e = pure $ onNameChainUpdated e <&> \case
+--       (Just toName, Just toChain) ->
+--         showManualTxBuilderPopover mUcct (fromName, fromChain) (toName, toChain)
+--       _ ->
+--         PopoverState_Disabled
+
+--   fmap snd $ uiInputWithPopover chainSelect (_element_raw . fst) showPopover (def :: DropdownConfig t k)
+
+-- uiExplodedTxBuilder
+--   :: forall t m model key
+--      . ( MonadWidget t m
+--        , HasWallet model key t
+--        , HasJsonData model t
+--        , HasNetwork model t
+--        )
+--   => model
+--   -> AccountName
+--   -> ChainId
+--   -> Maybe UnfinishedCrossChainTransfer
+--   -> Maybe TxBuilder
+--   -> m (Dynamic t (Maybe TxBuilder))
+-- uiExplodedTxBuilder model fromName fromChain mUcct mInitToAddress = do
+--   let
+--     mkAlteredTxB mname mchain intKeys extKeys mPredicate = TxBuilder <$> mname <*> mchain
+--       <*> pure (fmap (\p -> toPactKeyset $ KeySetHeritage (intKeys <> extKeys) p Nothing) mPredicate)
+
+--     explodedTxB onTxAccountName onTxChainId keysetsPresets = do
+--       (onNameInput, dname) <- uiAccountNameInput "Account Name" False Nothing onTxAccountName noValidation
+
+--       chainE <- uiExplodedChainSelect model
+--         mUcct
+--         onNameInput
+--         dname
+--         fromName
+--         fromChain
+--         onTxChainId
+
+--       keyset <- fmap snd $ uiDefineKeyset model keysetsPresets
+
+--       let onKeysetChange = mconcat
+--             [ () <$ _keysetInputs_rowAddDelete (_definedKeyset_internalKeys keyset)
+--             , () <$ _keysetInputs_rowAddDelete (_definedKeyset_externalKeys keyset)
+--             , () <$ _keysetInputs_rowChange (_definedKeyset_internalKeys keyset)
+--             , () <$ _keysetInputs_rowChange (_definedKeyset_externalKeys keyset)
+--             , () <$ _definedKeyset_predicateChange keyset
+--             , () <$ onNameInput
+--             , () <$ _dropdown_change chainE
+--             ]
+
+--       pure $ (,) onKeysetChange $ mkAlteredTxB
+--         <$> dname
+--         <*> value chainE
+--         <*> _keysetInputs_set (_definedKeyset_internalKeys keyset)
+--         <*> _keysetInputs_set (_definedKeyset_externalKeys keyset)
+--         <*> _definedKeyset_predicate keyset
+
+--   rec
+--     onEitherTxB <- fmap (fst . snd) $
+--       uiManualTxBuilderInput onKeysetChange fromName fromChain mUcct mInitToAddress
+
+--     let
+--       onTxBAccountName = fmap (^? _Right . to _txBuilder_accountName) onEitherTxB
+--       onTxBChainId = fmap (^? _Right . to _txBuilder_chainId) onEitherTxB
+--       onTxBPredicate = fmap
+--         (^? _Right . to _txBuilder_keyset . _Just . to Pact._ksPredFun . to Pact.renderCompactText)
+--         onEitherTxB
+
+--       (onInternalKeys, onExternalKeys) = splitE $ attachWithMaybe
+--         (\keys -> either (const Nothing) (Just . mkKeysets keys))
+--         (current $ model ^. wallet_keys)
+--         onEitherTxB
+
+--     (onKeysetChange, dKeyset) <- explodedTxB onTxBAccountName onTxBChainId $ emptyKeysetPresets
+--       & definedKeyset_internalKeys . keysetInputs_rowAddDelete .~ onInternalKeys
+--       & definedKeyset_externalKeys . keysetInputs_rowAddDelete .~ onExternalKeys
+--       & definedKeyset_predicateChange .~ onTxBPredicate
+
+--   pure dKeyset
 
 mkKeysets
   :: KeyStorage key

frontend/src/Frontend/UI/Dialogs/Signing.hs

@@ -28,7 +28,7 @@ import Frontend.JsonData
 import Frontend.Network
 import Frontend.UI.DeploymentSettings
 import Frontend.UI.Modal.Impl
-import Frontend.UI.Widgets (predefinedChainIdDisplayed, userChainIdSelect, uiAccountFixed, uiAccountAny)
+import Frontend.UI.Widgets (predefinedChainIdDisplayed, userChainIdSelect, uiAccountFixed, uiAccountAny, uiAccountComboBox)
 import Frontend.Wallet
 
 type HasUISigningModelCfg mConf key t =
@@ -64,7 +64,7 @@ uiSigning ideL writeSigningResponse signingRequest onCloseExternal = do
     , _deploymentSettingsConfig_code = pure $ _signingRequest_code signingRequest
     , _deploymentSettingsConfig_sender = case _signingRequest_sender signingRequest of
         Just sender -> \_ _ _ -> uiAccountFixed sender
-        Nothing -> \_ _ _ -> uiAccountAny
+        Nothing -> \m _ _ -> uiAccountComboBox m Nothing
     , _deploymentSettingsConfig_data = _signingRequest_data signingRequest
     , _deploymentSettingsConfig_nonce = _signingRequest_nonce signingRequest
     , _deploymentSettingsConfig_ttl = _signingRequest_ttl signingRequest

frontend/src/Frontend/UI/Form/Common.hs

@@ -95,7 +95,7 @@ amountFormWidget cfg = do
     parsingFormWidget parseAmount (either (const "") tshow) cfg
 
 parseAmount :: Text -> Either String Decimal
-parseAmount t = 
+parseAmount t =
   let tNoLeadingDecimal = if "." `T.isPrefixOf` t then "0" <> t else t in
   case D.normalizeDecimal <$> readMaybe (T.unpack tNoLeadingDecimal) of
         Nothing -> Left "Not a valid number"

frontend/src/Frontend/UI/Widgets.hs

@@ -37,6 +37,7 @@ module Frontend.UI.Widgets
   , accountDatalist
   , uiAccountNameInput
   , uiAccountNameInputNoDropdown
+  , uiAccountComboBox
   , accountNameFormWidget
   , accountNameFormWidgetNoDropdown
   , uiAccountFixed
@@ -925,9 +926,24 @@ uiGasPriceInputField eReset conf = dimensionalInputFeedbackWrapper (Just "KDA")
 userChainIdSelect
   :: MonadWidget t m
   => Dynamic t [ChainId]
-  -> m ( Dropdown t (Maybe ChainId) )
+  -> m ( FormWidget t (Maybe ChainId) )
 userChainIdSelect options = do
-  mkLabeledClsInput True "Chain ID" (uiChainSelectionWithUpdate options never)
+  mkLabeledClsInput True "Chain ID" (uiChainSelection options)
+
+uiChainSelection
+  :: MonadWidget t m
+  => Dynamic t [ChainId]
+  -> CssClass
+  -> m ( FormWidget t (Maybe ChainId) )
+uiChainSelection options cls = do
+  let
+    chains = map (Just &&& _chainId) <$> options
+    mkPlaceHolder cChains = if null cChains then "No chains available" else "Select chain"
+    chains' = ffor chains $ \c -> (Nothing, mkPlaceHolder c):c
+    staticCls = cls <> "select"
+    cfg = mkCfg Nothing
+            & initialAttributes %~ addToClassAttr staticCls
+  unsafeDropdownFormWidget chains' cfg
 
 uiChainSelectionWithUpdate
   :: MonadWidget t m
@@ -1112,6 +1128,35 @@ uiAccountNameInputNoDropdown label inlineLabel initval onSetName validateName =
     & setValue .~ Just onSetName
   pure (tagPromptlyDyn v i, v)
 
+-- TODO: Implement commented version and figure out why it causes event-loop
+-- uiAccountComboBox :: (HasWallet model key t, HasNetwork model t, MonadWidget t m) =>
+--   model -> Maybe AccountName -> (Dynamic t (Maybe ChainId)) -> m (Dynamic t (Maybe (AccountName, Account)))
+-- uiAccountComboBox m mDefAccount dMCid = do
+uiAccountComboBox
+  :: (HasWallet model key t, HasNetwork model t, MonadWidget t m)
+  => model
+  -> Maybe AccountName
+  -> m (Dynamic t (Maybe (AccountName, Account)))
+uiAccountComboBox m mDefAccount = do
+  let dAccMap = fmap (fromMaybe mempty) $ Map.lookup
+                  <$> (m^.network_selectedNetwork)
+                  <*> (unAccountData <$> m^.wallet_accounts)
+      dAccList = fmap (unAccountName . fst) . Map.toList <$> dAccMap
+      initAccount = maybe "" unAccountName mDefAccount
+      mkEmpty a = (AccountName a, Account AccountStatus_Unknown blankVanityAccount)
+      -- f map Nothing accName = Just $ mkEmpty accName
+      -- f map (Just cid) accName =
+      --   maybe
+      --     (if T.null accName
+      --        then Nothing
+      --        else Just $ mkEmpty accName)
+      --     (\res ->  Just (AccountName accName, res))
+      --     $ map ^? ix (AccountName accName) . accountInfo_chains . ix cid
+  dAccName <- fmap value $ uiComboBox initAccount dAccList $ pfwc2iec id $
+        mkCfg ""
+          & primFormWidgetConfig_initialAttributes .~ ("class" =: "labeled-input__input")
+  pure $ Just . mkEmpty <$> dAccName
+  -- pure $ f <$> dAccMap <*> dMCid <*> dAccName
 
 -- | Free form for an account
 uiAccountAny :: MonadWidget t m => m (Dynamic t (Maybe (AccountName, Account)))