Use readerT to move the UI wallet type around

Author: paolino

lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Wallet.hs

@@ -21,8 +21,9 @@ import Cardano.Wallet.UI.Common.Html.Lib
 import Cardano.Wallet.UI.Common.Html.Pages.Lib
     ( copyButton
     )
-import Control.Monad
-    ( when
+import Cardano.Wallet.UI.Type
+    ( WHtml
+    , onShelley
     )
 import Data.Text
     ( Text
@@ -60,7 +61,7 @@ mnemonicH (Just mnemonic) = do
             $ T.intercalate " " mnemonic
         copyButton "copy-mnemonic"
 
-newWalletH :: (Maybe Bool -> Link) -> PostWalletConfig -> Html ()
+newWalletH :: (Maybe Bool -> Link) -> PostWalletConfig -> WHtml ()
 newWalletH walletMnemonicLink config = do
     useHtmxExtension "json-enc"
     div_ [class_ "btn-group mb-3", role_ "group"] $ do
@@ -88,11 +89,10 @@ newWalletH walletMnemonicLink config = do
 
 data PostWalletConfig = PostWalletConfig
     { passwordVisibility :: Maybe Visible
-    , namePresence :: Bool
     , walletDataLink :: Link
     }
 
-postWalletForm :: PostWalletConfig -> Html ()
+postWalletForm :: PostWalletConfig -> WHtml ()
 postWalletForm PostWalletConfig{..} = form_
     [ hxPost_ $ linkText walletDataLink
     , hxExt_ "json-enc"
@@ -106,19 +106,20 @@ postWalletForm PostWalletConfig{..} = form_
             , name_ "mnemonicSentence"
             , placeholder_ "Mnemonic Sentence"
             ]
-        when namePresence $
-            input_
+        onShelley
+            $ input_
                 [ class_ "form-control form-control-lg mb-3"
                 , type_ "text"
                 , name_ "name"
                 , placeholder_ "Wallet Name"
                 ]
-        input_
-            [ class_ "form-control form-control-lg mb-3"
-            , visibility
-            , name_ "passphrase"
-            , placeholder_ "Passphrase"
-            ]
+        onShelley
+            $ input_
+                [ class_ "form-control form-control-lg mb-3"
+                , visibility
+                , name_ "passphrase"
+                , placeholder_ "Passphrase"
+                ]
         button_
             [ class_ "btn btn-primary btn-block mb-3"
             , type_ "submit"

lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Page.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -47,6 +48,10 @@ import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
     ( WalletPresent
     , walletH
     )
+import Cardano.Wallet.UI.Type
+    ( WalletType (..)
+    , runWHtml
+    )
 import Control.Lens.Extras
     ( is
     )
@@ -79,6 +84,7 @@ page
     -> RawHtml
 page c@PageConfig{..} p wp = RawHtml
     $ renderBS
+    $ runWHtml Deposit
     $ pageFromBodyH faviconLink c
     $ bodyH (headerH prefix p)
     $ case p of

lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Wallet.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE RankNTypes #-}
 module Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
 where
 
@@ -25,6 +26,9 @@ import Cardano.Wallet.UI.Deposit.API
     ( walletLink
     , walletMnemonicLink
     )
+import Cardano.Wallet.UI.Type
+    ( WHtml
+    )
 import Codec.Binary.Encoding
     ( AbstractEncoding (..)
     , encode
@@ -46,7 +50,7 @@ import qualified Data.Text.Encoding as T
 
 data WalletPresent = WalletPresent WalletPublicIdentity | WalletAbsent
 
-walletH :: WalletPresent -> Html ()
+walletH :: WalletPresent -> WHtml ()
 walletH walletPresent = do
     -- sseH sseLink walletLink "wallet" ["wallet"]
     case walletPresent of
@@ -55,7 +59,6 @@ walletH walletPresent = do
             newWalletH walletMnemonicLink $ PostWalletConfig
                 { walletDataLink = walletLink
                 , passwordVisibility = Just Hidden
-                , namePresence = False
                 }
 
 base16 :: ByteString -> Text

lib/ui/src/Cardano/Wallet/UI/Shelley/Html/Pages/Page.hs

@@ -55,6 +55,10 @@ import Cardano.Wallet.UI.Shelley.Html.Pages.Wallet
 import Cardano.Wallet.UI.Shelley.Html.Pages.Wallets
     ( walletsH
     )
+import Cardano.Wallet.UI.Type
+    ( WalletType (..)
+    , runWHtml
+    )
 import Control.Lens.Extras
     ( is
     )
@@ -89,6 +93,7 @@ page
     -> RawHtml
 page c@PageConfig{..} p wp = RawHtml
     $ renderBS
+    $ runWHtml Shelley
     $ pageFromBodyH faviconLink c
     $ bodyH (headerH prefix p)
     $ case p of

lib/ui/src/Cardano/Wallet/UI/Shelley/Html/Pages/Wallets.hs

@@ -49,6 +49,9 @@ import Cardano.Wallet.UI.Shelley.API
 import Cardano.Wallet.UI.Shelley.Html.Pages.Wallet
     ( renderState
     )
+import Cardano.Wallet.UI.Type
+    ( WHtml
+    )
 import Control.Monad
     ( forM_
     )
@@ -72,13 +75,12 @@ import Lucid
 
 data Selected = Selected | NotSelected
 
-walletsH :: Html ()
+walletsH :: WHtml ()
 walletsH = do
     sseH sseLink walletsListLink "content" ["wallets"]
     newWalletH walletMnemonicLink $ PostWalletConfig
         { walletDataLink = walletLink
         , passwordVisibility = Just Hidden
-        , namePresence = True
         }
 
 walletListH :: Maybe WalletId -> [(ApiWallet, UTCTime)] -> Html ()