From 7c77e52faa71e43324087903c905f9d493b1dfb7 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 8 Aug 2019 21:28:22 +0200 Subject: Finish payment add modal --- client/src/View/Payment.hs | 1 + client/src/View/Payment/Add.hs | 36 ++++++++++++++++-------------------- client/src/View/Payment/Header.hs | 34 +++++++++++++++++++++------------- 3 files changed, 38 insertions(+), 33 deletions(-) (limited to 'client/src/View') diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs index 05eedab..ae20079 100644 --- a/client/src/View/Payment.hs +++ b/client/src/View/Payment.hs @@ -53,6 +53,7 @@ widget paymentIn = do header <- Header.widget $ HeaderIn { _headerIn_init = init + , _headerIn_payments = payments , _headerIn_searchPayments = searchPayments , _headerIn_paymentCategories = paymentCategories } diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs index d023613..e0772f7 100644 --- a/client/src/View/Payment/Add.hs +++ b/client/src/View/Payment/Add.hs @@ -66,7 +66,7 @@ view addIn = do , _inputIn_validation = PaymentValidation.name }) reset - validate + confirm cost <- _inputOut_value <$> (Component.input (Component.defaultInputIn @@ -74,7 +74,7 @@ view addIn = do , _inputIn_validation = PaymentValidation.cost }) reset - validate) + confirm) now <- liftIO Time.getCurrentTime @@ -91,7 +91,7 @@ view addIn = do , _inputIn_validation = PaymentValidation.date }) (const currentDay <$> reset) - validate) + confirm) frequency <- _selectOut_value <$> (Component.select $ SelectIn { _selectIn_label = Msg.get Msg.Payment_Frequency @@ -100,7 +100,7 @@ view addIn = do , _selectIn_values = R.constDyn frequencies , _selectIn_reset = reset , _selectIn_isValid = const True - , _selectIn_validate = validate + , _selectIn_validate = confirm }) let setCategory = @@ -115,7 +115,7 @@ view addIn = do , _selectIn_values = R.constDyn categories , _selectIn_reset = reset , _selectIn_isValid = \id -> id /= -1 - , _selectIn_validate = validate + , _selectIn_validate = confirm }) let payment = do @@ -124,24 +124,20 @@ view addIn = do d <- date cat <- category f <- frequency - pure $ do - n' <- n - c' <- c - d' <- d - pure $ CreatePayment - <$> ValidationUtil.nelError n' - <*> ValidationUtil.nelError c' - <*> ValidationUtil.nelError d' - <*> ValidationUtil.nelError (V.Success cat) - <*> ValidationUtil.nelError (V.Success f) - - (addPayment, cancel, validate) <- R.divClass "buttons" $ do + return (CreatePayment + <$> ValidationUtil.nelError n + <*> ValidationUtil.nelError c + <*> ValidationUtil.nelError d + <*> ValidationUtil.nelError cat + <*> ValidationUtil.nelError f) + + (addPayment, 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" }) - validate <- Component._buttonOut_clic <$> (Component.button $ + confirm <- Component._buttonOut_clic <$> (Component.button $ (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm)) { _buttonIn_class = R.constDyn "confirm" , _buttonIn_waiting = waiting @@ -150,9 +146,9 @@ view addIn = do (addPayment, waiting) <- WaitFor.waitFor (Ajax.postJson "/payment") - (ValidationUtil.fireValidation payment validate) + (ValidationUtil.fireValidation payment confirm) - return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, validate) + return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, confirm) return AddOut { _addOut_cancel = cancel diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs index 5cc362a..73517f0 100644 --- a/client/src/View/Payment/Header.hs +++ b/client/src/View/Payment/Header.hs @@ -36,6 +36,7 @@ import qualified View.Payment.Add as Add data HeaderIn t = HeaderIn { _headerIn_init :: Init + , _headerIn_payments :: Dynamic t [Payment] , _headerIn_searchPayments :: Dynamic t [Payment] , _headerIn_paymentCategories :: Dynamic t [PaymentCategory] } @@ -49,7 +50,7 @@ data HeaderOut t = HeaderOut widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t) widget headerIn = R.divClass "header" $ do - addPayment <- payerAndAdd incomes punctualPayments users categories paymentCategories currency + addPayment <- payerAndAdd incomes payments users categories paymentCategories currency let resetSearchName = fmap (const ()) $ addPayment (searchName, searchFrequency) <- searchLine resetSearchName @@ -64,7 +65,7 @@ widget headerIn = init = _headerIn_init headerIn incomes = _init_incomes init initPayments = _init_payments init - punctualPayments = filter ((==) Punctual . _payment_frequency) initPayments + payments = _headerIn_payments headerIn users = _init_users init categories = _init_categories init currency = _init_currency init @@ -73,7 +74,7 @@ widget headerIn = payerAndAdd :: forall t m. MonadWidget t m => [Income] - -> [Payment] + -> Dynamic t [Payment] -> [User] -> [Category] -> Dynamic t [PaymentCategory] @@ -82,17 +83,23 @@ payerAndAdd payerAndAdd incomes payments users categories paymentCategories currency = do time <- liftIO Time.getCurrentTime R.divClass "payerAndAdd" $ do + + let exceedingPayers = + R.ffor payments $ \ps -> + CM.getExceedingPayers time users incomes $ + filter ((==) Punctual . _payment_frequency) ps + R.divClass "exceedingPayers" $ - forM_ - (CM.getExceedingPayers time users incomes payments) - (\p -> - R.elClass "span" "exceedingPayer" $ do - R.elClass "span" "userName" $ - R.text . fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId p) users - R.elClass "span" "amount" $ do - R.text "+ " - R.text . Format.price currency $ _exceedingPayer_amount p - ) + R.simpleList exceedingPayers $ \exceedingPayer -> + R.elClass "span" "exceedingPayer" $ do + R.elClass "span" "userName" $ + R.dynText . R.ffor exceedingPayer $ \ep -> + fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId ep) users + R.elClass "span" "amount" $ do + R.text "+ " + R.dynText . R.ffor exceedingPayer $ \ep -> + Format.price currency $ _exceedingPayer_amount ep + addPaymentClic <- _buttonOut_clic <$> (Component.button $ ButtonIn { _buttonIn_class = R.constDyn "addPayment" , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add @@ -100,6 +107,7 @@ payerAndAdd incomes payments users categories paymentCategories currency = do , _buttonIn_tabIndex = Nothing , _buttonIn_submit = False }) + rec modalOut <- Component.modal $ ModalIn { _modalIn_show = addPaymentClic -- cgit v1.2.3