Create ModalForm component

2 files changed, 59 insertions, 82 deletions

diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs
index d83bb51..0b1bd04 100644
--- a/client/src/View/Income/Add.hs
+++ b/client/src/View/Income/Add.hs
@@ -11,6 +11,7 @@ import           Common.Model           (CreateIncomeForm (..), Income)
 import qualified Common.Msg             as Msg
 import qualified Common.Util.Time       as TimeUtil
 import qualified Component.Modal        as Modal
+import qualified Util.Ajax              as Ajax
 import qualified Util.Reflex            as ReflexUtil
 import           View.Income.Form       (FormIn (..), FormOut (..))
 import qualified View.Income.Form       as Form
@@ -27,7 +28,7 @@ view cancel = do
       , _formIn_amount = ""
       , _formIn_date = currentDay
       , _formIn_mkPayload = CreateIncomeForm
-      , _formIn_httpMethod = Form.Post
+      , _formIn_ajax = Ajax.post
       }
 
   hide <- ReflexUtil.flatten (_formOut_hide <$> form)
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs
index 2bfc23f..824bb0a 100644
--- a/client/src/View/Income/Form.hs
+++ b/client/src/View/Income/Form.hs
@@ -1,113 +1,89 @@
 module View.Income.Form
   ( view
   , FormIn(..)
-  , HttpMethod(..)
   , FormOut(..)
   ) where
 
-import           Data.Aeson               (ToJSON)
+import           Data.Aeson               (FromJSON, ToJSON)
 import           Data.Text                (Text)
 import qualified Data.Text                as T
 import           Data.Time.Calendar       (Day)
 import qualified Data.Time.Calendar       as Calendar
+import           Data.Validation          (Validation)
 import qualified Data.Validation          as V
-import           Reflex.Dom               (Event, MonadWidget)
+import           Reflex.Dom               (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom               as R
 
 import           Common.Model             (Income)
 import qualified Common.Msg               as Msg
 import qualified Common.Validation.Income as IncomeValidation
-import           Component                (ButtonIn (..), InputIn (..),
-                                           InputOut (..))
+import           Component                (InputIn (..), InputOut (..),
+                                           ModalFormIn (..), ModalFormOut (..))
 import qualified Component                as Component
-import qualified Util.Ajax                as Ajax
-import qualified Util.Either              as EitherUtil
-import qualified Util.Validation          as ValidationUtil
-import qualified Util.WaitFor             as WaitFor
 
-data FormIn t i = FormIn
+data FormIn m t a = FormIn
   { _formIn_cancel      :: Event t ()
   , _formIn_headerLabel :: Text
   , _formIn_amount      :: Text
   , _formIn_date        :: Day
-  , _formIn_mkPayload   :: Text -> Text -> i
-  , _formIn_httpMethod  :: HttpMethod
+  , _formIn_mkPayload   :: Text -> Text -> a
+  , _formIn_ajax        :: Text -> Event t a -> m (Event t (Either Text Income))
   }
 
-data HttpMethod = Put | Post
-
 data FormOut t = FormOut
   { _formOut_hide      :: Event t ()
   , _formOut_addIncome :: Event t Income
   }
 
-view :: forall t m i. (MonadWidget t m, ToJSON i) => FormIn t i -> m (FormOut t)
+view :: forall t m a. (MonadWidget t m, ToJSON a) => FormIn m t a -> m (FormOut t)
 view formIn = do
-  R.divClass "form" $ do
-    R.divClass "formHeader" $
-      R.text (_formIn_headerLabel formIn)
-
-    R.divClass "formContent" $ do
-      rec
-        let reset = R.leftmost
-              [ "" <$ cancel
-              , "" <$ addIncome
-              , "" <$ _formIn_cancel formIn
-              ]
-
-        amount <- _inputOut_raw <$> (Component.input
-          (Component.defaultInputIn
-            { _inputIn_label = Msg.get Msg.Income_Amount
-            , _inputIn_initialValue = _formIn_amount formIn
-            , _inputIn_validation = IncomeValidation.amount
-            })
-          (_formIn_amount formIn <$ reset)
-          confirm)
-
-        let initialDate = T.pack . Calendar.showGregorian . _formIn_date $ formIn
-
-        date <- _inputOut_raw <$> (Component.input
-          (Component.defaultInputIn
-            { _inputIn_label = Msg.get Msg.Income_Date
-            , _inputIn_initialValue = initialDate
-            , _inputIn_inputType = "date"
-            , _inputIn_hasResetButton = False
-            , _inputIn_validation = IncomeValidation.date
-            })
-          (initialDate <$ reset)
-          confirm)
-
-        let income = do
-              a <- amount
-              d <- date
-              return . V.Success $ (_formIn_mkPayload formIn) a d
-
-        (addIncome, cancel, confirm) <- R.divClass "buttons" $ do
-          rec
-            cancel <- Component._buttonOut_clic <$> (Component.button $
-              (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
-                { _buttonIn_class = R.constDyn "undo" })
-
-            confirm <- Component._buttonOut_clic <$> (Component.button $
-              (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
-                { _buttonIn_class = R.constDyn "confirm"
-                , _buttonIn_waiting = waiting
-                , _buttonIn_submit = True
-                })
-
-            (addIncome, waiting) <- WaitFor.waitFor
-              (ajax "/api/income")
-              (ValidationUtil.fireValidation income confirm)
-
-          return (R.fmapMaybe EitherUtil.eitherToMaybe addIncome, cancel, confirm)
-
-      return FormOut
-        { _formOut_hide = R.leftmost [ cancel, () <$ addIncome ]
-        , _formOut_addIncome = addIncome
-        }
+  rec
+    let reset = R.leftmost
+          [ "" <$ _modalFormOut_cancel modalForm
+          , "" <$ _modalFormOut_validate modalForm
+          , "" <$ _formIn_cancel formIn
+          ]
+
+    modalForm <- Component.modalForm $ ModalFormIn
+      { _modalFormIn_headerLabel = _formIn_headerLabel formIn
+      , _modalFormIn_ajax        = _formIn_ajax formIn "/api/income"
+      , _modalFormIn_form        = form reset (_modalFormOut_confirm modalForm)
+      }
+
+  return $ FormOut
+    { _formOut_hide = _modalFormOut_hide modalForm
+    , _formOut_addIncome = _modalFormOut_validate modalForm
+    }
 
   where
-    ajax =
-      case _formIn_httpMethod formIn of
-        Post -> Ajax.post
-        Put  -> Ajax.put
+    form
+      :: Event t String
+      -> Event t ()
+      -> m (Dynamic t (Validation Text a))
+    form reset confirm = do
+      amount <- _inputOut_raw <$> (Component.input
+        (Component.defaultInputIn
+          { _inputIn_label = Msg.get Msg.Income_Amount
+          , _inputIn_initialValue = _formIn_amount formIn
+          , _inputIn_validation = IncomeValidation.amount
+          })
+        (_formIn_amount formIn <$ reset)
+        confirm)
+
+      let initialDate = T.pack . Calendar.showGregorian . _formIn_date $ formIn
+
+      date <- _inputOut_raw <$> (Component.input
+        (Component.defaultInputIn
+          { _inputIn_label = Msg.get Msg.Income_Date
+          , _inputIn_initialValue = initialDate
+          , _inputIn_inputType = "date"
+          , _inputIn_hasResetButton = False
+          , _inputIn_validation = IncomeValidation.date
+          })
+        (initialDate <$ reset)
+        confirm)
+
+      return $ do
+        a <- amount
+        d <- date
+        return . V.Success $ (_formIn_mkPayload formIn) a d