haskell/src/Main.hs

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