From bc81084933f8ec1bfe6c2834defd12243117fdd9 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 5 Aug 2019 21:53:30 +0200
Subject: Use updated payment categories from payment add in payment’s table

---
 client/src/View/Payment.hs | 30 +++++++++++++++++++++++-------
 1 file changed, 23 insertions(+), 7 deletions(-)

(limited to 'client/src/View/Payment.hs')

diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index 007471d..f614936 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -10,7 +10,8 @@ import           Prelude             hiding (init)
 import           Reflex.Dom          (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom          as R
 
-import           Common.Model        (Frequency, Init (..), Payment (..),
+import           Common.Model        (CreatedPayment (..), Frequency, Init (..),
+                                      Payment (..), PaymentCategory (..),
                                       PaymentId)
 import qualified Common.Util.Text    as T
 import           View.Payment.Header (HeaderIn (..), HeaderOut (..))
@@ -37,8 +38,12 @@ widget paymentIn = do
 
       payments <- getPayments
         (_init_payments init)
-        (_headerOut_addedPayment header)
-        (_tableOut_deletedPayment table)
+        (_createdPayment_payment <$> _headerOut_addPayment header)
+        (_tableOut_deletePayment table)
+
+      paymentCategories <- getPaymentCategories
+        (_init_paymentCategories init)
+        (_createdPayment_paymentCategory <$> _headerOut_addPayment header)
 
       let searchPayments =
             getSearchPayments
@@ -56,6 +61,7 @@ widget paymentIn = do
         , _tableIn_currentPage = _pagesOut_currentPage pages
         , _tableIn_payments = searchPayments
         , _tableIn_perPage = paymentsPerPage
+        , _tableIn_paymentCategories = paymentCategories
         }
 
       pages <- Pages.widget $ PagesIn
@@ -63,7 +69,7 @@ widget paymentIn = do
         , _pagesIn_perPage = paymentsPerPage
         , _pagesIn_reset = R.leftmost $
             [ fmap (const ()) . R.updated . _headerOut_searchName $ header
-            , fmap (const ()) . _headerOut_addedPayment $ header
+            , fmap (const ()) . _headerOut_addPayment $ header
             ]
         }
 
@@ -75,10 +81,20 @@ getPayments
   -> Event t Payment
   -> Event t PaymentId
   -> m (Dynamic t [Payment])
-getPayments initPayments addedPayment deletedPayment =
+getPayments initPayments addPayment deletePayment =
   R.foldDyn id initPayments $ R.leftmost
-    [ flip fmap addedPayment (:)
-    , flip fmap deletedPayment (\paymentId -> filter ((/= paymentId) . _payment_id))
+    [ (:) <$> addPayment
+    , flip fmap deletePayment (\paymentId -> filter ((/= paymentId) . _payment_id))
+    ]
+
+getPaymentCategories
+  :: forall t m. MonadWidget t m
+  => [PaymentCategory]
+  -> Event t PaymentCategory
+  -> m (Dynamic t [PaymentCategory])
+getPaymentCategories initPaymentCategories addPaymentCategory =
+  R.foldDyn id initPaymentCategories $ R.leftmost
+    [ (:) <$> addPaymentCategory
     ]
 
 getSearchPayments
-- 
cgit v1.2.3