From 50fb8fa48d1c4881da20b4ecf6d68a772301e713 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 30 Oct 2018 18:04:58 +0100
Subject: Update table when adding or removing a payment

---
 client/src/View/Payment.hs | 61 ++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 53 insertions(+), 8 deletions(-)

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

diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index 42da8fb..5245e72 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -4,17 +4,20 @@ module View.Payment
   , PaymentOut(..)
   ) where
 
+import           Data.Text           (Text)
+import qualified Data.Text           as T
 import           Prelude             hiding (init)
-import           Reflex.Dom          (MonadWidget)
+import           Reflex.Dom          (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom          as R
 
-import           Common.Model        (Init (..))
-
+import           Common.Model        (Frequency, Init (..), Payment (..),
+                                      PaymentId)
+import qualified Common.Util.Text    as T
 import           View.Payment.Header (HeaderIn (..), HeaderOut (..))
 import qualified View.Payment.Header as Header
 import           View.Payment.Pages  (PagesIn (..), PagesOut (..))
 import qualified View.Payment.Pages  as Pages
-import           View.Payment.Table  (TableIn (..))
+import           View.Payment.Table  (TableIn (..), TableOut (..))
 import qualified View.Payment.Table  as Table
 
 data PaymentIn = PaymentIn
@@ -32,21 +35,63 @@ widget paymentIn = do
       let init = _paymentIn_init paymentIn
           paymentsPerPage = 7
 
+      payments <- getPayments
+        (_init_payments init)
+        (_headerOut_addedPayment header)
+        (_tableOut_deletedPayment table)
+
+      let searchPayments =
+            getSearchPayments
+              (_headerOut_searchName header)
+              (_headerOut_searchFrequency header)
+              payments
+
       header <- Header.widget $ HeaderIn
         { _headerIn_init = init
+        , _headerIn_searchPayments = searchPayments
         }
 
-      _ <- Table.widget $ TableIn
+      table <- Table.widget $ TableIn
         { _tableIn_init = init
         , _tableIn_currentPage = _pagesOut_currentPage pages
-        , _tableIn_payments = _headerOut_searchPayments header
+        , _tableIn_payments = searchPayments
         , _tableIn_perPage = paymentsPerPage
         }
 
       pages <- Pages.widget $ PagesIn
-        { _pagesIn_total = length <$> _headerOut_searchPayments header
+        { _pagesIn_total = length <$> searchPayments
         , _pagesIn_perPage = paymentsPerPage
-        , _pagesIn_reset = (fmap $ const ()) . R.updated $ _headerOut_searchName header
+        , _pagesIn_reset = R.leftmost $
+            [ fmap (const ()) . R.updated . _headerOut_searchName $ header
+            , fmap (const ()) . _headerOut_addedPayment $ header
+            ]
         }
 
     pure $ PaymentOut {}
+
+getPayments
+  :: forall t m. MonadWidget t m
+  => [Payment]
+  -> Event t Payment
+  -> Event t PaymentId
+  -> m (Dynamic t [Payment])
+getPayments initPayments addedPayment deletedPayment =
+  R.foldDyn id initPayments $ R.leftmost
+    [ flip fmap addedPayment (:)
+    , flip fmap deletedPayment (\paymentId -> filter ((/= paymentId) . _payment_id))
+    ]
+
+getSearchPayments
+  :: forall t. Reflex t
+  => Dynamic t Text
+  -> Dynamic t Frequency
+  -> Dynamic t [Payment]
+  -> Dynamic t [Payment]
+getSearchPayments name frequency payments = do
+  n <- name
+  f <- frequency
+  ps <- payments
+  pure $ flip filter ps (\p ->
+    (  (T.search n (_payment_name p) || T.search n (T.pack . show . _payment_cost $ p))
+    && (_payment_frequency p == f)
+    ))
-- 
cgit v1.2.3