2023-03-01 00:07:42 -08:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
|
2023-02-24 02:06:02 -08:00
|
|
|
module Main (main) where
|
|
|
|
|
2023-03-01 00:07:42 -08:00
|
|
|
import Control.Lens
|
|
|
|
|
|
|
|
import Monomer
|
|
|
|
import TextShow
|
|
|
|
|
2023-02-24 02:06:02 -08:00
|
|
|
import Lib
|
|
|
|
|
2023-03-01 10:04:30 -08:00
|
|
|
data AppModel = AppModel {
|
|
|
|
_clickCount :: Int,
|
|
|
|
_curTimeRepresentation :: String
|
2023-03-01 00:07:42 -08:00
|
|
|
} deriving (Eq, Show)
|
|
|
|
|
|
|
|
data AppEvent = AppInit | AppIncrease deriving (Show, Eq)
|
|
|
|
|
|
|
|
makeLenses 'AppModel
|
|
|
|
|
|
|
|
buildUI
|
|
|
|
:: WidgetEnv AppModel AppEvent
|
|
|
|
-> AppModel
|
|
|
|
-> WidgetNode AppModel AppEvent
|
2023-03-01 10:04:30 -08:00
|
|
|
buildUI _wenv model = widgetTree where
|
2023-03-01 00:07:42 -08:00
|
|
|
widgetTree = vstack [
|
2023-03-01 10:04:30 -08:00
|
|
|
label $ "Cur time: " <> showt (model ^. curTimeRepresentation),
|
2023-03-01 00:07:42 -08:00
|
|
|
spacer,
|
|
|
|
hstack [
|
|
|
|
label $ "Click count: " <> showt (model ^. clickCount),
|
|
|
|
spacer,
|
|
|
|
button "Increase count" AppIncrease
|
|
|
|
]
|
|
|
|
] `styleBasic` [padding 10]
|
|
|
|
|
|
|
|
handleEvent
|
|
|
|
:: WidgetEnv AppModel AppEvent
|
|
|
|
-> WidgetNode AppModel AppEvent
|
|
|
|
-> AppModel
|
|
|
|
-> AppEvent
|
|
|
|
-> [AppEventResponse AppModel AppEvent]
|
2023-03-01 10:04:30 -08:00
|
|
|
handleEvent _wenv _node model evt = case evt of
|
2023-03-01 00:07:42 -08:00
|
|
|
AppInit -> []
|
|
|
|
AppIncrease -> [Model (model & clickCount +~ 1)]
|
|
|
|
|
|
|
|
|
2023-02-24 02:06:02 -08:00
|
|
|
main :: IO ()
|
2023-02-24 02:40:13 -08:00
|
|
|
main = do
|
|
|
|
putStrLn "haskell-clock"
|
2023-03-01 00:07:42 -08:00
|
|
|
guiMain
|
2023-02-24 02:40:13 -08:00
|
|
|
|
2023-03-01 00:07:42 -08:00
|
|
|
guiMain :: IO ()
|
|
|
|
guiMain = do
|
2023-03-01 10:04:30 -08:00
|
|
|
curTime <- curTimeString
|
|
|
|
let model = AppModel 0 curTime
|
2023-03-01 00:07:42 -08:00
|
|
|
startApp model handleEvent buildUI config
|
|
|
|
where
|
|
|
|
config = [
|
|
|
|
appWindowTitle "Haskell Clock",
|
|
|
|
--appWindowIcon "./assets/images/icon.png",
|
|
|
|
appTheme darkTheme,
|
|
|
|
appFontDef "Regular" "/usr/share/fonts/TTF/FiraCode-Regular.ttf",
|
|
|
|
appInitEvent AppInit
|
|
|
|
]
|