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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
module Component.Select
( SelectIn(..)
, SelectOut(..)
, select
) where
import Data.Map (Map)
import qualified Data.Map as M
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Data.Validation (Validation (Failure, Success))
import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex)
import qualified Reflex.Dom as R
import qualified Common.Msg as Msg
import qualified Util.Validation as ValidationUtil
data (Reflex t) => SelectIn t a b c = SelectIn
{ _selectIn_label :: Text
, _selectIn_initialValue :: a
, _selectIn_value :: Event t 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_raw :: Dynamic t a
, _selectOut_value :: Dynamic t (Validation Text 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 showedError (\e ->
M.singleton "class" $ T.intercalate " "
[ "selectInput"
, if Maybe.isJust e then "error" else ""
])
validatedValue =
R.ffor value (\v ->
if _selectIn_isValid selectIn v then
Success v
else
Failure (Msg.get Msg.Form_NonEmpty))
maybeError =
fmap ValidationUtil.maybeError validatedValue
showedError <- R.holdDyn Nothing $ R.leftmost
[ Nothing <$ _selectIn_reset selectIn
, R.updated maybeError
, R.attachWith const (R.current maybeError) (_selectIn_validate selectIn)
]
value <- R.elDynAttr "div" containerAttr $ do
let initialValue = _selectIn_initialValue selectIn
let setValue = R.leftmost
[ initialValue <$ (_selectIn_reset selectIn)
, _selectIn_value selectIn
]
value <- R.el "label" $ do
R.divClass "label" $
R.text (_selectIn_label selectIn)
R._dropdown_value <$>
R.dropdown
initialValue
(_selectIn_values selectIn)
(R.def { R._dropdownConfig_setValue = setValue })
R.divClass "errorMessage" . R.dynText $
R.ffor showedError (Maybe.fromMaybe "")
return value
return SelectOut
{ _selectOut_raw = value
, _selectOut_value = validatedValue
}
|
