WIP

1 files changed, 104 insertions, 0 deletions

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
new file mode 100644
index 0000000..2eaec0f
--- /dev/null
+++ b/client/src/View/Payment/Add.hs
@@ -0,0 +1,104 @@
+module View.Payment.Add
+  ( view
+  , AddIn(..)
+  , AddOut(..)
+  ) where
+
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.Map               as M
+import qualified Data.Maybe             as Maybe
+import qualified Data.Text              as T
+import qualified Data.Time.Clock        as Time
+import           Reflex.Dom             (Event, MonadWidget)
+import qualified Reflex.Dom             as R
+import qualified Text.Read              as T
+
+import           Common.Model           (Category (..), CreatePayment (..),
+                                         Frequency (..))
+import qualified Common.Msg             as Msg
+import qualified Common.Util.Time       as Time
+import qualified Common.View.Format     as Format
+import           Component              (ButtonIn (..), InputIn (..),
+                                         InputOut (..), SelectIn (..),
+                                         SelectOut (..))
+import qualified Component              as Component
+import qualified Util.Ajax              as Ajax
+import qualified Util.WaitFor           as Util
+
+data AddIn = AddIn
+  { _addIn_categories :: [Category]
+  }
+
+data AddOut t = AddOut
+  { _addOut_cancel :: Event t ()
+  }
+
+view :: forall t m. MonadWidget t m => AddIn -> m (AddOut t)
+view addIn = do
+  R.divClass "add" $ do
+    R.divClass "addHeader" $ R.text $ Msg.get Msg.Payment_Add
+
+    R.divClass "addContent" $ do
+      name <- _inputOut_value <$> (Component.input $
+        Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+
+      cost <- _inputOut_value <$> (Component.input $
+        Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+
+      currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+
+      date <- _inputOut_value <$> (Component.input $
+        Component.defaultInputIn
+          { _inputIn_label = Msg.get Msg.Payment_Cost
+          , _inputIn_initialValue = Format.shortDay currentDay
+          })
+
+      frequency <- _selectOut_value <$> (Component.select $ SelectIn
+        { _selectIn_label = Msg.get Msg.Payment_Frequency
+        , _selectIn_initialValue = Punctual
+        , _selectIn_values = R.constDyn frequencies
+        })
+
+      category <- _selectOut_value <$> (Component.select $ SelectIn
+        { _selectIn_label = Msg.get Msg.Payment_Category
+        , _selectIn_initialValue = 0
+        , _selectIn_values = R.constDyn categories
+        })
+
+      let payment = CreatePayment
+            <$> name
+            <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
+            <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
+            <*> category
+            <*> frequency
+
+      cancel <- R.divClass "buttons" $ do
+        rec
+          validate <- 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
+              })
+
+          (_, waiting) <- Util.waitFor
+            (Ajax.post "/payment")
+            validate
+            payment
+
+        Component._buttonOut_clic <$> (Component.button $
+          (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+            { _buttonIn_class = R.constDyn "undo" })
+
+      return AddOut
+        { _addOut_cancel = cancel
+        }
+
+  where
+    frequencies = M.fromList
+      [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+      , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+      ]
+
+    categories = M.fromList . flip map (_addIn_categories addIn) $ \c ->
+      (_category_id c, _category_name c)