Current time in model

This commit is contained in:
Greg Shuflin 2023-03-01 10:04:30 -08:00
parent 2f1489aebb
commit 9655a8a126
1 changed files with 8 additions and 8 deletions

View File

@ -10,8 +10,9 @@ import TextShow
import Lib import Lib
newtype AppModel = AppModel { data AppModel = AppModel {
_clickCount :: Int _clickCount :: Int,
_curTimeRepresentation :: String
} deriving (Eq, Show) } deriving (Eq, Show)
data AppEvent = AppInit | AppIncrease deriving (Show, Eq) data AppEvent = AppInit | AppIncrease deriving (Show, Eq)
@ -22,9 +23,9 @@ buildUI
:: WidgetEnv AppModel AppEvent :: WidgetEnv AppModel AppEvent
-> AppModel -> AppModel
-> WidgetNode AppModel AppEvent -> WidgetNode AppModel AppEvent
buildUI wenv model = widgetTree where buildUI _wenv model = widgetTree where
widgetTree = vstack [ widgetTree = vstack [
label "Hello world", label $ "Cur time: " <> showt (model ^. curTimeRepresentation),
spacer, spacer,
hstack [ hstack [
label $ "Click count: " <> showt (model ^. clickCount), label $ "Click count: " <> showt (model ^. clickCount),
@ -39,7 +40,7 @@ handleEvent
-> AppModel -> AppModel
-> AppEvent -> AppEvent
-> [AppEventResponse AppModel AppEvent] -> [AppEventResponse AppModel AppEvent]
handleEvent wenv node model evt = case evt of handleEvent _wenv _node model evt = case evt of
AppInit -> [] AppInit -> []
AppIncrease -> [Model (model & clickCount +~ 1)] AppIncrease -> [Model (model & clickCount +~ 1)]
@ -47,12 +48,12 @@ handleEvent wenv node model evt = case evt of
main :: IO () main :: IO ()
main = do main = do
putStrLn "haskell-clock" putStrLn "haskell-clock"
t <- curTimeString
putStrLn t
guiMain guiMain
guiMain :: IO () guiMain :: IO ()
guiMain = do guiMain = do
curTime <- curTimeString
let model = AppModel 0 curTime
startApp model handleEvent buildUI config startApp model handleEvent buildUI config
where where
config = [ config = [
@ -62,4 +63,3 @@ guiMain = do
appFontDef "Regular" "/usr/share/fonts/TTF/FiraCode-Regular.ttf", appFontDef "Regular" "/usr/share/fonts/TTF/FiraCode-Regular.ttf",
appInitEvent AppInit appInitEvent AppInit
] ]
model = AppModel 0