1 files changed, 119 insertions, 0 deletions
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs
new file mode 100644
index 0000000..59f6a0d
--- /dev/null
+++ b/client/src/View/Income/Form.hs
@@ -0,0 +1,119 @@
+module View.Income.Form
+  ( view
+  , In(..)
+  , Operation(..)
+  ) where
+
+import           Control.Monad.IO.Class   (liftIO)
+import           Data.Aeson               (Value)
+import qualified Data.Aeson               as Aeson
+import qualified Data.Maybe               as Maybe
+import           Data.Text                (Text)
+import qualified Data.Text                as T
+import qualified Data.Time.Calendar       as Calendar
+import qualified Data.Time.Clock          as Time
+import           Data.Validation          (Validation)
+import qualified Data.Validation          as V
+import           Reflex.Dom               (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom               as R
+
+import           Common.Model             (CreateIncomeForm (..),
+                                           EditIncomeForm (..), Income (..))
+import qualified Common.Msg               as Msg
+import qualified Common.Util.Time         as TimeUtil
+import qualified Common.Validation.Income as IncomeValidation
+import qualified Component.Input          as Input
+import qualified Component.Modal          as Modal
+import qualified Component.ModalForm      as ModalForm
+import qualified Util.Ajax                as Ajax
+
+data In = In
+  { _in_operation :: Operation
+  }
+
+data Operation
+  = New
+  | Clone Income
+  | Edit Income
+
+view :: forall t m a. MonadWidget t m => In -> Modal.Content t m
+view input cancel = do
+
+  rec
+    let reset = R.leftmost
+          [ "" <$ ModalForm._out_cancel modalForm
+          , "" <$ ModalForm._out_validate modalForm
+          , "" <$ cancel
+          ]
+
+    modalForm <- ModalForm.view $ ModalForm.In
+      { ModalForm._in_headerLabel = headerLabel
+      , ModalForm._in_ajax        = ajax "/api/income"
+      , ModalForm._in_form        = form reset (ModalForm._out_confirm modalForm)
+      }
+
+  return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm)
+
+  where
+
+    form
+      :: Event t String
+      -> Event t ()
+      -> m (Dynamic t (Validation Text Value))
+    form reset confirm = do
+      amount <- Input._out_raw <$> (Input.view
+        (Input.defaultIn
+          { Input._in_label = Msg.get Msg.Income_Amount
+          , Input._in_initialValue = amount
+          , Input._in_validation = IncomeValidation.amount
+          })
+        (amount <$ reset)
+        confirm)
+
+      currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
+
+      let initialDate = T.pack . Calendar.showGregorian $ date currentDay
+
+      date <- Input._out_raw <$> (Input.view
+        (Input.defaultIn
+          { Input._in_label = Msg.get Msg.Income_Date
+          , Input._in_initialValue = initialDate
+          , Input._in_inputType = "date"
+          , Input._in_hasResetButton = False
+          , Input._in_validation = IncomeValidation.date
+          })
+        (initialDate <$ reset)
+        confirm)
+
+      return $ do
+        a <- amount
+        d <- date
+        return . V.Success $ mkPayload a d
+
+    op = _in_operation input
+
+    amount =
+      case op of
+        New     -> ""
+        Clone i -> T.pack . show . _income_amount $ i
+        Edit i  -> T.pack . show . _income_amount $ i
+
+    date currentDay =
+      case op of
+        Edit i -> _income_date i
+        _      -> currentDay
+
+    ajax =
+      case op of
+        Edit _ -> Ajax.put
+        _      -> Ajax.post
+
+    headerLabel =
+      case op of
+        Edit _ -> Msg.get Msg.Income_Edit
+        _      -> Msg.get Msg.Income_AddLong
+
+    mkPayload =
+      case op of
+        Edit i -> \a b -> Aeson.toJSON $ EditIncomeForm (_income_id i) a b
+        _      -> \a b -> Aeson.toJSON $ CreateIncomeForm a b