Refactor/reformat examples code

2024-09-11 12:05:35 +03:00 · 2021-07-24 13:47:57 -03:00 · 2021-07-24 13:47:57 -03:00 · efa89f0ed3
commit efa89f0ed3
parent 94fbb8d507
12 changed files with 252 additions and 197 deletions
--- a/.ghcid
+++ b/.ghcid
@ -1,3 +1,3 @@
--command "stack repl --main-is monomer:exe:ticker"
+--command "stack repl --main-is monomer:exe:generative"
 --test ":main"
 --restart=package.yaml
--- a/examples/books/Main.hs
+++ b/examples/books/Main.hs
@ -18,71 +18,78 @@ import Monomer

 import qualified Monomer.Lens as L

+type BooksWenv = WidgetEnv BooksModel BooksEvt
+type BooksNode = WidgetNode BooksModel BooksEvt
+
+bookImage :: Maybe Int -> Text -> WidgetNode s BooksEvt
+bookImage imgId size = maybe filler coverImg imgId where
+  baseUrl = "http://covers.openlibrary.org/b/id/<id>-<size>.jpg"
+  imgUrl i = T.replace "<size>" size $ T.replace "<id>" (showt i) baseUrl
+  coverImg i = image_ (imgUrl i) [fitHeight, alignRight]
+
+bookRow :: BooksWenv -> Book -> BooksNode
+bookRow wenv b = row where
+  rowBgColor = wenv ^. L.theme . L.userColorMap . at "rowBgColor" . non def
+  publishYear = maybe "" showt (b ^. year)
+
+  rowContent b = hstack [
+      vstack [
+        label_ (b ^. title) [resizeFactor 1]
+          `style` [textFont "Medium", textSize 16],
+        spacer,
+        label_ (T.intercalate ", " (b ^. authors)) [resizeFactor 1]
+          `style` [textSize 14]
+      ],
+      filler,
+      vstack [
+        label publishYear `style` [width 50, textSize 14],
+        spacer
+      ],
+      bookImage (b ^. cover) "S" `style` [width 35]
+    ]
+
+  row = box_ cfg content `style` [padding 10, paddingT 0] where
+    cfg = [expandContent, onClick (BooksShowDetails b)]
+    content = rowContent b
+      `style` [height 80, padding 20, radius 5]
+      `hover` [bgColor rowBgColor, cursorIcon CursorHand]
+
+bookDetail :: Book -> WidgetNode s BooksEvt
+bookDetail b = content `style` [minWidth 500, paddingH 20] where
+  hasCover = isJust (b ^. cover)
+  publishYear = maybe "" showt (b ^. year)
+
+  shortLabel value = label value `style` [textFont "Medium", textTop]
+  longLabel value = label_ value [multiLine, ellipsis, trimSpaces]
+
+  content = hstack . concat $ [[
+    vstack [
+      longLabel (b ^. title)
+        `style` [textSize 20, textFont "Medium"],
+      spacer,
+      longLabel (T.intercalate ", " (b ^. authors))
+        `style` [textSize 16],
+      spacer,
+      label publishYear
+        `style` [textSize 14]
+    ]],
+    [filler | hasCover],
+    [bookImage (b ^. cover) "M" `style` [width 200] | hasCover]
+    ]
+
 buildUI
  :: WidgetEnv BooksModel BooksEvt
  -> BooksModel
  -> WidgetNode BooksModel BooksEvt
 buildUI wenv model = widgetTree where
  sectionBgColor = wenv ^. L.theme . L.sectionColor
