diff options
Diffstat (limited to 'client/src/View/Payment/Payment.hs')
| -rw-r--r-- | client/src/View/Payment/Payment.hs | 165 |
1 files changed, 103 insertions, 62 deletions
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 |