haskell-clock/app/Main.hs

{-# 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
      ]