zenith/src/Zenith/GUI.hs
2024-05-23 16:20:43 -05:00

100 lines
2.7 KiB
Haskell

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Zenith.GUI where
import Control.Exception (throwIO, try)
import Control.Monad.Logger (runNoLoggingT)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T
import Database.Persist
import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
import Lens.Micro.TH
import Monomer
import TextShow
import ZcashHaskell.Types
( ZcashNet(..)
, ZebraGetBlockChainInfo(..)
, ZebraGetInfo(..)
)
import Zenith.Core
import Zenith.DB
import Zenith.Types
data AppModel = AppModel
{ _network :: !ZcashNet
, _wallets :: ![Entity ZcashWallet]
, _msg :: !(Maybe T.Text)
} deriving (Eq, Show)
makeLenses ''AppModel
data AppEvent
= AppInit
| ShowMsg !T.Text
| CloseMsg
deriving (Eq, Show)
buildUI ::
WidgetEnv AppModel AppEvent -> AppModel -> WidgetNode AppModel AppEvent
buildUI wenv model = widgetTree
where
widgetTree =
zstack
[ vstack
[ label "Hello World"
, spacer
, hstack [button "Try the overlay" $ ShowMsg "It works!"]
] `styleBasic`
[padding 10]
, msgOverlay `nodeVisible` isJust (model ^. msg)
]
msgOverlay =
alert CloseMsg $
hstack [filler, label $ fromMaybe "" (model ^. msg), filler]
handleEvent ::
WidgetEnv AppModel AppEvent
-> WidgetNode AppModel AppEvent
-> AppModel
-> AppEvent
-> [AppEventResponse AppModel AppEvent]
handleEvent wenv node model evt =
case evt of
AppInit -> []
ShowMsg t -> [Model $ model & msg ?~ t]
CloseMsg -> [Model $ model & msg .~ Nothing]
runZenithGUI :: Config -> IO ()
runZenithGUI config = do
let host = c_zebraHost config
let port = c_zebraPort config
let dbFilePath = c_dbPath config
pool <- runNoLoggingT $ initPool dbFilePath
w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
case w of
Right zebra -> do
bc <-
try $ checkBlockChain host port :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
initDb dbFilePath
walList <- getWallets pool $ zgb_net chainInfo
let model = AppModel (zgb_net chainInfo) walList Nothing
startApp model handleEvent buildUI params
Left e ->
print $
"No Zebra node available on port " <>
show port <> ". Check your configuration."
where
params =
[ appWindowTitle "Zenith - Zcash Full Node Wallet"
, appTheme darkTheme
, appFontDef "Regular" "./assets/DejaVuSansMono.ttf"
, appFontDef "Bold" "./assets/DejaVuSansMono-Bold.ttf"
, appFontDef "Italic" "./assets/DejaVuSansMono-Oblique.ttf"
, appInitEvent AppInit
]