-  rowBgColor = wenv ^. L.theme . L.userColorMap . at "rowBgColor" . non def
-  bookImage imgId size = maybe filler coverImg imgId where
-    baseUrl = "http://covers.openlibrary.org/b/id/<id>-<size>.jpg"
-    imgUrl i = T.replace "<size>" size $ T.replace "<id>" (showt i) baseUrl
-    coverImg i = image_ (imgUrl i) [fitHeight, alignRight]
-  bookRow b = box_ cfg content `style` [padding 10, paddingT 0] where
-    cfg = [expandContent, onClick (BooksShowDetails b)]
-    content = bookRowContent b
-      `style` [bgColor rowBgColor, height 80, padding 20, radius 5]
-      `hover` [bgColor gray, cursorIcon CursorHand]
-  bookRowContent b = hstack [
-      vstack [
-        hstack [
-          label "Title: " `style` [textFont "Bold"],
-          label_ (b ^. title) [resizeFactor 1]
-        ],
-        spacer,
-        hstack [
-          label "Authors: " `style` [textFont "Bold"],
-          label_ (T.intercalate ", " (b ^. authors)) [resizeFactor 1]
-        ]
-      ],
-      filler,
-      vstack [
-        hstack [
-          label "Year: " `style` [textFont "Bold"],
-          label $ maybe "" showt (b ^. year)
-        ]
-      ] `style` [width 100],
-      bookImage (b ^. cover) "S" `style` [width 35]
-    ]
-  bookDetail b = content `style` [minWidth 500, paddingH 20] where
-    hasCover = isJust (b ^. cover)
-    shortLabel value = label value `style` [textFont "Bold", textTop]
-    longLabel value = label_ value [multiLine, ellipsis, trimSpaces]
-    content = hstack . concat $ [[
-      vstack [
-        hstack [
-          shortLabel "Title: ",
-          longLabel (b ^. title)
-        ],
-        spacer,
-        hstack [
-          shortLabel "Authors: ",
-          longLabel (T.intercalate ", " (b ^. authors))
-        ],
-        spacer,
-        hstack [
-          shortLabel "Year: ",
-          label $ maybe "" showt (b ^. year)
-        ]
-      ]],
-      [filler | hasCover],
-      [bookImage (b ^. cover) "M" `style` [width 200] | hasCover]
-      ]
+
  bookOverlay = alert BooksCloseDetails content where
    content = maybe spacer bookDetail (model ^. selected)
+
  searchOverlay = box content `style` [bgColor (darkGray & L.a .~ 0.8)] where
    content = label "Searching" `style` [textSize 20, textColor black]
+
  searchForm = keystroke [("Enter", BooksSearch)] $ vstack [
      hstack [
        label "Query:",
@ -92,26 +99,20 @@ buildUI wenv model = widgetTree where
        mainButton "Search" BooksSearch
      ] `style` [bgColor sectionBgColor, padding 25]
    ]
+
  countLabel = label caption `style` [padding 10] where
    caption = "Books (" <> showt (length $ model ^. books) <> ")"
+
  widgetTree = zstack [
      vstack [
        searchForm,
        countLabel,
-        vscroll (vstack (bookRow <$> model ^. books)) `key` "mainScroll"
+        vscroll (vstack (bookRow wenv <$> model ^. books)) `key` "mainScroll"
      ],
      bookOverlay `visible` isJust (model ^. selected),
      searchOverlay `visible` model ^. searching
    ]

-{-
-searchBgColor :: Color
-searchBgColor = rgbHex "#404040"
-
-rowBgColor :: Color
-rowBgColor = rgbHex "#212121"
-}
-
 handleEvent
  :: WidgetEnv BooksModel BooksEvt
  -> WidgetNode BooksModel BooksEvt
@ -150,14 +151,18 @@ main = do
  where
    config = [
      appWindowTitle "Book search",
-      appTheme lightTheme,
+      appTheme customLightTheme,
      appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
-      appFontDef "Bold" "./assets/fonts/Roboto-Bold.ttf",
+      appFontDef "Medium" "./assets/fonts/Roboto-Medium.ttf",
      appInitEvent BooksInit
      ]
    initBook = Book "This is my book" ["Author1", "Author 2"] (Just 2000) (Just 1234)
    initModel = BooksModel "pedro paramo" False (Just initBook) [initBook]
-    customLightTheme = lightTheme
-      & L.userColorMap . at "rowBgColor" ?~ rgbHex "#636363"
-    customDarkTheme = darkTheme
-      & L.userColorMap . at "rowBgColor" ?~ rgbHex "#212121"
+
+customLightTheme :: Theme
+customLightTheme = lightTheme
+  & L.userColorMap . at "rowBgColor" ?~ rgbHex "#ECECEC"
+
+customDarkTheme :: Theme
+customDarkTheme = darkTheme
+  & L.userColorMap . at "rowBgColor" ?~ rgbHex "#656565"
--- a/examples/generative/Main.hs
+++ b/examples/generative/Main.hs
@ -4,6 +4,7 @@ module Main where

 import Control.Lens
 import Data.Default
