diff options
Diffstat (limited to 'client/src')
| -rw-r--r-- | client/src/Util/WaitFor.hs | 2 | ||||
| -rw-r--r-- | client/src/View/Payment/Add.hs | 115 |
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 |