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
|
module Component.ModalForm
( modalForm
, ModalFormIn(..)
, ModalFormOut(..)
) 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 Component.Button (ButtonIn (..))
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 ModalFormIn m t a b e = ModalFormIn
{ _modalFormIn_headerLabel :: Text
, _modalFormIn_form :: m (Dynamic t (Validation e a))
, _modalFormIn_ajax :: Event t a -> m (Event t (Either Text b))
}
data ModalFormOut t a = ModalFormOut
{ _modalFormOut_hide :: Event t ()
, _modalFormOut_cancel :: Event t ()
, _modalFormOut_confirm :: Event t ()
, _modalFormOut_validate :: Event t a
}
modalForm :: forall t m a b e. (MonadWidget t m, ToJSON a) => ModalFormIn m t a b e -> m (ModalFormOut t b)
modalForm modalFormIn =
R.divClass "form" $ do
R.divClass "formHeader" $
R.text (_modalFormIn_headerLabel modalFormIn)
R.divClass "formContent" $ do
rec
form <- _modalFormIn_form modalFormIn
(validate, cancel, confirm) <- R.divClass "buttons" $ do
rec
cancel <- Button._buttonOut_clic <$> (Button.button $
(Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
{ _buttonIn_class = R.constDyn "undo" })
confirm <- Button._buttonOut_clic <$> (Button.button $
(Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
{ _buttonIn_class = R.constDyn "confirm"
, _buttonIn_waiting = waiting
, _buttonIn_submit = True
})
(validate, waiting) <- WaitFor.waitFor
(_modalFormIn_ajax modalFormIn)
(ValidationUtil.fireValidation form confirm)
return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm)
return ModalFormOut
{ _modalFormOut_hide = R.leftmost [ cancel, () <$ validate ]
, _modalFormOut_cancel = cancel
, _modalFormOut_confirm = confirm
, _modalFormOut_validate = validate
}
|
