Parametrize input form

CHANGELOG.md

@@ -14,6 +14,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Transaction list
 - Balance display
 - Account selector
+- Menu for new addresses, accounts, wallets
 
 
 ## [0.5.3.0-beta]

src/Zenith/GUI.hs

@@ -40,16 +40,28 @@ import Zenith.Utils (displayAmount, showAddress)
 data AppEvent
   = AppInit
   | ShowMsg !T.Text
+  | ShowError !T.Text
   | CloseMsg
   | WalletClicked
   | AccountClicked
+  | MenuClicked
+  | NewClicked
+  | NewAddress
+  | NewAccount
+  | NewWallet
   | SetPool !ZcashPool
   | SwitchQr !(Maybe QrCode)
   | SwitchAddr !Int
   | SwitchAcc !Int
+  | SwitchWal !Int
   | CopyAddr !(Maybe (Entity WalletAddress))
   | LoadTxs ![Entity UserTx]
   | LoadAddrs ![Entity WalletAddress]
+  | LoadAccs ![Entity ZcashAccount]
+  | ConfirmCancel
+  | SaveAddress
+  | SaveAccount
+  | SaveWallet
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -70,6 +82,15 @@ data AppModel = AppModel
   , _selPool :: !ZcashPool
   , _qrCodeWidget :: !(Maybe QrCode)
   , _accPopup :: !Bool
+  , _walPopup :: !Bool
+  , _menuPopup :: !Bool
+  , _newPopup :: !Bool
+  , _mainInput :: !T.Text
+  , _confirmTitle :: !(Maybe T.Text)
+  , _confirmAccept :: !T.Text
+  , _confirmCancel :: !T.Text
+  , _confirmEvent :: !AppEvent
+  , _inError :: !Bool
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -102,7 +123,11 @@ buildUI wenv model = widgetTree
         then Nothing
         else Just ((model ^. addresses) !! (model ^. selAddr))
     widgetTree =
-      zstack [mainWindow, msgOverlay `nodeVisible` isJust (model ^. msg)]
+      zstack
+        [ mainWindow
+        , confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
+        , msgOverlay `nodeVisible` isJust (model ^. msg)
+        ]
     mainWindow =
       vstack
         [ windowHeader
@@ -115,9 +140,21 @@ buildUI wenv model = widgetTree
         ]
     windowHeader =
       hstack
