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/Table.hs | 31 +++++++++++++++++--------------
 1 file changed, 17 insertions(+), 14 deletions(-)

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

diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index ba16bf5..6432274 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -29,21 +29,22 @@ import qualified Icon
 import qualified Util.Dom            as Dom
 
 data TableIn t = TableIn
-  { _tableIn_init        :: Init
-  , _tableIn_currentPage :: Dynamic t Int
-  , _tableIn_payments    :: Dynamic t [Payment]
-  , _tableIn_perPage     :: Int
+  { _tableIn_init              :: Init
+  , _tableIn_currentPage       :: Dynamic t Int
+  , _tableIn_payments          :: Dynamic t [Payment]
+  , _tableIn_perPage           :: Int
+  , _tableIn_paymentCategories :: Dynamic t [PaymentCategory]
   }
 
 data TableOut t = TableOut
-  { _tableOut_deletedPayment :: Event t PaymentId
+  { _tableOut_deletePayment :: Event t PaymentId
   }
 
 widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
 widget tableIn = do
   R.divClass "table" $ do
 
-    deletedPayment <- R.divClass "lines" $ do
+    deletePayment <- R.divClass "lines" $ do
       R.divClass "header" $ do
         R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name
         R.divClass "cell cost" $ R.text $ Msg.get Msg.Payment_Cost
@@ -53,13 +54,14 @@ widget tableIn = do
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
-      (R.switch . R.current . fmap R.leftmost) <$> (R.simpleList paymentRange (paymentRow init))
+      (R.switch . R.current . fmap R.leftmost) <$>
+        (R.simpleList paymentRange (paymentRow init paymentCategories))
 
     Dom.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
       R.text $ Msg.get Msg.Payment_Empty
 
     return $ TableOut
-      { _tableOut_deletedPayment = deletedPayment
+      { _tableOut_deletePayment = deletePayment
       }
 
   where
@@ -67,6 +69,7 @@ widget tableIn = do
     currentPage = _tableIn_currentPage tableIn
     payments = _tableIn_payments tableIn
     paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage
+    paymentCategories = _tableIn_paymentCategories tableIn
 
 getPaymentRange :: Int -> [Payment] -> Int -> [Payment]
 getPaymentRange perPage payments currentPage =
@@ -76,8 +79,8 @@ getPaymentRange perPage payments currentPage =
     . L.sortOn _payment_date
     $ payments
 
-paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m (Event t PaymentId)
-paymentRow init payment =
+paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t [PaymentCategory] -> Dynamic t Payment -> m (Event t PaymentId)
+paymentRow init paymentCategories payment =
   R.divClass "row" $ do
     R.divClass "cell name" . R.dynText . fmap _payment_name $ payment
     R.divClass "cell cost" . R.dynText . fmap (Format.price (_init_currency init) . _payment_cost) $  payment
@@ -88,10 +91,10 @@ paymentRow init payment =
         Just u -> _user_name u
         _      -> ""
 
-    let category = flip fmap payment $ \p -> findCategory
-          (_init_categories init)
-          (_init_paymentCategories init)
-          (_payment_name p)
+    let category = do
+          p <- payment
+          pcs <- paymentCategories
+          return $ findCategory (_init_categories init) pcs (_payment_name p)
     R.divClass "cell category" $ do
       let attrs = flip fmap category $ \maybeCategory -> case maybeCategory of
             Just c -> M.fromList
-- 
cgit v1.2.3