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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
module Component.Select
( SelectIn(..)
, SelectOut(..)
, select
) where
import Data.Map (Map)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex)
import qualified Reflex.Dom as R
import qualified Common.Msg as Msg
data (Reflex t) => SelectIn t a b c = SelectIn
{ _selectIn_label :: Text
, _selectIn_initialValue :: a
, _selectIn_values :: Dynamic t (Map a Text)
, _selectIn_reset :: Event t b
, _selectIn_isValid :: a -> Bool
, _selectIn_validate :: Event t c
}
data SelectOut t a = SelectOut
{ _selectOut_value :: Dynamic t a
}
select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a)
select selectIn = do
rec
let containerAttr = R.ffor hasError (\e ->
M.singleton "class" $ T.intercalate " "
[ "selectInput"
, if e then "error" else ""
])
hasError <- R.holdDyn False $ R.attachWith
(\v clearError -> not clearError && not (_selectIn_isValid selectIn v))
(R.current value)
(R.leftmost
[ const False <$> _selectIn_validate selectIn
, const True <$> _selectIn_reset selectIn
])
value <- R.elDynAttr "div" containerAttr $ 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) })
errorMessage <- R.holdDyn "" $ R.attachWith
(\v _ -> if (_selectIn_isValid selectIn) v then "" else "ERROR!")
(R.current value)
(_selectIn_validate selectIn)
R.divClass "errorMessage" . R.dynText $
R.ffor hasError (\e -> if e then Msg.get Msg.Form_NonEmpty else "")
return value
return SelectOut
{ _selectOut_value = value
}
|
