Optimize and refactor payments

1 files changed, 26 insertions, 151 deletions

diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index f47b627..6bc1614 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -3,6 +3,7 @@ module View.Payment.Payment
   , In(..)
   ) where
 
+import           Control.Monad.IO.Class   (liftIO)
 import qualified Data.Maybe               as Maybe
 import           Data.Text                (Text)
 import qualified Data.Text                as T
@@ -12,9 +13,8 @@ import           Reflex.Dom               (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom               as R
 
 import           Common.Model             (Currency, Frequency, Income (..),
-                                           Payment (..), PaymentCategory (..),
-                                           PaymentId, PaymentPage (..),
-                                           SavedPayment (..), User, UserId)
+                                           Payment (..), PaymentId,
+                                           PaymentPage (..), User, UserId)
 import qualified Common.Util.Text         as T
 
 import qualified Component.Pages          as Pages
@@ -22,8 +22,8 @@ import           Loadable                 (Loadable (..))
 import qualified Loadable
 import qualified Util.Ajax                as AjaxUtil
 import qualified Util.Reflex              as ReflexUtil
+import qualified View.Payment.HeaderForm  as HeaderForm
 import qualified View.Payment.HeaderInfos as HeaderInfos
--- import qualified View.Payment.HeaderForm as HeaderForm
 import qualified View.Payment.Reducer     as Reducer
 import qualified View.Payment.Table       as Table
 
@@ -36,15 +36,16 @@ data In t = In
 view :: forall t m. MonadWidget t m => In t -> m ()
 view input = do
 
-  categoriesEvent <- (AjaxUtil.getNow "api/categories")
+  categories <- AjaxUtil.getNow "api/categories"
 
-  R.dyn . R.ffor categoriesEvent . Loadable.view $ \categories -> do
+  R.dyn . R.ffor categories . Loadable.view $ \categories -> do
 
     rec
       payments <- Reducer.reducer $ Reducer.In
