{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main (main) where import Control.Lens import Monomer import TextShow import Lib data AppModel = AppModel { _clickCount :: Int, _curTimeRepresentation :: String } deriving (Eq, Show) data AppEvent = AppInit | AppIncrease deriving (Show, Eq) makeLenses 'AppModel clockWidget :: WidgetNode s e clockWidget = clockWidget_ def clockWidget_ def = defaultWidgetNode "clock" newWidget where newWidget = createSingle () def { singleMerge = merge, singleHandleEvent = handleEvent, singleHandleMessage = handleMessage, singleGetSizeReq = getSizeReq, singleRender = render } merge wenv node oldNode oldState = result where newNode = node & L.widget .~ makeCanvas cfg oldState result = resultNode newNode buildUI :: WidgetEnv AppModel AppEvent -> AppModel -> WidgetNode AppModel AppEvent buildUI _wenv model = widgetTree where widgetTree = vstack [ label $ showt (model ^. curTimeRepresentation), 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] handleEvent _wenv _node model evt = case evt of AppInit -> [] AppIncrease -> [Model (model & clickCount +~ 1)] main :: IO () main = do putStrLn "haskell-clock" guiMain guiMain :: IO () guiMain = do curTime <- curTimeString let model = AppModel 0 curTime 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 ]