client/src/Component/Select.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

module Component.Select
  ( SelectIn(..)
  , SelectOut(..)
  , select
  ) where

import           Data.Map   (Map)
import           Data.Text  (Text)
import           Reflex.Dom (Dynamic, Event, MonadWidget, Reflex)
import qualified Reflex.Dom as R

data (Reflex t) => SelectIn t a = SelectIn
  { _selectIn_label        :: Text
  , _selectIn_initialValue :: a
  , _selectIn_values       :: Dynamic t (Map a Text)
  , _selectIn_reset        :: Event t ()
  }

data SelectOut t a = SelectOut
  { _selectOut_value :: Dynamic t a
  }

select :: forall t m a. (Ord a, MonadWidget t m) => SelectIn t a -> m (SelectOut t a)
select selectIn =
  R.divClass "selectInput" $ do
    R.el "label" $ R.text (_selectIn_label selectIn)

    let initialValue = _selectIn_initialValue selectIn

    value <- R._dropdown_value <$>
      R.dropdown
        initialValue
        (_selectIn_values selectIn)
        (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) })

    return SelectOut
      { _selectOut_value = value
      }