+        [ vstack
+            [ box_
+                [onClick MenuClicked, alignMiddle]
+                (remixIcon remixMenuFill `styleBasic`
+                 [textSize 16, textColor white]) `styleBasic`
+              [cursorHand, height 25, padding 3] `styleHover`
+              [bgColor btnHiLite]
+            , popup menuPopup menuBox
+            ]
+        , vstack
             [ box_ [onClick WalletClicked, alignMiddle] walletButton `styleBasic`
               [cursorHand, height 25, padding 3] `styleHover`
               [bgColor btnHiLite]
+            , popup walPopup walListPopup
+            ]
         , vstack
             [ box_ [onClick AccountClicked, alignMiddle] accountButton `styleBasic`
               [cursorHand, height 25, padding 3] `styleHover`
@@ -130,6 +167,47 @@ buildUI wenv model = widgetTree
           (model ^. network == TestNet)
         ] `styleBasic`
       [bgColor btnColor]
+    menuBox =
+      box_
+        [alignMiddle]
+        (vstack
+           [ box_
+               [alignLeft]
+               (vstack
+                  [ box_
+                      [alignLeft, onClick NewClicked]
+                      (hstack
+                         [ label "New"
+                         , filler
+                         , widgetIf (not $ model ^. newPopup) $
+                           remixIcon remixMenuUnfoldFill
+                         , widgetIf (model ^. newPopup) $
+                           remixIcon remixMenuFoldFill
+                         ])
+                  , widgetIf (model ^. newPopup) $ animSlideIn newBox
+                  ]) `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           , box_ [alignLeft] (label "Backup Wallet") `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           ]) `styleBasic`
+      [bgColor btnColor, padding 3]
+    newBox =
+      box_
+        [alignMiddle]
+        (vstack
+           [ box_
+               [alignLeft, onClick NewAddress]
+               (hstack [label "Address", filler]) `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           , box_
+               [alignLeft, onClick NewAccount]
+               (hstack [label "Account", filler]) `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           , box_
+               [alignLeft, onClick NewWallet]
+               (hstack [label "Wallet", filler]) `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           ])
     walletButton =
       hstack
         [ label "Wallet: " `styleBasic` [textFont "Bold", textColor white]
@@ -137,6 +215,21 @@ buildUI wenv model = widgetTree
           [textFont "Regular", textColor white]
         , remixIcon remixArrowRightWideLine `styleBasic` [textColor white]
         ]
+    walListPopup =
+      box_ [alignMiddle] dispWalList `styleBasic` [bgColor btnColor, padding 3]
+    dispWalList = vstack (zipWith walRow [0 ..] (model ^. wallets))
+    walRow :: Int -> Entity ZcashWallet -> WidgetNode AppModel AppEvent
+    walRow idx wal =
+      box_
+        [onClick $ SwitchWal idx, alignCenter]
+        (label (zcashWalletName (entityVal wal))) `styleBasic`
+      [ padding 1
+      , borderB 1 gray
+      , bgColor white
+      , width 80
+      , styleIf (model ^. selWallet == idx) (borderL 2 btnHiLite)
+      , styleIf (model ^. selWallet == idx) (borderR 2 btnHiLite)
+      ]
     accountButton =
       hstack
         [ label "Account: " `styleBasic` [textFont "Bold", textColor white]
@@ -155,6 +248,7 @@ buildUI wenv model = widgetTree
       [ padding 1
       , borderB 1 gray
       , bgColor white
+      , width 80
       , styleIf (model ^. selAcc == idx) (borderL 2 btnHiLite)
       , styleIf (model ^. selAcc == idx) (borderR 2 btnHiLite)
       ]
@@ -354,7 +448,23 @@ buildUI wenv model = widgetTree
         ]
     msgOverlay =
       alert CloseMsg $
-      hstack [filler, label $ fromMaybe "" (model ^. msg), filler]
+      hstack
+        [ filler
+        , image_ "./assets/1F616_color.png" [fitHeight] `styleBasic`
+          [height 44, width 44] `nodeVisible`
+          (model ^. inError)
+        , label $ fromMaybe "" (model ^. msg)
+        , filler
+        ]
+    confirmOverlay =
+      confirm_
+        (model ^. confirmEvent)
+        ConfirmCancel
+        [ titleCaption $ fromMaybe "" $ model ^. confirmTitle
+        , acceptCaption $ model ^. confirmAccept
+        , cancelCaption $ model ^. confirmCancel
+        ]
+        (hstack [label "Name:", filler, textField_ mainInput [maxLength 25]])
 
 generateQRCodes :: Config -> IO ()
 generateQRCodes config = do
@@ -433,9 +543,62 @@ handleEvent ::
 handleEvent wenv node model evt =
   case evt of
     AppInit -> []
-    ShowMsg t -> [Model $ model & msg ?~ t]
-    WalletClicked -> [Model $ model & msg ?~ "You clicked Wallet!"]
+    ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False]
+    ShowError t ->
+      [Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True]
+    WalletClicked -> [Model $ model & walPopup .~ True]
     AccountClicked -> [Model $ model & accPopup .~ True]
+    MenuClicked -> [Model $ model & menuPopup .~ True]
+    NewClicked -> [Model $ model & newPopup .~ not (model ^. newPopup)]
+    NewAddress ->
+      [ Model $
+        model & confirmTitle ?~ "New Address" & confirmAccept .~ "Create" &
+        confirmCancel .~
+        "Cancel" &
+        confirmEvent .~
+        SaveAddress &
+        menuPopup .~
+        False
+      ]
+    NewAccount ->
+      [ Model $
+        model & confirmTitle ?~ "New Account" & confirmAccept .~ "Create" &
+        confirmCancel .~
+        "Cancel" &
+        confirmEvent .~
+        SaveAccount &
+        menuPopup .~
+        False
+      ]
+    NewWallet ->
+      [ Model $
+        model & confirmTitle ?~ "New Wallet" & confirmAccept .~ "Create" &
+        confirmCancel .~
+        "Cancel" &
+        confirmEvent .~
+        SaveWallet &
+        menuPopup .~
+        False
+      ]
+    ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
+    SaveAddress ->
+      [ if T.length (model ^. mainInput) > 1
+          then Event $ ShowMsg $ "You saved address: " <> model ^. mainInput
+          else Event $ ShowError "Invalid input"
+      , Event ConfirmCancel
+      ]
+    SaveAccount ->
+      [ if T.length (model ^. mainInput) > 1
+          then Event $ ShowMsg $ "You saved account: " <> model ^. mainInput
+          else Event $ ShowError "Invalid input"
+      , Event ConfirmCancel
+      ]
+    SaveWallet ->
+      [ if T.length (model ^. mainInput) > 1
+          then Event $ ShowMsg $ "You saved wallet: " <> model ^. mainInput
+          else Event $ ShowError "Invalid input"
+      , Event ConfirmCancel
+      ]
     SetPool p ->
       [ Model $ model & selPool .~ p
       , Task $
@@ -463,6 +626,15 @@ handleEvent wenv node model evt =
             Just acc -> runNoLoggingT $ getAddresses dbPool $ entityKey acc
       , Event $ SetPool Orchard
       ]
+    SwitchWal i ->
+      [ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
+      , Task $
+        LoadAccs <$> do
+          dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
+          case selectWallet i of
+            Nothing -> return []
+            Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
+      ]
     CopyAddr a ->
       [ setClipboardData $
         ClipboardText $
@@ -484,12 +656,17 @@ handleEvent wenv node model evt =
       ]
     LoadTxs t -> [Model $ model & transactions .~ t]
     LoadAddrs a -> [Model $ model & addresses .~ a, Event $ SetPool Orchard]
-    CloseMsg -> [Model $ model & msg .~ Nothing]
+    LoadAccs a -> [Model $ model & accounts .~ a, Event $ SwitchAcc 0]
+    CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
   where
     currentWallet =
       if null (model ^. wallets)
         then Nothing
         else Just ((model ^. wallets) !! (model ^. selWallet))
+    selectWallet i =
+      if null (model ^. wallets)
+        then Nothing
+        else Just ((model ^. wallets) !! i)
     currentAccount =
       if null (model ^. accounts)
         then Nothing
@@ -556,6 +733,15 @@ runZenithGUI config = do
                   Orchard
                   qr
                   False
+                  False
+                  False
+                  False
+                  ""
+                  Nothing
+                  ""
+                  ""
+                  SaveAddress
+                  False
           startApp model handleEvent buildUI params
     Left e -> do
       initDb dbFilePath
@@ -580,6 +766,15 @@ runZenithGUI config = do
               Orchard
               Nothing
               False
+              False
+              False
+              False
+              ""
+              Nothing
+              ""
+              ""
+              SaveAddress
+              False
       startApp model handleEvent buildUI params
   where
     params =

src/Zenith/GUI/Theme.hs

@@ -4,6 +4,7 @@ module Zenith.GUI.Theme
   ( zenithTheme
   ) where
 
+import Data.Default
 import Lens.Micro ((&), (+~), (.~), (?~), (^.), at, set)
 import Monomer
 import Monomer.Core.Themes.BaseTheme
@@ -12,49 +13,72 @@ import Monomer.Graphics (rgbHex, transparent)
 import Monomer.Graphics.ColorTable
 import qualified Monomer.Lens as L
 
+baseTextStyle :: TextStyle
+baseTextStyle = def & L.fontSize ?~ FontSize 10 & L.fontColor ?~ black
+
+hiliteTextStyle :: TextStyle
+hiliteTextStyle = def & L.fontSize ?~ FontSize 10 & L.fontColor ?~ white
+
 zenithTheme :: Theme
 zenithTheme =
-  baseTheme zgoThemeColors & L.basic . L.labelStyle . L.text ?~
-  TextStyle
-    Nothing
-    (Just . FontSize $ 10)
-    Nothing
-    Nothing
-    (Just black)
-    Nothing
-    Nothing
-    Nothing
-    Nothing
-    Nothing
-    Nothing &
+  baseTheme zgoThemeColors & L.basic . L.labelStyle . L.text ?~ baseTextStyle &
   L.hover .
   L.tooltipStyle . L.text ?~
-  TextStyle
-    Nothing
-    (Just . FontSize $ 10)
-    Nothing
-    Nothing
-    (Just black)
-    Nothing
-    Nothing
-    Nothing
-    Nothing
-    Nothing
-    Nothing &
+  baseTextStyle &
   L.hover .
   L.labelStyle . L.text ?~
-  TextStyle
-    Nothing
-    (Just . FontSize $ 10)
-    Nothing
-    Nothing
-    (Just black)
-    Nothing
-    Nothing
-    Nothing
-    Nothing
-    Nothing
-    Nothing
+  baseTextStyle &
+  L.basic .
+  L.dialogTitleStyle . L.text ?~
+  (baseTextStyle & L.fontSize ?~ FontSize 12 & L.font ?~ "Bold") &
+  L.hover .
+  L.dialogTitleStyle . L.text ?~
+  (baseTextStyle & L.fontSize ?~ FontSize 12 & L.font ?~ "Bold") &
+  L.basic .
+  L.btnStyle . L.text ?~
+  baseTextStyle &
+  L.hover .
+  L.btnStyle . L.text ?~
+  baseTextStyle &
+  L.focus .
+  L.btnStyle . L.text ?~
+  baseTextStyle &
+  L.focusHover .
+  L.btnStyle . L.text ?~
+  baseTextStyle &
+  L.active .
+  L.btnStyle . L.text ?~
+  baseTextStyle &
+  L.basic .
+  L.btnMainStyle . L.text ?~
+  hiliteTextStyle &
+  L.hover .
+  L.btnMainStyle . L.text ?~
+  hiliteTextStyle &
+  L.focus .
+  L.btnMainStyle . L.text ?~
+  hiliteTextStyle &
+  L.focusHover .
+  L.btnMainStyle . L.text ?~
+  hiliteTextStyle &
+  L.active .
+  L.btnMainStyle . L.text ?~
+  hiliteTextStyle &
+  L.basic .
+  L.textFieldStyle . L.text ?~
+  baseTextStyle &
+  L.hover .
+  L.textFieldStyle . L.text ?~
+  baseTextStyle &
+  L.focus .
+  L.textFieldStyle . L.text ?~
+  baseTextStyle &
+  L.active .
+  L.textFieldStyle . L.text ?~
+  baseTextStyle &
+  L.focusHover .
+  L.textFieldStyle . L.text ?~
+  baseTextStyle
 
 zenithThemeColors :: BaseThemeColors
 zenithThemeColors =
@@ -70,10 +94,10 @@ zenithThemeColors =
     , btnText = gray02
     , btnTextDisabled = gray01
     , btnMainFocusBorder = blue08
-    , btnMainBgBasic = blue05b
-    , btnMainBgHover = blue06
-    , btnMainBgFocus = blue05c
-    , btnMainBgActive = blue05
+    , btnMainBgBasic = btnColor
+    , btnMainBgHover = btnHiLite
+    , btnMainBgFocus = btnColor
+    , btnMainBgActive = btnHiLite
     , btnMainBgDisabled = blue04
     , btnMainText = white
     , btnMainTextDisabled = gray08
@@ -149,10 +173,10 @@ zgoThemeColors =
     , btnText = gray02
     , btnTextDisabled = gray02
     , btnMainFocusBorder = blue09
-    , btnMainBgBasic = blue05b
-    , btnMainBgHover = blue06
-    , btnMainBgFocus = blue05c
-    , btnMainBgActive = blue05
+    , btnMainBgBasic = btnColor
+    , btnMainBgHover = btnHiLite
+    , btnMainBgFocus = btnColor
+    , btnMainBgActive = btnHiLite
     , btnMainBgDisabled = blue04
     , btnMainText = white
     , btnMainTextDisabled = white
@@ -217,6 +241,10 @@ zgoThemeColors =
 
 --black = rgbHex "#000000"
 {-white = rgbHex "#FFFFFF"-}
+btnColor = rgbHex "#ff5722" --rgbHex "#1818B2"
+
+btnHiLite = rgbHex "#207DE8"
+
 blue01 = rgbHex "#002159"
 
 blue02 = rgbHex "#01337D"

zenith.cabal

@@ -46,6 +46,7 @@ library
     , base64-bytestring
     , brick
     , bytestring
+    , data-default
     , esqueleto
     , resource-pool
     , binary