aboutsummaryrefslogtreecommitdiff
path: root/client/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View')
-rw-r--r--client/src/View/Payment.hs1
-rw-r--r--client/src/View/Payment/Add.hs36
-rw-r--r--client/src/View/Payment/Header.hs34
3 files changed, 38 insertions, 33 deletions
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 05:19:42 +0000