Add menu

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

@@ -43,13 +43,20 @@ data AppEvent
   | 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]
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -70,6 +77,9 @@ data AppModel = AppModel
   , _selPool :: !ZcashPool
   , _qrCodeWidget :: !(Maybe QrCode)
   , _accPopup :: !Bool
+  , _walPopup :: !Bool
+  , _menuPopup :: !Bool
+  , _newPopup :: !Bool
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -115,9 +125,21 @@ buildUI wenv model = widgetTree
         ]
     windowHeader =
       hstack
-        [ box_ [onClick WalletClicked, alignMiddle] walletButton `styleBasic`
-          [cursorHand, height 25, padding 3] `styleHover`
-          [bgColor btnHiLite]
+        [ 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 +152,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 +200,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 +233,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)
       ]
@@ -433,9 +512,14 @@ 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]
+    WalletClicked -> [Model $ model & walPopup .~ True]
     AccountClicked -> [Model $ model & accPopup .~ True]
+    MenuClicked -> [Model $ model & menuPopup .~ True]
+    NewClicked -> [Model $ model & newPopup .~ not (model ^. newPopup)]
+    NewAddress -> [Event $ ShowMsg "You clicked new address"]
+    NewAccount -> [Event $ ShowMsg "You clicked new account"]
+    NewWallet -> [Event $ ShowMsg "You clicked new wallet"]
     SetPool p ->
       [ Model $ model & selPool .~ p
       , Task $
@@ -463,6 +547,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 +577,17 @@ handleEvent wenv node model evt =
       ]
     LoadTxs t -> [Model $ model & transactions .~ t]
     LoadAddrs a -> [Model $ model & addresses .~ a, Event $ SetPool Orchard]
+    LoadAccs a -> [Model $ model & accounts .~ a, Event $ SwitchAcc 0]
     CloseMsg -> [Model $ model & msg .~ Nothing]
   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 +654,9 @@ runZenithGUI config = do
                   Orchard
                   qr
                   False
+                  False
+                  False
+                  False
           startApp model handleEvent buildUI params
     Left e -> do
       initDb dbFilePath
@@ -580,6 +681,9 @@ runZenithGUI config = do
               Orchard
               Nothing
               False
+              False
+              False
+              False
       startApp model handleEvent buildUI params
   where
     params =