1 files changed, 71 insertions, 0 deletions
diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs
new file mode 100644
index 0000000..c56ff88
--- /dev/null
+++ b/client/src/Component/ModalForm.hs
@@ -0,0 +1,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 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
+          }