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/Header.hs | 79 +++++++++++++++++++++++----------------
 1 file changed, 47 insertions(+), 32 deletions(-)

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

diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index be7f6d5..653df5e 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -13,7 +13,7 @@ import           Data.Text              (Text)
 import qualified Data.Text              as T
 import qualified Data.Time              as Time
 import           Prelude                hiding (init)
-import           Reflex.Dom             (Dynamic, MonadWidget, Reflex)
+import           Reflex.Dom             (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom             as R
 
 import           Common.Model           (Category, Currency,
@@ -22,7 +22,6 @@ import           Common.Model           (Category, Currency,
                                          User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
-import qualified Common.Util.Text       as T
 import qualified Common.View.Format     as Format
 
 import           Component              (ButtonIn (..), ButtonOut (..),
@@ -34,44 +33,47 @@ import           View.Payment.Add       (AddIn (..), AddOut (..))
 import qualified View.Payment.Add       as Add
 
 data HeaderIn t = HeaderIn
-  { _headerIn_init :: Init
+  { _headerIn_init           :: Init
+  , _headerIn_searchPayments :: Dynamic t [Payment]
   }
 
 data HeaderOut t = HeaderOut
-  { _headerOut_searchName     :: Dynamic t Text
-  , _headerOut_searchPayments :: Dynamic t [Payment]
+  { _headerOut_searchName      :: Dynamic t Text
+  , _headerOut_searchFrequency :: Dynamic t Frequency
+  , _headerOut_addedPayment    :: Event t Payment
   }
 
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
-    payerAndAdd incomes punctualPayments users categories currency
-    (searchName, searchFrequency)  <- searchLine
-    let searchPayments = getSearchPayments searchName searchFrequency payments
-    infos searchPayments users currency
+    addedPayment <- payerAndAdd incomes punctualPayments users categories currency
+    let resetSearchName = fmap (const ()) $ addedPayment
+    (searchName, searchFrequency)  <- searchLine resetSearchName
+
+    infos (_headerIn_searchPayments headerIn) users currency
+
     return $ HeaderOut
       { _headerOut_searchName = searchName
-      , _headerOut_searchPayments = searchPayments
+      , _headerOut_searchFrequency = searchFrequency
+      , _headerOut_addedPayment = addedPayment
       }
   where
     init = _headerIn_init headerIn
     incomes = _init_incomes init
-    payments = _init_payments init
-    punctualPayments = filter ((==) Punctual . _payment_frequency) payments
+    initPayments = _init_payments init
+    punctualPayments = filter ((==) Punctual . _payment_frequency) initPayments
     users = _init_users init
     categories = _init_categories init
     currency = _init_currency init
 
-getSearchPayments :: forall t. (Reflex t) => Dynamic t Text -> Dynamic t Frequency -> [Payment] -> Dynamic t [Payment]
-getSearchPayments name frequency payments = do
-  n <- name
-  f <- frequency
-  pure $ flip filter payments (\p ->
-    (  (T.search n (_payment_name p) || T.search n (T.pack . show . _payment_cost $ p))
-    && (_payment_frequency p == f)
-    ))
-
-payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> [Category] -> Currency -> m ()
+payerAndAdd
+  :: forall t m. MonadWidget t m
+  => [Income]
+  -> [Payment]
+  -> [User]
+  -> [Category]
+  -> Currency
+  -> m (Event t Payment)
 payerAndAdd incomes payments users categories currency = do
   time <- liftIO Time.getCurrentTime
   R.divClass "payerAndAdd" $ do
@@ -94,19 +96,28 @@ payerAndAdd incomes payments users categories currency = do
       , _buttonIn_submit = False
       })
     rec
-      modalOut <- Component.modal $ ModalIn
+      modalOut <- fmap _modalOut_content . Component.modal $ ModalIn
         { _modalIn_show    = addPaymentClic
-        , _modalIn_hide = _addOut_cancel . _modalOut_content $ modalOut
-        , _modalIn_content = Add.view $ AddIn { _addIn_categories = categories }
+        , _modalIn_hide = R.leftmost $
+            [ _addOut_cancel modalOut
+            , fmap (const ()) . _addOut_addedPayment $ modalOut
+            ]
+        , _modalIn_content = Add.view $ AddIn
+            { _addIn_categories = categories
+            , _addIn_show = addPaymentClic
+            }
         }
-    return ()
+    return (_addOut_addedPayment modalOut)
 
-searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text, Dynamic t Frequency)
-searchLine = do
+searchLine
+  :: forall t m. MonadWidget t m
+  => Event t ()
+  -> m (Dynamic t Text, Dynamic t Frequency)
+searchLine reset = do
   R.divClass "searchLine" $ do
-    searchName <- _inputOut_value <$> (Component.input $ Component.defaultInputIn
-      { _inputIn_label = Msg.get Msg.Search_Name
-      })
+    searchName <- _inputOut_value <$> (Component.input
+      ( Component.defaultInputIn { _inputIn_label = Msg.get Msg.Search_Name })
+      reset)
 
     let frequencies = M.fromList
           [ (Punctual, Msg.get Msg.Payment_PunctualMale)
@@ -118,7 +129,11 @@ searchLine = do
 
     return (searchName, searchFrequency)
 
-infos :: forall t m. MonadWidget t m => Dynamic t [Payment] -> [User] -> Currency -> m ()
+infos
+  :: forall t m. MonadWidget t m
+  => Dynamic t [Payment]
+  -> [User]
+  -> Currency -> m ()
 infos payments users currency =
   R.divClass "infos" $ do
 
-- 
cgit v1.2.3