+import Data.List (intersperse)
 import Data.Maybe
 import Data.Text (Text)
 import TextShow
@ -17,53 +18,67 @@ import Widgets.CirclesGrid

 import qualified Monomer.Lens as L

-buildUI
-  :: WidgetEnv GenerativeModel GenerativeEvt
-  -> GenerativeModel
-  -> WidgetNode GenerativeModel GenerativeEvt
+type GenerativeWenv = WidgetEnv GenerativeModel GenerativeEvt
+type GenerativeNode = WidgetNode GenerativeModel GenerativeEvt
+
+buildUI :: GenerativeWenv -> GenerativeModel -> GenerativeNode
 buildUI wenv model = widgetTree where
+  sectionBg = wenv ^. L.theme . L.sectionColor
+
  seedDropdown lens = textDropdown_ lens seedList seedDesc []
-  widgetCircleCfg = vstack [
+
+  widgetCircleCfg = vstack $ intersperse spacer [
      label "Width",
-      dial_ (circlesCfg . itemWidth) 10 50 [dragRate 0.5],
-      label "Random seed",
+      vstack [
+        dial_ (circlesCfg . itemWidth) 20 50 [dragRate 0.5],
+        labelS (model ^. circlesCfg . itemWidth) `style` [textSize 14, textCenter]
+      ],
+      label "Seed",
      seedDropdown (circlesCfg . seed)
    ]
-  widgetBoxCfg = vstack [
+
+  widgetBoxCfg = vstack $ intersperse spacer [
      label "Width",
-      dial_ (boxesCfg . itemWidth) 10 50 [dragRate 0.5],
+      vstack [
+        dial_ (boxesCfg . itemWidth) 20 50 [dragRate 0.5],
+        labelS (model ^. boxesCfg . itemWidth) `style` [textSize 14, textCenter]
+      ],
+      label "Seed",
+      seedDropdown (boxesCfg . seed),
+      separatorLine,
      label "Palette type",
      textDropdown (boxesCfg . paletteType) [1..4],
      label "Palette size",
-      dial_ (boxesCfg . paletteSize) 1 50 [dragRate 0.5],
-      label "Random seed",
-      seedDropdown (boxesCfg . seed)
+      dial_ (boxesCfg . paletteSize) 1 50 [dragRate 0.5]
    ]
+
  widgetTree = vstack [
      hstack [
-        label "Type: ",
+        label "Type:",
+        spacer,
        textDropdown_ activeGen genTypes genTypeDesc [] `key` "activeType",
        spacer,
-        hstack [
-          label "Show config: ",
-          checkbox showCfg
-        ] `style` [width 150]
-      ] `style` [padding 3],
+        labeledCheckbox "Show config:" showCfg
+      ] `style` [padding 20, bgColor sectionBg],
      zstack [
        hstack [
-          circlesGrid (model ^. circlesCfg),
-          widgetCircleCfg `visible` model ^. showCfg `style` [paddingH 3, width 150]
+          circlesGrid (model ^. circlesCfg) `style` [padding 20],
+          widgetCircleCfg
+            `visible` model ^. showCfg
+            `style` [padding 20, width 200, bgColor sectionBg]
        ] `visible` (model ^. activeGen == CirclesGrid),
        hstack [
-          boxesPalette (model ^. boxesCfg),
-          widgetBoxCfg `visible` model ^. showCfg `style` [paddingH 3, width 150]
+          boxesPalette (model ^. boxesCfg) `style` [padding 20],
+          widgetBoxCfg
+            `visible` model ^. showCfg
+            `style` [padding 20, width 200, bgColor sectionBg]
        ] `visible` (model ^. activeGen == BoxesPalette)
      ]
    ]

 handleEvent
-  :: WidgetEnv GenerativeModel GenerativeEvt
-  -> WidgetNode GenerativeModel GenerativeEvt
+  :: GenerativeWenv
+  -> GenerativeNode
  -> GenerativeModel
  -> GenerativeEvt
  -> [EventResponse GenerativeModel GenerativeEvt GenerativeModel ()]
--- a/examples/generative/Widgets/BoxesPalette.hs
+++ b/examples/generative/Widgets/BoxesPalette.hs
@ -85,7 +85,8 @@ makeBoxesPalette cfg state = widget where
    colors <- makePalette (cfg ^. paletteType) (cfg ^. paletteSize)
    mapM_ (drawRectangle renderer state colors vp cols rows) [0..cols * rows - 1]
    where
-      vp = node ^. L.info . L.viewport
+      style = activeStyle wenv node
+      vp = getContentArea style node
      iw = cfg ^. itemWidth
      fw = 0.5 + 5 * (state ^. mouseX - vp ^. L.x) / vp ^. L.w
      fh = 0.5 + 5 * (state ^. mouseY - vp ^. L.y) / vp ^. L.h
--- a/examples/generative/Widgets/CirclesGrid.hs
+++ b/examples/generative/Widgets/CirclesGrid.hs
@ -77,7 +77,8 @@ makeCirclesGrid cfg state = widget where

    mapM_ (drawCircle renderer state vp iw cols) [0..cols * rows - 1]
    where
-      vp = node ^. L.info . L.viewport
+      style = activeStyle wenv node
+      vp = getContentArea style node
      iw = cfg ^. itemWidth
      cols = round (vp ^. L.w / iw)
      rows = round (vp ^. L.h / iw)
--- a/examples/ticker/Main.hs
+++ b/examples/ticker/Main.hs
@ -30,65 +30,81 @@ import TickerTypes

 import qualified Monomer.Lens as L

-buildUI
-  :: WidgetEnv TickerModel TickerEvt
-  -> TickerModel
-  -> WidgetNode TickerModel TickerEvt
-buildUI wenv model = widgetTree where
-  sectionColor = wenv ^. L.theme . L.sectionColor
+type TickerWenv = WidgetEnv TickerModel TickerEvt
+type TickerNode = WidgetNode TickerModel TickerEvt
+
+tickerPct :: Ticker -> TickerNode
+tickerPct t = pctLabel where
+  diff = toRealFloat $ 100 * (t ^. close - t ^. open)
+  pct = diff / toRealFloat (t ^. open)
+
+  pctText = formatTickerPct (fromFloatDigits pct) <> "%"
+  pctColor
+    | abs pct < 0.01 = rgbHex "#428FE0"
+    | pct > 0 = rgbHex "#51A39A"
+    | otherwise = rgbHex "#E25141"
+
+  pctLabel = label pctText `style` [width 100, textRight, textColor pctColor]
+
+tickerRow :: TickerWenv -> Int -> Ticker -> TickerNode
+tickerRow wenv idx t = row where
  dragColor = rgbaHex "#D3D3D3" 0.5
  rowSep = rgbaHex "#A9A9A9" 0.5
  rowBg = wenv ^. L.theme . L.userColorMap . at "rowBg" . non def
+
  trashBg = wenv ^. L.theme . L.userColorMap . at "trashBg" . non def
  trashFg = wenv ^. L.theme . L.userColorMap . at "trashFg" . non def
  trashIcon action = button remixDeleteBinLine action
    `style` [textFont "Remix", textMiddle, textColor trashFg, bgColor transparent, border 0 transparent]
    `hover` [bgColor trashBg]
-  dropTicker pair widget = dropTarget_ (TickerMovePair pair) [dropTargetStyle [bgColor darkGray]] widget
-  tickerPct t = pctLabel where
-    diff = toRealFloat $ 100 * (t ^. close - t ^. open)
-    pct = diff / toRealFloat (t ^. open)
-    pctText = formatTickerPct (fromFloatDigits pct) <> "%"
-    pctColor
-      | abs pct < 0.01 = rgbHex "#428FE0"
-      | pct > 0 = rgbHex "#51A39A"
-      | otherwise = rgbHex "#E25141"
-    pctLabel = label pctText `style` [width 100, textRight, textColor pctColor]
-  tickerItem idx t = hstack [
+
+  dropTicker pair
+    = dropTarget_ (TickerMovePair pair) [dropTargetStyle [bgColor darkGray]]
+
+  tickerInfo = hstack [
+      label (t ^. symbolPair) `style` [width 100],
+      spacer,
+      label (formatTickerValue (t ^. close))
+        `style` [textRight, minWidth 100],
+      spacer,
+      tickerPct t
+    ] `style` [cursorHand]
+
+  row = hstack [
      dropTicker (t ^. symbolPair) $
-        draggable_ (t ^. symbolPair) [draggableStyle [bgColor dragColor]] $
-          hstack [
-            label (t ^. symbolPair) `style` [width 100],
-            spacer,
-            label (formatTickerValue (t ^. close))
-              `style` [textRight, minWidth 100],
-            spacer,
-            tickerPct t
-          ] `style` [cursorHand],
+        draggable_ (t ^. symbolPair) [draggableStyle [bgColor dragColor]]
+          tickerInfo,
      spacer,
      trashIcon (TickerRemovePairBegin (t ^. symbolPair))
    ] `style` [padding 10, borderB 1 rowSep]
      `hover` [bgColor rowBg]
+
+buildUI :: TickerWenv -> TickerModel -> TickerNode
+buildUI wenv model = widgetTree where
+  sectionBg = wenv ^. L.theme . L.sectionColor
+
  tickerList = vstack tickerRows where
    orderedTickers = (\e -> model ^? tickers . ix e) <$> model ^. symbolPairs
    tickerFade idx t = fadeOut_ [onFinished action] item `key` (t ^. symbolPair) where
      action = TickerRemovePair (t ^. symbolPair)
-      item = tickerItem idx t
+      item = tickerRow wenv idx t
    tickerRows = zipWith tickerFade [0..] (catMaybes orderedTickers)
+
  widgetTree = vstack [
      hstack [
-        label "New pair: ",
+        label "New pair:",
+        spacer,
        keystroke [("Enter", TickerAddClick)] $ textField newPair `key` "newPair",
        spacer,
        button "Add" TickerAddClick
-      ] `style` [padding 20, bgColor sectionColor],
-      scroll_ [scrollOverlay] $ tickerList `style` [padding 20, paddingT 10]
+      ] `style` [padding 20, bgColor sectionBg],
+      scroll_ [scrollOverlay] $ tickerList `style` [padding 10]
    ]

 handleEvent
  :: AppEnv
-  -> WidgetEnv TickerModel TickerEvt
-  -> WidgetNode TickerModel TickerEvt
+  -> TickerWenv
+  -> TickerNode
  -> TickerModel
  -> TickerEvt
  -> [EventResponse TickerModel TickerEvt TickerModel ()]
@ -187,7 +203,7 @@ main = do
  where
    config = [
      appWindowTitle "Ticker",
-      appTheme customDarkTheme,
+      appTheme customLightTheme,
      appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
      appFontDef "Remix" "./assets/fonts/remixicon.ttf",
      appInitEvent TickerInit
@ -202,8 +218,8 @@ customLightTheme = lightTheme

 customDarkTheme :: Theme
 customDarkTheme = darkTheme
-  & L.userColorMap . at "rowBg" ?~ rgbHex "#515151"
-  & L.userColorMap . at "trashBg" ?~ rgbHex "#656565"
+  & L.userColorMap . at "rowBg" ?~ rgbHex "#656565"
+  & L.userColorMap . at "trashBg" ?~ rgbHex "#555555"
  & L.userColorMap . at "trashFg" ?~ rgbHex "#909090"

 formatTickerValue :: Scientific -> Text
--- a/examples/ticker/TickerTypes.hs
+++ b/examples/ticker/TickerTypes.hs
@ -6,15 +6,11 @@

 module TickerTypes where

-import Control.Applicative ((<|>))
 import Control.Concurrent.STM.TChan
 import Control.Lens.TH
-import Data.Aeson
 import Data.Default
 import Data.Foldable (asum)
-import Data.Maybe
 import Data.Map (Map)
-import Data.Scientific
 import Data.Text (Text, pack)

 import qualified Data.Map as M
--- a/examples/todo/Main.hs
+++ b/examples/todo/Main.hs
@ -17,47 +17,60 @@ import TodoTypes
 import qualified Monomer.Lens as L
 import qualified Data.Text as T

-buildUI
-  :: WidgetEnv TodoModel TodoEvt
-  -> TodoModel
-  -> WidgetNode TodoModel TodoEvt
-buildUI wenv model = widgetTree where
-  sectionBgColor = wenv ^. L.theme . L.sectionColor
-  statusFontColor = wenv ^. L.theme . L.userColorMap . at "statusFont" . non def
+type TodoWenv = WidgetEnv TodoModel TodoEvt
+type TodoNode = WidgetNode TodoModel TodoEvt
+
+todoRowKey :: Todo -> Text
+todoRowKey todo = "todoRow" <> showt (todo ^. todoId)
+
+todoRow :: TodoWenv -> TodoModel -> Int -> Todo -> TodoNode
+todoRow wenv model idx t = slideWidget `key` todoKey where
+  sectionBg = wenv ^. L.theme . L.sectionColor
  rowButtonColor = wenv ^. L.theme . L.userColorMap . at "rowButton" . non def
  rowSepColor = gray & L.a .~ 0.5

-  todoView idx t = slideWidget `key` todoKey where
-    todoKey = todoRowKey t
-    isLast = idx == length (model ^. todos) - 1
-    todoDone = t ^. status == Done
-    (todoBg, todoFg)
-      | todoDone = (doneBg, doneFg)
-      | otherwise = (pendingBg, pendingFg)
-    todoStatus = labelS (t ^. status)
-      `style` [textFont "Medium", textSize 12, textAscender, textColor todoFg, padding 6, paddingH 8, radius 12, bgColor todoBg]
-    rowButton caption action = button caption action
-      `style` [textFont "Remix", textMiddle, textColor rowButtonColor, bgColor transparent, border 0 transparent]
-      `hover` [bgColor sectionBgColor]
-    todoRow = hstack [
-        vstack [
-          labelS (t ^. todoType) `style` [textSize 12, textColor darkGray],
-          spacer_ [width 5],
-          label (t ^. description) `style` [textThroughline_ todoDone]
-        ],
-        filler,
-        box_ [alignRight] todoStatus `style` [width 80],
-        spacer,
-        rowButton remixEdit2Line (TodoEdit idx t),
-        spacer,
-        rowButton remixDeleteBinLine (TodoDeleteBegin idx t)
-      ] `style` (paddingV 15 : [borderB 1 rowSepColor | not isLast])
-    slideWidget = fadeOut_ [onFinished (TodoDelete idx t)] todoRow
+  todoKey = todoRowKey t
+  todoDone = t ^. status == Done
+  isLast = idx == length (model ^. todos) - 1
+
+  (todoBg, todoFg)
+    | todoDone = (doneBg, doneFg)
+    | otherwise = (pendingBg, pendingFg)
+
+  todoStatus = labelS (t ^. status)
+    `style` [textFont "Medium", textSize 12, textAscender, textColor todoFg, padding 6, paddingH 8, radius 12, bgColor todoBg]
+
+  rowButton caption action = button caption action
+    `style` [textFont "Remix", textMiddle, textColor rowButtonColor, bgColor transparent, border 0 transparent]
+    `hover` [bgColor sectionBg]
+
+  todoInfo = hstack [
+      vstack [
+        labelS (t ^. todoType) `style` [textSize 12, textColor darkGray],
+        spacer_ [width 5],
+        label (t ^. description) `style` [textThroughline_ todoDone]
+      ],
+      filler,
+      box_ [alignRight] todoStatus `style` [width 80],
+      spacer,
+      rowButton remixEdit2Line (TodoEdit idx t),
+      spacer,
+      rowButton remixDeleteBinLine (TodoDeleteBegin idx t)
+    ] `style` (paddingV 15 : [borderB 1 rowSepColor | not isLast])
+
+  slideWidget = fadeOut_ [onFinished (TodoDelete idx t)] todoInfo
+
+
+todoEdit :: TodoWenv -> TodoModel -> TodoNode
+todoEdit wenv model = editNode where
+  sectionBg = wenv ^. L.theme . L.sectionColor
+
  saveTodoBtn = case model ^. action of
    TodoAdding -> mainButton "Add" TodoAdd
    TodoEditing idx -> mainButton "Save" (TodoSave idx)
    _ -> spacer
-  todoEdit = vstack [
+
+  editNode = vstack [
      hstack [
        label "Task:",
        spacer,
@ -84,30 +97,35 @@ buildUI wenv model = widgetTree where
        spacer,
        button "Cancel" TodoCancel
        ]
-    ] `style` [bgColor sectionBgColor, padding 20]
+    ] `style` [bgColor sectionBg, padding 20]
+
+buildUI :: TodoWenv -> TodoModel -> TodoNode
+buildUI wenv model = widgetTree where
+  sectionBg = wenv ^. L.theme . L.sectionColor
+  isEditing = model ^. action /= TodoNone
+
  countLabel = label caption `style` styles where
    caption = "Tasks (" <> showt (length $ model ^. todos) <> ")"
-    styles = [textFont "Regular", textSize 16, padding 20, bgColor sectionBgColor]
-  todoList = vstack (zipWith todoView [0..] (model ^. todos))
-  isEditing = model ^. action /= TodoNone
+    styles = [textFont "Regular", textSize 16, padding 20, bgColor sectionBg]
+
+  todoList = vstack (zipWith (todoRow wenv model) [0..] (model ^. todos))
+
  newButton = mainButton "New" TodoNew `key` "todoNew"
    `visible` not isEditing
+
  widgetTree = vstack [
-      keystroke [("Esc", TodoCancel)] todoEdit
+      keystroke [("Esc", TodoCancel)] (todoEdit wenv model)
        `visible` isEditing,
      countLabel,
      scroll_ [] (todoList `style` [padding 20, paddingT 5]),
      filler,
      box_ [alignRight] newButton
-        `style` [bgColor sectionBgColor, padding 20]
+        `style` [bgColor sectionBg, padding 20]
    ]

-todoRowKey :: Todo -> Text
-todoRowKey todo = "todoRow" <> showt (todo ^. todoId)
-
 handleEvent
-  :: WidgetEnv TodoModel TodoEvt
-  -> WidgetNode TodoModel TodoEvt
+  :: TodoWenv
+  -> TodoNode
  -> TodoModel
  -> TodoEvt
  -> [EventResponse TodoModel TodoEvt TodoModel ()]
@ -169,7 +187,7 @@ main = do
  where
    config = [
      appWindowTitle "Todo list",
-      appTheme customDarkTheme,
+      appTheme customLightTheme,
      appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
      appFontDef "Medium" "./assets/fonts/Roboto-Medium.ttf",
      appFontDef "Bold" "./assets/fonts/Roboto-Bold.ttf",
@ -187,12 +205,12 @@ grayDarker = rgbHex "#2E2E2E"

 customLightTheme :: Theme
 customLightTheme = lightTheme
-  & L.userColorMap . at "statusFont" ?~ grayDarker
+--  & L.userColorMap . at "statusFont" ?~ grayDarker
  & L.userColorMap . at "rowButton" ?~ grayLight

 customDarkTheme :: Theme
 customDarkTheme = darkTheme
-  & L.userColorMap . at "statusFont" ?~ grayDarker
+--  & L.userColorMap . at "statusFont" ?~ grayDarker
  & L.userColorMap . at "rowButton" ?~ gray

 remove :: Int -> [a] -> [a]
--- a/src/Monomer/Core/Themes/BaseTheme.hs
+++ b/src/Monomer/Core/Themes/BaseTheme.hs
@ -212,8 +212,8 @@ baseBasic themeMod = def
  & L.dialStyle . L.fgColor ?~ inputFgBasic themeMod
  & L.dialStyle . L.sndColor ?~ inputSndBasic themeMod
  & L.dialogTitleStyle . L.text ?~ (titleFont & L.fontColor ?~ dialogTitleText themeMod)
-  & L.dialogTitleStyle . L.padding ?~ padding 10 <> paddingB 10
-  & L.dialogFrameStyle . L.padding ?~ padding 10
+  & L.dialogTitleStyle . L.padding ?~ padding 10
+  & L.dialogFrameStyle . L.padding ?~ padding 5
  & L.dialogFrameStyle . L.radius ?~ radius 10
  & L.dialogFrameStyle . L.bgColor ?~ dialogBg themeMod
  & L.dialogFrameStyle . L.border ?~ border 1 (dialogBorder themeMod)
@ -223,8 +223,8 @@ baseBasic themeMod = def
  & L.dialogCloseIconStyle . L.radius ?~ radius 8
  & L.dialogCloseIconStyle . L.sizeReqW ?~ width 16
  & L.dialogCloseIconStyle . L.sizeReqH ?~ width 16
-  & L.dialogButtonsStyle . L.padding ?~ padding 10
-  & L.dialogMsgBodyStyle . L.padding ?~ paddingH 10
+  & L.dialogButtonsStyle . L.padding ?~ padding 20 <> paddingT 10
+  & L.dialogMsgBodyStyle . L.padding ?~ padding 20
  & L.dialogMsgBodyStyle . L.text
    ?~ (normalFont & L.fontColor ?~ dialogText themeMod)
  & L.dialogMsgBodyStyle . L.sizeReqW ?~ maxWidth 600
--- a/src/Monomer/Core/Themes/SampleThemes.hs
+++ b/src/Monomer/Core/Themes/SampleThemes.hs
@ -46,7 +46,7 @@ lightThemeColors = BaseThemeColors {
  btnMainBgDisabled = blue04,
  btnMainText = white,
  btnMainTextDisabled = white,
-  dialogBg = gray09,
+  dialogBg = white,
  dialogBorder = white,
  dialogText = black,
  dialogTitleText = black,
@ -56,7 +56,7 @@ lightThemeColors = BaseThemeColors {
  externalLinkFocus = blue07,
  externalLinkActive = blue06,
  externalLinkDisabled = gray06,
-  iconBg = gray08,
+  iconBg = gray07,
  iconFg = gray01,
  inputIconFg = black,
  inputBorder = gray06,
@ -109,8 +109,8 @@ darkTheme = baseTheme darkThemeColors

 darkThemeColors :: BaseThemeColors
 darkThemeColors = BaseThemeColors {
-  clearColor = gray02,
-  sectionColor = gray03,
+  clearColor = gray03,
+  sectionColor = gray02,
  btnFocusBorder = blue09,
  btnBgBasic = gray07,
  btnBgHover = gray09,
--- a/src/Monomer/Widgets/Composite.hs
+++ b/src/Monomer/Widgets/Composite.hs
@ -95,7 +95,7 @@ import qualified Monomer.Core.Lens as L
 -- | Type of the parent's model
 type ParentModel sp = Typeable sp
 -- | Type of the composite's model
-type CompositeModel s = (Eq s, Typeable s, WidgetModel s)
+type CompositeModel s = (Eq s, WidgetModel s)
 -- | Type of the composite's event
 type CompositeEvent e = WidgetEvent e

@ -115,7 +115,7 @@ type TaskHandler e = IO e
 type ProducerHandler e = (e -> IO ()) -> IO ()

 data CompMsgUpdate
-  = forall s . Typeable s => CompMsgUpdate (s -> s)
+  = forall s . CompositeModel s => CompMsgUpdate (s -> s)

 -- | Response options for an event handler.
 data EventResponse s e sp ep
@ -736,7 +736,7 @@ toParentResult comp state wenv widgetComp result = newResult where
  newResult = WidgetResult newNode newReqs

 evtResponseToRequest
-  :: (Typeable s, Typeable sp, WidgetEvent e, WidgetEvent ep)
+  :: (CompositeModel s, CompositeEvent e, CompositeEvent ep, ParentModel sp)
  => WidgetNode sp ep
  -> WidgetKeyMap s e
  -> EventResponse s e sp ep
@ -790,7 +790,7 @@ getModel
 getModel comp wenv = widgetDataGet (_weModel wenv) (_cmpWidgetData comp)

 toParentReq
-  :: (Typeable s, Typeable sp)
+  :: (CompositeModel s, ParentModel sp)
  => WidgetId
  -> WidgetRequest s e
  -> Maybe (WidgetRequest sp ep)
--- a/tasks.md
+++ b/tasks.md
@ -779,13 +779,16 @@
    - Simple click receives focus, shift+click allows changing values without getting focus
  - Avoid building examples when used as a library.
    - Tried using flags and it works, but it ends up being annoying for testing examples with stack run.
+  - Add hsl function https://stackoverflow.com/questions/2353211/hsl-to-rgb-color-conversion

 Next
  - Document themes and how widgets use them.
  - Add ignoreStyle to widgets that may need it.
  - Maybe spacer should be 8 pixels wide.
  - Rethink activeStyle, activeTheme, active style related function names.
-  - Add hsl function https://stackoverflow.com/questions/2353211/hsl-to-rgb-color-conversion
+    - Order of arguments?
+  - CmbMergeRequired in box?
+  - Generalize fade/slide messages. Add anim suffix.
  - Remove dpr calculations from NanoVGRenderer.
    - Same with FontManager.
    - When testing Windows/Linux, check if scroll rate needs to be adjusted.