aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component/ModalForm.hs
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Component/ModalForm.hs')
-rw-r--r--client/src/Component/ModalForm.hs71
1 files changed, 0 insertions, 71 deletions
diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs
deleted file mode 100644
index c56ff88..0000000
--- a/client/src/Component/ModalForm.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-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 e = In
- { _in_headerLabel :: Text
- , _in_form :: m (Dynamic t (Validation e a))
- , _in_ajax :: Event t a -> m (Event t (Either Text ()))
- }
-
-data Out t = Out
- { _out_hide :: Event t ()
- , _out_cancel :: Event t ()
- , _out_confirm :: Event t ()
- , _out_validate :: Event t ()
- }
-
-view :: forall t m a e. (MonadWidget t m, ToJSON a) => In m t a e -> m (Out t)
-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
- }