From fb8f0fe577e28dae69903413b761da50586e0099 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Aug 2019 14:53:41 +0200
Subject: Remove payment category if unused after a payment is deleted

---
 client/src/View/Payment.hs | 49 ++++++++++++++++++++++++++++++++--------------
 1 file changed, 34 insertions(+), 15 deletions(-)

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

diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index 915cc18..46ab642 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -45,18 +45,14 @@ widget paymentIn = do
       paymentCategories <- getPaymentCategories
         (_init_paymentCategories init)
         (_createdPayment_paymentCategory <$> _headerOut_addPayment header)
+        payments
+        (_tableOut_deletePayment table)
 
-      let searchPayments =
-            getSearchPayments
-              debouncedSearchName
-              (_headerOut_searchFrequency header)
-              payments
-
-      debouncedSearchNameEvt <-
-        R.debounce (0.5 :: NominalDiffTime) (R.updated $ _headerOut_searchName header)
+      (searchNameEvent, searchName) <-
+        debounceSearchName (_headerOut_searchName header)
 
-      debouncedSearchName <-
-        R.holdDyn "" debouncedSearchNameEvt
+      let searchPayments =
+            getSearchPayments searchName (_headerOut_searchFrequency header) payments
 
       header <- Header.widget $ HeaderIn
         { _headerIn_init = init
@@ -77,34 +73,57 @@ widget paymentIn = do
         { _pagesIn_total = length <$> searchPayments
         , _pagesIn_perPage = paymentsPerPage
         , _pagesIn_reset = R.leftmost $
-            [ const () <$> debouncedSearchNameEvt
+            [ const () <$> searchNameEvent
             , const () <$> _headerOut_addPayment header
             ]
         }
 
     pure $ PaymentOut {}
 
+debounceSearchName
+  :: forall t m. MonadWidget t m
+  => Dynamic t Text
+  -> m (Event t Text, Dynamic t Text)
+debounceSearchName searchName = do
+  event <- R.debounce (0.5 :: NominalDiffTime) (R.updated searchName)
+  dynamic <- R.holdDyn "" event
+  return (event, dynamic)
+
 getPayments
   :: forall t m. MonadWidget t m
   => [Payment]
   -> Event t Payment
-  -> Event t PaymentId
+  -> Event t Payment
   -> m (Dynamic t [Payment])
 getPayments initPayments addPayment deletePayment =
   R.foldDyn id initPayments $ R.leftmost
     [ (:) <$> addPayment
-    , flip fmap deletePayment (\paymentId -> filter ((/= paymentId) . _payment_id))
+    , R.ffor deletePayment (\p -> filter ((/= (_payment_id p)) . _payment_id))
     ]
 
 getPaymentCategories
   :: forall t m. MonadWidget t m
   => [PaymentCategory]
-  -> Event t PaymentCategory
+  -> Event t PaymentCategory  -- add payment category
+  -> Dynamic t [Payment]      -- payments
+  -> Event t Payment          -- delete payment
   -> m (Dynamic t [PaymentCategory])
-getPaymentCategories initPaymentCategories addPaymentCategory =
+getPaymentCategories initPaymentCategories addPaymentCategory payments deletePayment =
   R.foldDyn id initPaymentCategories $ R.leftmost
     [ (:) <$> addPaymentCategory
+    , R.ffor deletePaymentName (\name -> filter ((/=) (T.toLower name) . _paymentCategory_name))
     ]
+  where
+    deletePaymentName =
+      R.attachWithMaybe
+        (\ps p ->
+          if any (\p2 -> _payment_id p2 /= _payment_id p && lowerName p2 == lowerName p) ps then
+            Nothing
+          else
+            Just (_payment_name p))
+        (R.current payments)
+        deletePayment
+    lowerName = T.toLower . _payment_name
 
 getSearchPayments
   :: forall t. Reflex t
-- 
cgit v1.2.3