haskell/src/Main.hs

   1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   2 {-# LANGUAGE LambdaCase #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4
   5 module Main where
   6
   7 import Miso hiding (text_)
   8 import Miso.CSS qualified as CSS
   9 import Miso.Lens
  10 import Miso.Lynx
  11 import Miso.Lynx.Element.View.Event (onTap)
  12 import Miso.String
  13
  14 -- | Application model
  15 newtype Model = Model {_value :: Int}
  16   deriving (Show, Eq, ToMisoString)
  17
  18 value :: Lens Model Int
  19 value = lens _value $ \m v -> m{_value = v}
  20
  21 data Action
  22   = AddOne
  23   | SubtractOne
  24   deriving (Show, Eq)
  25
  26 -- | Entry point for a miso application
  27 main :: IO ()
  28 main =
  29   run $
  30     lynx
  31       counterComponent
  32         { events = lynxEvents
  33         }
  34
  35 counterComponent :: App Model Action
  36 counterComponent = component (Model 0) updateModel viewModel
  37
  38 updateModel ::
  39   Action ->
  40   Transition Model Action
  41 updateModel = \case
  42   AddOne ->
  43     value += 1
  44   SubtractOne ->
  45     value -= 1
  46
  47 -- | Constructs a virtual DOM from a model
  48 viewModel :: Model -> View Model Action
  49 viewModel m =
  50   view_
  51     [ CSS.style_
  52         [ CSS.height "200px"
  53         , CSS.display "flex"
  54         , CSS.alignItems "center"
  55         , CSS.justifyContent "center"
  56         ]
  57     ]
  58     [ view_
  59         [ onTap AddOne
  60         , CSS.style_
  61             [ CSS.backgroundColor CSS.yellow
  62             , CSS.width "100px"
  63             , CSS.height "100px"
  64             , CSS.margin "2px"
  65             , CSS.display "flex"
  66             , CSS.alignItems "center"
  67             , CSS.justifyContent "center"
  68             ]
  69         ]
  70         [ text_
  71             [ CSS.style_
  72                 [ CSS.fontSize "48px"
  73                 ]
  74             ]
  75             [ "🐈"
  76             ]
  77         ]
  78     , view_
  79         [ CSS.style_
  80             [ CSS.backgroundColor CSS.orange
  81             , CSS.width "100px"
  82             , CSS.height "100px"
  83             , CSS.display "flex"
  84             , CSS.alignItems "center"
  85             , CSS.justifyContent "center"
  86             ]
  87         ]
  88         [ text_
  89             [ CSS.style_
  90                 [ CSS.fontSize "48px"
  91                 ]
  92             ]
  93             [ text $ ms (m ^. value)
  94             ]
  95         ]
  96     , view_
  97         [ onTap SubtractOne
  98         , CSS.style_
  99             [ CSS.backgroundColor CSS.pink
 100             , CSS.width "100px"
 101             , CSS.height "100px"
 102             , CSS.margin "2px"
 103             , CSS.display "flex"
 104             , CSS.alignItems "center"
 105             , CSS.justifyContent "center"
 106             ]
 107         ]
 108         [ text_
 109             [ CSS.style_
 110                 [ CSS.fontSize "48px"
 111                 ]
 112             ]
 113             [ "🍜"
 114             ]
 115         ]
 116     ]