From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 17 Nov 2019 18:08:28 +0100 Subject: Optimize and refactor payments --- client/src/View/Payment/Payment.hs | 177 ++++++------------------------------- 1 file changed, 26 insertions(+), 151 deletions(-) (limited to 'client/src/View/Payment/Payment.hs') 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) --- -- )) -- cgit v1.2.3