haskell/src/Main.hs

   1 -----------------------------------------------------------------------------
   2 {-# LANGUAGE LambdaCase                  #-}
   3 {-# LANGUAGE RecordWildCards             #-}
   4 {-# LANGUAGE OverloadedStrings           #-}
   5 {-# LANGUAGE GeneralizedNewtypeDeriving  #-}
   6 -----------------------------------------------------------------------------
   7 module Main where
   8 -----------------------------------------------------------------------------
   9 import           Miso hiding (text_)
  10 import           Miso.Lynx
  11 import           Miso.Lynx.Element.View.Event (onTap)
  12 -----------------------------------------------------------------------------
  13 import           Miso.Lens
  14 import           Miso.String
  15 import qualified Miso.CSS as CSS
  16 -----------------------------------------------------------------------------
  17 -- | Application model
  18 newtype Model = Model { _value :: Int }
  19   deriving (Show, Eq, ToMisoString)
  20 -----------------------------------------------------------------------------
  21 value :: Lens Model Int
  22 value = lens _value $ \m v -> m { _value = v }
  23 -----------------------------------------------------------------------------
  24 data Action
  25   = AddOne
  26   | SubtractOne
  27   deriving (Show, Eq)
  28 -----------------------------------------------------------------------------
  29 -- | Entry point for a miso application
  30 main :: IO ()
  31 main = run $ lynx 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 = view_
  50   [ CSS.style_
  51     [ CSS.height "200px"
  52     , CSS.display "flex"
  53     , CSS.alignItems "center"
  54     , CSS.justifyContent "center"
  55     ]
  56   ]
  57   [ view_
  58     [ onTap AddOne
  59     , CSS.style_
  60         [ CSS.backgroundColor CSS.yellow
  61         , CSS.width "100px"
  62         , CSS.height "100px"
  63         , CSS.margin "2px"
  64         , CSS.display "flex"
  65         , CSS.alignItems "center"
  66         , CSS.justifyContent "center"
  67         ]
  68     ]
  69     [ text_
  70       [ CSS.style_
  71         [ CSS.fontSize "48px"
  72         ]
  73       ]
  74       [ "🐈"
  75       ]
  76     ]
  77   , view_
  78     [ CSS.style_
  79         [ CSS.backgroundColor CSS.orange
  80         , CSS.width "100px"
  81         , CSS.height "100px"
  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       [ text $ ms (m ^. value)
  93       ]
  94     ]
  95   , view_
  96     [ onTap SubtractOne
  97     , CSS.style_
  98         [ CSS.backgroundColor CSS.pink
  99         , CSS.width "100px"
 100         , CSS.height "100px"
 101         , CSS.margin "2px"
 102         , CSS.display "flex"
 103         , CSS.alignItems "center"
 104         , CSS.justifyContent "center"
 105         ]
 106     ]
 107     [ text_
 108       [ CSS.style_
 109         [ CSS.fontSize "48px"
 110         ]
 111       ]
 112       [ "🍜"
 113       ]
 114     ]
 115  ]
 116 -----------------------------------------------------------------------------