From 602c52acfcfa494b07fec05c20b317b60ea8a6f3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 20 Oct 2019 21:31:57 +0200 Subject: Load init data per page with AJAX --- client/src/View/Payment/Form.hs | 4 +- client/src/View/Payment/Header.hs | 6 +- client/src/View/Payment/Init.hs | 13 +++ client/src/View/Payment/Payment.hs | 165 +++++++++++++++++++++++-------------- client/src/View/Payment/Table.hs | 21 +++-- 5 files changed, 136 insertions(+), 73 deletions(-) create mode 100644 client/src/View/Payment/Init.hs (limited to 'client/src/View/Payment') diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs index 7819836..c817831 100644 --- a/client/src/View/Payment/Form.hs +++ b/client/src/View/Payment/Form.hs @@ -165,8 +165,8 @@ view input = do ajax = case _input_httpMethod input of - Post -> Ajax.postJson - Put -> Ajax.putJson + Post -> Ajax.post + Put -> Ajax.put findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId findCategory paymentName = diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs index 9db4c7c..9ad90a9 100644 --- a/client/src/View/Payment/Header.hs +++ b/client/src/View/Payment/Header.hs @@ -20,7 +20,7 @@ import qualified Reflex.Dom as R import Common.Model (Category, Currency, ExceedingPayer (..), Frequency (..), - Income (..), Init (..), Payment (..), + Income (..), Payment (..), PaymentCategory, SavedPayment (..), User (..)) import qualified Common.Model as CM @@ -34,9 +34,11 @@ import qualified Component as Component import qualified Component.Modal as Modal import qualified Util.List as L import qualified View.Payment.Add as Add +import View.Payment.Init (Init (..)) data HeaderIn t = HeaderIn { _headerIn_init :: Init + , _headerIn_currency :: Currency , _headerIn_payments :: Dynamic t [Payment] , _headerIn_searchPayments :: Dynamic t [Payment] , _headerIn_paymentCategories :: Dynamic t [PaymentCategory] @@ -78,7 +80,7 @@ widget headerIn = payments = _headerIn_payments headerIn users = _init_users init categories = _init_categories init - currency = _init_currency init + currency = _headerIn_currency headerIn paymentCategories = _headerIn_paymentCategories headerIn payerAndAdd diff --git a/client/src/View/Payment/Init.hs b/client/src/View/Payment/Init.hs new file mode 100644 index 0000000..d9f85c8 --- /dev/null +++ b/client/src/View/Payment/Init.hs @@ -0,0 +1,13 @@ +module View.Payment.Init + ( Init(..) + ) where + +import Common.Model (Category, Income, Payment, PaymentCategory, User) + +data Init = Init + { _init_users :: [User] + , _init_payments :: [Payment] + , _init_incomes :: [Income] + , _init_categories :: [Category] + , _init_paymentCategories :: [PaymentCategory] + } deriving (Show) diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs index cfdb441..ec350e2 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -1,5 +1,6 @@ module View.Payment.Payment - ( view + ( init + , view , PaymentIn(..) ) where @@ -10,78 +11,118 @@ import Prelude hiding (init) import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex) import qualified Reflex.Dom as R -import Common.Model (Frequency, Init (..), Payment (..), - PaymentCategory (..), PaymentId, - SavedPayment (..)) +import Common.Model (Currency, Frequency, Income (..), + Payment (..), PaymentCategory (..), + PaymentId, SavedPayment (..), User, + UserId) import qualified Common.Util.Text as T + +import Model.Loadable (Loadable (..)) +import qualified Model.Loadable as Loadable +import qualified Util.Ajax as AjaxUtil import View.Payment.Header (HeaderIn (..), HeaderOut (..)) import qualified View.Payment.Header as Header +import View.Payment.Init (Init (..)) import View.Payment.Pages (PagesIn (..), PagesOut (..)) import qualified View.Payment.Pages as Pages import View.Payment.Table (TableIn (..), TableOut (..)) import qualified View.Payment.Table as Table -data PaymentIn = PaymentIn - { _paymentIn_init :: Init +init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init)) +init = do + postBuild <- R.getPostBuild + + incomesEvent <- AjaxUtil.get (R.tag (R.constant "api/incomes") postBuild) + incomes <- Loadable.fromEvent incomesEvent + + usersEvent <- AjaxUtil.get (R.tag (R.constant "api/users") postBuild) + users <- Loadable.fromEvent usersEvent + + paymentsEvent <- AjaxUtil.get (R.tag (R.constant "api/payments") postBuild) + payments <- Loadable.fromEvent paymentsEvent + + paymentCategoriesEvent <- AjaxUtil.get (R.tag (R.constant "api/paymentCategories") postBuild) + paymentCategories <- Loadable.fromEvent paymentCategoriesEvent + + categoriesEvent <- AjaxUtil.get (R.tag (R.constant "api/categories") postBuild) + categories <- Loadable.fromEvent categoriesEvent + + return $ do + us <- users + ps <- payments + is <- incomes + cs <- categories + pcs <- paymentCategories + return $ Init <$> us <*> ps <*> is <*> cs <*> pcs + +data PaymentIn t = PaymentIn + { _paymentIn_currentUser :: UserId + , _paymentIn_currency :: Currency + , _paymentIn_init :: Dynamic t (Loadable Init) } -view :: forall t m. MonadWidget t m => PaymentIn -> m () +view :: forall t m. MonadWidget t m => PaymentIn t -> m () view paymentIn = do - R.elClass "main" "payment" $ do - rec - let init = _paymentIn_init paymentIn - - paymentsPerPage = 7 - - addPayment = R.leftmost - [ _headerOut_addPayment header - , _tableOut_addPayment table - ] - - payments <- reducePayments - (_init_payments init) - (_savedPayment_payment <$> addPayment) - (_savedPayment_payment <$> _tableOut_editPayment table) - (_tableOut_deletePayment table) - - paymentCategories <- reducePaymentCategories - (_init_paymentCategories init) - payments - (_savedPayment_paymentCategory <$> addPayment) - (_savedPayment_paymentCategory <$> _tableOut_editPayment table) - (_tableOut_deletePayment table) - - (searchNameEvent, searchName) <- - debounceSearchName (_headerOut_searchName header) - - let searchPayments = - getSearchPayments searchName (_headerOut_searchFrequency header) payments - - header <- Header.widget $ HeaderIn - { _headerIn_init = init - , _headerIn_payments = payments - , _headerIn_searchPayments = searchPayments - , _headerIn_paymentCategories = paymentCategories - } - - table <- Table.widget $ TableIn - { _tableIn_init = init - , _tableIn_currentPage = _pagesOut_currentPage pages - , _tableIn_payments = searchPayments - , _tableIn_perPage = paymentsPerPage - , _tableIn_paymentCategories = paymentCategories - } - - pages <- Pages.widget $ PagesIn - { _pagesIn_total = length <$> searchPayments - , _pagesIn_perPage = paymentsPerPage - , _pagesIn_reset = R.leftmost $ - [ () <$ searchNameEvent - , () <$ _headerOut_addPayment header - ] - } - - pure () + R.dyn . R.ffor (_paymentIn_init paymentIn) . Loadable.view $ \init -> + + R.elClass "main" "payment" $ do + rec + let addPayment = R.leftmost + [ _headerOut_addPayment header + , _tableOut_addPayment table + ] + + paymentsPerPage = 7 + + payments <- reducePayments + (_init_payments init) + (_savedPayment_payment <$> addPayment) + (_savedPayment_payment <$> _tableOut_editPayment table) + (_tableOut_deletePayment table) + + paymentCategories <- reducePaymentCategories + (_init_paymentCategories init) + payments + (_savedPayment_paymentCategory <$> addPayment) + (_savedPayment_paymentCategory <$> _tableOut_editPayment table) + (_tableOut_deletePayment table) + + (searchNameEvent, searchName) <- + debounceSearchName (_headerOut_searchName header) + + let searchPayments = + getSearchPayments searchName (_headerOut_searchFrequency header) payments + + header <- Header.widget $ HeaderIn + { _headerIn_init = init + , _headerIn_currency = _paymentIn_currency paymentIn + , _headerIn_payments = payments + , _headerIn_searchPayments = searchPayments + , _headerIn_paymentCategories = paymentCategories + } + + table <- Table.widget $ TableIn + { _tableIn_init = init + , _tableIn_currency = _paymentIn_currency paymentIn + , _tableIn_currentUser = _paymentIn_currentUser paymentIn + , _tableIn_currentPage = _pagesOut_currentPage pages + , _tableIn_payments = searchPayments + , _tableIn_perPage = paymentsPerPage + , _tableIn_paymentCategories = paymentCategories + } + + pages <- Pages.widget $ PagesIn + { _pagesIn_total = length <$> searchPayments + , _pagesIn_perPage = paymentsPerPage + , _pagesIn_reset = R.leftmost $ + [ () <$ searchNameEvent + , () <$ _headerOut_addPayment header + ] + } + + pure () + + return () debounceSearchName :: forall t m. MonadWidget t m diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs index bf6b604..5ffa037 100644 --- a/client/src/View/Payment/Table.hs +++ b/client/src/View/Payment/Table.hs @@ -13,10 +13,10 @@ import Prelude hiding (init) import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Category (..), Frequency (Punctual), - Init (..), Payment (..), +import Common.Model (Category (..), Currency, + Frequency (Punctual), Payment (..), PaymentCategory (..), SavedPayment, - User (..)) + User (..), UserId) import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Common.View.Format as Format @@ -26,12 +26,15 @@ import qualified Component.Modal as Modal import qualified View.Payment.Clone as Clone import qualified View.Payment.Delete as Delete import qualified View.Payment.Edit as Edit +import View.Payment.Init (Init (..)) import qualified Icon import qualified Util.Reflex as ReflexUtil data TableIn t = TableIn { _tableIn_init :: Init + , _tableIn_currency :: Currency + , _tableIn_currentUser :: UserId , _tableIn_currentPage :: Dynamic t Int , _tableIn_payments :: Dynamic t [Payment] , _tableIn_perPage :: Int @@ -61,7 +64,7 @@ widget tableIn = do R.divClass "cell" $ R.blank result <- - (R.simpleList paymentRange (paymentRow init paymentCategories)) + (R.simpleList paymentRange (paymentRow init currency currentUser paymentCategories)) return $ ( R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result @@ -80,6 +83,8 @@ widget tableIn = do where init = _tableIn_init tableIn + currency = _tableIn_currency tableIn + currentUser = _tableIn_currentUser tableIn currentPage = _tableIn_currentPage tableIn payments = _tableIn_payments tableIn paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage @@ -96,17 +101,19 @@ getPaymentRange perPage payments currentPage = paymentRow :: forall t m. MonadWidget t m => Init + -> Currency + -> UserId -> Dynamic t [PaymentCategory] -> Dynamic t Payment -> m (Event t SavedPayment, Event t SavedPayment, Event t Payment) -paymentRow init paymentCategories payment = +paymentRow init currency currentUser paymentCategories payment = R.divClass "row" $ do R.divClass "cell name" $ R.dynText $ fmap _payment_name payment R.divClass "cell cost" $ - R.dynText $ fmap (Format.price (_init_currency init) . _payment_cost) payment + R.dynText $ fmap (Format.price currency . _payment_cost) payment let user = R.ffor payment (\p -> CM.findUser (_payment_user p) (_init_users init)) @@ -162,7 +169,7 @@ paymentRow init paymentCategories payment = let isFromCurrentUser = R.ffor payment - (\p -> _payment_user p == _init_currentUser init) + (\p -> _payment_user p == currentUser) editPayment <- R.divClass "cell button" $ -- cgit v1.2.3