Finish payment add modal

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