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.ModalForm
( view
, In(..)
, Out(..)
) where
import Data.Aeson (ToJSON)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import Data.Validation (Validation)
import qualified Data.Validation as V
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import qualified Common.Msg as Msg
import qualified Component.Button as Button
import qualified Util.Either as EitherUtil
import qualified Util.Validation as ValidationUtil
import qualified Util.WaitFor as WaitFor
data In m t a b e = In
{ _in_headerLabel :: Text
, _in_form :: m (Dynamic t (Validation e a))
, _in_ajax :: Event t a -> m (Event t (Either Text b))
}
data Out t a = Out
{ _out_hide :: Event t ()
, _out_cancel :: Event t ()
, _out_confirm :: Event t ()
, _out_validate :: Event t a
}
view :: forall t m a b e. (MonadWidget t m, ToJSON a) => In m t a b e -> m (Out t b)
view input =
R.divClass "form" $ do
R.divClass "formHeader" $
R.text (_in_headerLabel input)
R.divClass "formContent" $ do
rec
form <- _in_form input
(validate, cancel, confirm) <- R.divClass "buttons" $ do
rec
cancel <- Button._out_clic <$> (Button.view $
(Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
{ Button._in_class = R.constDyn "undo" })
confirm <- Button._out_clic <$> (Button.view $
(Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
{ Button._in_class = R.constDyn "confirm"
, Button._in_waiting = waiting
, Button._in_submit = True
})
(validate, waiting) <- WaitFor.waitFor
(_in_ajax input)
(ValidationUtil.fireValidation form confirm)
return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm)
return Out
{ _out_hide = R.leftmost [ cancel, () <$ validate ]
, _out_cancel = cancel
, _out_confirm = confirm
, _out_validate = validate
}
|
