From 04c59f08f100ba6a0658d1f2b357f7d8b1e14218 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 13 Oct 2019 22:38:35 +0200 Subject: Show income table --- client/src/View/Payment/Payment.hs | 154 +++++++++++++++++++++++++++++++++++++ 1 file changed, 154 insertions(+) create mode 100644 client/src/View/Payment/Payment.hs (limited to 'client/src/View/Payment/Payment.hs') diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs new file mode 100644 index 0000000..cfdb441 --- /dev/null +++ b/client/src/View/Payment/Payment.hs @@ -0,0 +1,154 @@ +module View.Payment.Payment + ( view + , PaymentIn(..) + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Clock (NominalDiffTime) +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 qualified Common.Util.Text as T +import View.Payment.Header (HeaderIn (..), HeaderOut (..)) +import qualified View.Payment.Header as Header +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 + } + +view :: forall t m. MonadWidget t m => PaymentIn -> 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 () + +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 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/Payment.hs | 165 +++++++++++++++++++++++-------------- 1 file changed, 103 insertions(+), 62 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 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 -- cgit v1.2.3 From 33e78f2ebbf5bf7b40e7aa732cc7c019f6df3f12 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 20 Oct 2019 22:08:31 +0200 Subject: Simplify page initialization --- client/src/View/Payment/Payment.hs | 27 ++++++++------------------- 1 file changed, 8 insertions(+), 19 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 ec350e2..5f0d03c 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -17,8 +17,8 @@ import Common.Model (Currency, Frequency, Income (..), UserId) import qualified Common.Util.Text as T -import Model.Loadable (Loadable (..)) -import qualified Model.Loadable as Loadable +import Loadable (Loadable (..)) +import qualified Loadable import qualified Util.Ajax as AjaxUtil import View.Payment.Header (HeaderIn (..), HeaderOut (..)) import qualified View.Payment.Header as Header @@ -30,23 +30,11 @@ import qualified View.Payment.Table as Table 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 - + users <- AjaxUtil.getNow "api/users" + payments <- AjaxUtil.getNow "api/payments" + incomes <- AjaxUtil.getNow "api/incomes" + categories <- AjaxUtil.getNow "api/categories" + paymentCategories <- AjaxUtil.getNow "api/paymentCategories" return $ do us <- users ps <- payments @@ -55,6 +43,7 @@ init = do pcs <- paymentCategories return $ Init <$> us <*> ps <*> is <*> cs <*> pcs + data PaymentIn t = PaymentIn { _paymentIn_currentUser :: UserId , _paymentIn_currency :: Currency -- cgit v1.2.3 From 613ffccac4b3ab25c6d4c631fab757da0b35acf6 Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 22 Oct 2019 22:26:38 +0200 Subject: Harmonize view component code style --- client/src/View/Payment/Payment.hs | 75 ++++++++++++++++++-------------------- 1 file changed, 36 insertions(+), 39 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 5f0d03c..f86acd8 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -1,7 +1,7 @@ module View.Payment.Payment ( init , view - , PaymentIn(..) + , In(..) ) where import Data.Text (Text) @@ -20,12 +20,9 @@ import qualified Common.Util.Text as T import Loadable (Loadable (..)) import qualified 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 init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init)) @@ -44,21 +41,21 @@ init = do return $ Init <$> us <*> ps <*> is <*> cs <*> pcs -data PaymentIn t = PaymentIn - { _paymentIn_currentUser :: UserId - , _paymentIn_currency :: Currency - , _paymentIn_init :: Dynamic t (Loadable Init) +data In t = In + { _in_currentUser :: UserId + , _in_currency :: Currency + , _in_init :: Dynamic t (Loadable Init) } -view :: forall t m. MonadWidget t m => PaymentIn t -> m () -view paymentIn = do - R.dyn . R.ffor (_paymentIn_init paymentIn) . Loadable.view $ \init -> +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 - [ _headerOut_addPayment header - , _tableOut_addPayment table + [ Header._out_addPayment header + , Table._out_addPayment table ] paymentsPerPage = 7 @@ -66,46 +63,46 @@ view paymentIn = do payments <- reducePayments (_init_payments init) (_savedPayment_payment <$> addPayment) - (_savedPayment_payment <$> _tableOut_editPayment table) - (_tableOut_deletePayment table) + (_savedPayment_payment <$> Table._out_editPayment table) + (Table._out_deletePayment table) paymentCategories <- reducePaymentCategories (_init_paymentCategories init) payments (_savedPayment_paymentCategory <$> addPayment) - (_savedPayment_paymentCategory <$> _tableOut_editPayment table) - (_tableOut_deletePayment table) + (_savedPayment_paymentCategory <$> Table._out_editPayment table) + (Table._out_deletePayment table) (searchNameEvent, searchName) <- - debounceSearchName (_headerOut_searchName header) + debounceSearchName (Header._out_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 + 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 <- 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 + table <- Table.view $ Table.In + { Table._in_init = init + , Table._in_currency = _in_currency input + , Table._in_currentUser = _in_currentUser input + , Table._in_currentPage = Pages._out_currentPage pages + , Table._in_payments = searchPayments + , Table._in_perPage = paymentsPerPage + , Table._in_paymentCategories = paymentCategories } - pages <- Pages.widget $ PagesIn - { _pagesIn_total = length <$> searchPayments - , _pagesIn_perPage = paymentsPerPage - , _pagesIn_reset = R.leftmost $ + pages <- Pages.view $ Pages.In + { Pages._in_total = length <$> searchPayments + , Pages._in_perPage = paymentsPerPage + , Pages._in_reset = R.leftmost $ [ () <$ searchNameEvent - , () <$ _headerOut_addPayment header + , () <$ Header._out_addPayment header ] } -- cgit v1.2.3 From 182f3d3fea9985c0e403087fe253981c68e57102 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Nov 2019 11:33:20 +0100 Subject: Fix payment page --- client/src/View/Payment/Payment.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (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 f86acd8..e72577f 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -29,7 +29,7 @@ init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init)) init = do users <- AjaxUtil.getNow "api/users" payments <- AjaxUtil.getNow "api/payments" - incomes <- AjaxUtil.getNow "api/incomes" + incomes <- AjaxUtil.getNow "api/deprecated/incomes" categories <- AjaxUtil.getNow "api/categories" paymentCategories <- AjaxUtil.getNow "api/paymentCategories" return $ do -- cgit v1.2.3 From f4f24158a46d8c0975f1b8813bbdbbeebad8c108 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 6 Nov 2019 19:44:15 +0100 Subject: Show the payment table with server side paging --- client/src/View/Payment/Payment.hs | 367 ++++++++++++++++++++----------------- 1 file changed, 202 insertions(+), 165 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 e72577f..bf0186f 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -1,181 +1,218 @@ module View.Payment.Payment - ( init - , view + ( view , In(..) ) where -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time.Clock (NominalDiffTime) -import Prelude hiding (init) -import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex) -import qualified Reflex.Dom as R - -import Common.Model (Currency, Frequency, Income (..), - Payment (..), PaymentCategory (..), - PaymentId, SavedPayment (..), User, - UserId) -import qualified Common.Util.Text as T - -import Loadable (Loadable (..)) +import qualified Data.Maybe as Maybe +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Clock (NominalDiffTime) +import Prelude hiding (init) +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) +import qualified Common.Util.Text as T + +import qualified Component.Pages as Pages +import Loadable (Loadable (..)) import qualified Loadable -import qualified Util.Ajax as AjaxUtil -import qualified View.Payment.Header as Header -import View.Payment.Init (Init (..)) -import qualified View.Payment.Pages as Pages -import qualified View.Payment.Table as Table - -init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init)) -init = do - users <- AjaxUtil.getNow "api/users" - payments <- AjaxUtil.getNow "api/payments" - incomes <- AjaxUtil.getNow "api/deprecated/incomes" - categories <- AjaxUtil.getNow "api/categories" - paymentCategories <- AjaxUtil.getNow "api/paymentCategories" - return $ do - us <- users - ps <- payments - is <- incomes - cs <- categories - pcs <- paymentCategories - return $ Init <$> us <*> ps <*> is <*> cs <*> pcs - +import qualified Util.Ajax as AjaxUtil +import qualified Util.Reflex as ReflexUtil +import qualified View.Payment.Header as Header +import View.Payment.Init (Init (..)) +import qualified View.Payment.Reducer as Reducer +import qualified View.Payment.Table as Table data In t = In { _in_currentUser :: UserId + , _in_users :: [User] , _in_currency :: Currency - , _in_init :: Dynamic t (Loadable Init) } 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 - , Table._out_addPayment table - ] - - paymentsPerPage = 7 - - payments <- reducePayments - (_init_payments init) - (_savedPayment_payment <$> addPayment) - (_savedPayment_payment <$> Table._out_editPayment table) - (Table._out_deletePayment table) - - paymentCategories <- reducePaymentCategories - (_init_paymentCategories init) - payments - (_savedPayment_paymentCategory <$> addPayment) - (_savedPayment_paymentCategory <$> Table._out_editPayment table) - (Table._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 <- Table.view $ Table.In - { Table._in_init = init - , Table._in_currency = _in_currency input - , Table._in_currentUser = _in_currentUser input - , Table._in_currentPage = Pages._out_currentPage pages - , Table._in_payments = searchPayments - , Table._in_perPage = paymentsPerPage - , Table._in_paymentCategories = paymentCategories - } - - pages <- Pages.view $ Pages.In - { Pages._in_total = length <$> searchPayments - , Pages._in_perPage = paymentsPerPage - , Pages._in_reset = R.leftmost $ - [ () <$ searchNameEvent - , () <$ Header._out_addPayment header - ] - } - - pure () + + categoriesEvent <- (AjaxUtil.getNow "api/categories") + + R.dyn . R.ffor categoriesEvent . 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_editPayment = editPayment + , Reducer._in_deletePayment = deletePayment + } + + 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 + 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 payments paymentCategories count) -> do + table <- Table.view $ Table.In + { Table._in_users = _in_users input + , Table._in_currentUser = _in_currentUser input + , 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 + } + + return ((), table, pages) + + return () 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) - )) + +-- 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 From 4dc84dbda7ba3ea60d13e6f81eeec556974b7c72 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 7 Nov 2019 07:59:41 +0100 Subject: Show payment header infos --- client/src/View/Payment/Payment.hs | 53 +++++++++++++++++++++----------------- 1 file changed, 30 insertions(+), 23 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 bf0186f..f47b627 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -3,29 +3,29 @@ module View.Payment.Payment , In(..) ) where -import qualified Data.Maybe as Maybe -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time.Clock (NominalDiffTime) -import Prelude hiding (init) -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) -import qualified Common.Util.Text as T - -import qualified Component.Pages as Pages -import Loadable (Loadable (..)) +import qualified Data.Maybe as Maybe +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Clock (NominalDiffTime) +import Prelude hiding (init) +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) +import qualified Common.Util.Text as T + +import qualified Component.Pages as Pages +import Loadable (Loadable (..)) import qualified Loadable -import qualified Util.Ajax as AjaxUtil -import qualified Util.Reflex as ReflexUtil -import qualified View.Payment.Header as Header -import View.Payment.Init (Init (..)) -import qualified View.Payment.Reducer as Reducer -import qualified View.Payment.Table as Table +import qualified Util.Ajax as AjaxUtil +import qualified Util.Reflex as ReflexUtil +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 data In t = In { _in_currentUser :: UserId @@ -61,7 +61,14 @@ view input = do deletePayment <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b) result <- R.dyn . R.ffor ((,) <$> payments <*> currentPage) $ \(is, p) -> - flip Loadable.view is $ \(PaymentPage payments paymentCategories count) -> do + flip Loadable.view is $ \(PaymentPage header payments paymentCategories count) -> do + HeaderInfos.view $ HeaderInfos.In + { HeaderInfos._in_users = _in_users input + , HeaderInfos._in_currency = _in_currency input + , HeaderInfos._in_header = header + , HeaderInfos._in_paymentCount = count + } + table <- Table.view $ Table.In { Table._in_users = _in_users input , Table._in_currentUser = _in_currentUser input -- cgit v1.2.3 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 From 3c67fcf1d524811a18f0c4db3ef6eed1270b9a12 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 17 Nov 2019 19:55:22 +0100 Subject: Hide date from monthly payments --- client/src/View/Payment/Payment.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (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 6bc1614..a34d2f4 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -70,7 +70,7 @@ view input = do } result <- R.dyn . R.ffor payments $ - Loadable.view $ \(PaymentPage page header payments count) -> do + Loadable.view $ \(PaymentPage page frequency header payments count) -> do HeaderInfos.view $ HeaderInfos.In { HeaderInfos._in_users = _in_users input @@ -85,6 +85,7 @@ view input = do , Table._in_categories = categories , Table._in_currency = _in_currency input , Table._in_payments = payments + , Table._in_frequency = frequency } pages <- Pages.view $ Pages.In -- cgit v1.2.3 From 54628c70cb33de5e4309c35b9f6b57bbe9f7a07b Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 24 Nov 2019 16:19:53 +0100 Subject: Compute cumulative income with a DB query --- client/src/View/Payment/Payment.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 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 a34d2f4..a97c3df 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -41,7 +41,7 @@ view input = do R.dyn . R.ffor categories . Loadable.view $ \categories -> do rec - payments <- Reducer.reducer $ Reducer.In + paymentPage <- Reducer.reducer $ Reducer.In { Reducer._in_page = page , Reducer._in_search = HeaderForm._out_search form , Reducer._in_frequency = HeaderForm._out_frequency form @@ -50,7 +50,7 @@ view input = do , Reducer._in_deletePayment = deletePayment } - let eventFromResult :: forall a. (((), Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a) + 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 let addPayment = @@ -59,18 +59,18 @@ view input = do , 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) + page <- eventFromResult $ Pages._out_newPage . snd + tableAddPayment <- eventFromResult $ Table._out_add . fst + editPayment <- eventFromResult $ Table._out_edit . fst + deletePayment <- eventFromResult $ Table._out_delete . fst form <- HeaderForm.view $ HeaderForm.In { HeaderForm._in_reset = () <$ addPayment , HeaderForm._in_categories = categories } - result <- R.dyn . R.ffor payments $ - Loadable.view $ \(PaymentPage page frequency header payments count) -> do + result <- Loadable.view2 paymentPage $ + \(PaymentPage page frequency header payments count) -> do HeaderInfos.view $ HeaderInfos.In { HeaderInfos._in_users = _in_users input @@ -94,7 +94,7 @@ view input = do , Pages._in_page = page } - return ((), table, pages) + return (table, pages) return () -- cgit v1.2.3 From e622e8fdd2e40b4306b5cc724d8dfb76bf976242 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 25 Nov 2019 08:17:59 +0100 Subject: Remove Loadable2 --- client/src/View/Payment/Payment.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 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 a97c3df..8d0fee1 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -38,7 +38,7 @@ view input = do categories <- AjaxUtil.getNow "api/categories" - R.dyn . R.ffor categories . Loadable.view $ \categories -> do + R.dyn . R.ffor categories . Loadable.viewHideValueWhileLoading $ \categories -> do rec paymentPage <- Reducer.reducer $ Reducer.In @@ -69,7 +69,7 @@ view input = do , HeaderForm._in_categories = categories } - result <- Loadable.view2 paymentPage $ + result <- Loadable.viewShowValueWhileLoading paymentPage $ \(PaymentPage page frequency header payments count) -> do HeaderInfos.view $ HeaderInfos.In -- cgit v1.2.3 From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 8 Dec 2019 11:39:37 +0100 Subject: Add category page --- client/src/View/Payment/Payment.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (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 8d0fee1..26444d7 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -36,7 +36,7 @@ data In t = In view :: forall t m. MonadWidget t m => In t -> m () view input = do - categories <- AjaxUtil.getNow "api/categories" + categories <- AjaxUtil.getNow "api/allCategories" R.dyn . R.ffor categories . Loadable.viewHideValueWhileLoading $ \categories -> do -- cgit v1.2.3