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