aboutsummaryrefslogtreecommitdiff
path: root/client/src
diff options
context:
space:
mode:
Diffstat (limited to 'client/src')
-rw-r--r--client/src/Util/WaitFor.hs2
-rw-r--r--client/src/View/Payment/Add.hs115
2 files changed, 59 insertions, 58 deletions
diff --git a/client/src/Util/WaitFor.hs b/client/src/Util/WaitFor.hs
index 46882aa..02edff5 100644
--- a/client/src/Util/WaitFor.hs
+++ b/client/src/Util/WaitFor.hs
@@ -12,6 +12,6 @@ waitFor
-> Event t a
-> m (Event t b, Event t Bool)
waitFor op input = do
- result <- op input >>= R.debounce (0.2 :: NominalDiffTime)
+ result <- op input >>= R.debounce (0.5 :: NominalDiffTime)
let waiting = R.leftmost [ const True <$> input , const False <$> result ]
return (result, waiting)
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 1864e76..061eeeb 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -42,64 +42,65 @@ view addIn = 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 })
- (_addIn_show addIn))
-
- cost <- _inputOut_value <$> (Component.input
- (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
- (_addIn_show addIn))
-
- currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
-
- date <- _inputOut_value <$> (Component.input
- (Component.defaultInputIn
- { _inputIn_label = Msg.get Msg.Payment_Date
- , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
- , _inputIn_inputType = "date"
- , _inputIn_hasResetButton = False
+ rec
+ name <- _inputOut_value <$> (Component.input
+ (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+ (const () <$ addedPayment))
+
+ cost <- _inputOut_value <$> (Component.input
+ (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+ (const () <$ addedPayment))
+
+ currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+
+ date <- _inputOut_value <$> (Component.input
+ (Component.defaultInputIn
+ { _inputIn_label = Msg.get Msg.Payment_Date
+ , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
+ , _inputIn_inputType = "date"
+ , _inputIn_hasResetButton = False
+ })
+ (const () <$ addedPayment))
+
+ frequency <- _selectOut_value <$> (Component.select $ SelectIn
+ { _selectIn_label = Msg.get Msg.Payment_Frequency
+ , _selectIn_initialValue = Punctual
+ , _selectIn_values = R.constDyn frequencies
+ , _selectIn_reset = _addIn_show addIn
})
- (_addIn_show addIn))
-
- frequency <- _selectOut_value <$> (Component.select $ SelectIn
- { _selectIn_label = Msg.get Msg.Payment_Frequency
- , _selectIn_initialValue = Punctual
- , _selectIn_values = R.constDyn frequencies
- , _selectIn_reset = _addIn_show addIn
- })
-
- category <- _selectOut_value <$> (Component.select $ SelectIn
- { _selectIn_label = Msg.get Msg.Payment_Category
- , _selectIn_initialValue = 0
- , _selectIn_values = R.constDyn categories
- , _selectIn_reset = _addIn_show addIn
- })
-
- let payment = CreatePayment
- <$> name
- <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
- <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
- <*> category
- <*> frequency
-
- (addedPayment, 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
- })
-
- (result, waiting) <- WaitFor.waitFor
- (Ajax.postJson "/payment")
- (R.tag (R.current payment) validate)
-
- cancel <- Component._buttonOut_clic <$> (Component.button $
- (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
- { _buttonIn_class = R.constDyn "undo" })
-
- return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
+
+ category <- _selectOut_value <$> (Component.select $ SelectIn
+ { _selectIn_label = Msg.get Msg.Payment_Category
+ , _selectIn_initialValue = 0
+ , _selectIn_values = R.constDyn categories
+ , _selectIn_reset = _addIn_show addIn
+ })
+
+ let payment = CreatePayment
+ <$> name
+ <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
+ <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
+ <*> category
+ <*> frequency
+
+ (addedPayment, 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
+ })
+
+ (result, waiting) <- WaitFor.waitFor
+ (Ajax.postJson "/payment")
+ (R.tag (R.current payment) validate)
+
+ cancel <- Component._buttonOut_clic <$> (Component.button $
+ (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+ { _buttonIn_class = R.constDyn "undo" })
+
+ return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
return AddOut
{ _addOut_cancel = cancel