-        { Reducer._in_newPage      = newPage
-        , Reducer._in_currentPage  = currentPage
-        , Reducer._in_addPayment    = R.leftmost [headerAddPayment, tableAddPayment]
+        { Reducer._in_page          = page
+        , Reducer._in_search        = HeaderForm._out_search form
+        , Reducer._in_frequency     = HeaderForm._out_frequency form
+        , Reducer._in_addPayment    = addPayment
         , Reducer._in_editPayment   = editPayment
         , Reducer._in_deletePayment = deletePayment
         }
@@ -52,16 +53,25 @@ view input = do
       let eventFromResult :: forall a. (((), Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
           eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
 
-      newPage <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
-      currentPage <- R.holdDyn 1 newPage
-      -- headerAddPayment <- eventFromResult $ Header._out_add . (\(a, _, _) -> a)
-      let headerAddPayment = R.never
+      let addPayment =
+            R.leftmost
+              [ tableAddPayment
+              , HeaderForm._out_addPayment form
+              ]
+
+      page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
       tableAddPayment <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
       editPayment <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
       deletePayment <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
 
-      result <- R.dyn . R.ffor ((,) <$> payments <*> currentPage) $ \(is, p) ->
-        flip Loadable.view is $ \(PaymentPage header payments paymentCategories count) -> do
+      form <- HeaderForm.view $ HeaderForm.In
+        { HeaderForm._in_reset             = () <$ addPayment
+        , HeaderForm._in_categories        = categories
+        }
+
+      result <- R.dyn . R.ffor payments $
+        Loadable.view $ \(PaymentPage page header payments count) -> do
+
           HeaderInfos.view $ HeaderInfos.In
             { HeaderInfos._in_users = _in_users input
             , HeaderInfos._in_currency = _in_currency input
@@ -75,13 +85,12 @@ view input = do
             , Table._in_categories = categories
             , Table._in_currency = _in_currency input
             , Table._in_payments = payments
-            , Table._in_paymentCategories = paymentCategories
             }
 
           pages <- Pages.view $ Pages.In
             { Pages._in_total = R.constDyn count
             , Pages._in_perPage = Reducer.perPage
-            , Pages._in_page = p
+            , Pages._in_page = page
             }
 
           return ((), table, pages)
@@ -89,137 +98,3 @@ view input = do
     return ()
 
   return ()
-
-
--- view :: forall t m. MonadWidget t m => In t -> m ()
--- view input = do
---   R.dyn . R.ffor (_in_init input) . Loadable.view $ \init ->
---
---     R.elClass "main" "payment" $ do
---       rec
---         let addPayment = R.leftmost
---               -- [ Header._out_addPayment header
---               [ Table2._out_addPayment table
---               ]
---
---             paymentsPerPage = 7
---
---         payments <- reducePayments
---           (_init_payments init)
---           (_savedPayment_payment <$> addPayment)
---           (_savedPayment_payment <$> Table2._out_editPayment table)
---           (Table2._out_deletePayment table)
---
---         paymentCategories <- reducePaymentCategories
---           (_init_paymentCategories init)
---           payments
---           (_savedPayment_paymentCategory <$> addPayment)
---           (_savedPayment_paymentCategory <$> Table2._out_editPayment table)
---           (Table2._out_deletePayment table)
---
---         -- (searchNameEvent, searchName) <-
---         --   debounceSearchName (Header._out_searchName header)
---
---         -- let searchPayments =
---         --       getSearchPayments searchName (Header._out_searchFrequency header) payments
---
---         -- header <- Header.view $ Header.In
---         --   { Header._in_init = init
---         --   , Header._in_currency = _in_currency input
---         --   , Header._in_payments = payments
---         --   , Header._in_searchPayments = searchPayments
---         --   , Header._in_paymentCategories = paymentCategories
---         --   }
---
---         table <- Table2.view $ Table2.In
---           { Table2._in_init = init
---           , Table2._in_currency = _in_currency input
---           , Table2._in_currentUser = _in_currentUser input
---           , Table2._in_currentPage = Pages2._out_currentPage pages
---           , Table2._in_payments = payments
---           , Table2._in_perPage = paymentsPerPage
---           , Table2._in_paymentCategories = paymentCategories
---           }
---
---         pages <- Pages2.view $ Pages2.In
---           { Pages2._in_total = length <$> payments
---           , Pages2._in_perPage = paymentsPerPage
---           , Pages2._in_reset = R.never
---               -- [ () <$ searchNameEvent
---               -- [ () <$ Header._out_addPayment header
---               -- ]
---           }
---
---       pure ()
---
---   return ()
---
--- -- 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)
---
--- reducePayments
---   :: forall t m. MonadWidget t m
---   => [Payment]
---   -> Event t Payment -- add payment
---   -> Event t Payment -- edit payment
---   -> Event t Payment -- delete payment
---   -> m (Dynamic t [Payment])
--- reducePayments initPayments addPayment editPayment deletePayment =
---   R.foldDyn id initPayments $ R.leftmost
---     [ (:) <$> addPayment
---     , R.ffor editPayment (\p -> (p:) . filter ((/= (_payment_id p)) . _payment_id))
---     , R.ffor deletePayment (\p -> filter ((/= (_payment_id p)) . _payment_id))
---     ]
---
--- reducePaymentCategories
---   :: forall t m. MonadWidget t m
---   => [PaymentCategory]
---   -> Dynamic t [Payment]      -- payments
---   -> Event t PaymentCategory  -- add payment category
---   -> Event t PaymentCategory  -- edit payment category
---   -> Event t Payment          -- delete payment
---   -> m (Dynamic t [PaymentCategory])
--- reducePaymentCategories
---   initPaymentCategories
---   payments
---   addPaymentCategory
---   editPaymentCategory
---   deletePayment
---     =
---   R.foldDyn id initPaymentCategories $ R.leftmost
---     [ (:) <$> addPaymentCategory
---     , R.ffor editPaymentCategory (\pc -> (pc:) . filter ((/= (_paymentCategory_name pc)) . _paymentCategory_name))
---     , 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
--- --   => 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)
--- --     ))