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
|
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 Component.Form as Form
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)
Form.view $
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
}
|
