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/Loadable.hs | 37 +++++++++++++++++++++++++++++++++++ client/src/View/Income/Income.hs | 15 +++++++------- client/src/View/Income/Reducer.hs | 40 ++++++++++++++++++-------------------- client/src/View/Payment/Form.hs | 1 + client/src/View/Payment/Payment.hs | 18 ++++++++--------- client/src/View/Payment/Reducer.hs | 30 +++++++++++++--------------- 6 files changed, 86 insertions(+), 55 deletions(-) (limited to 'client') diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs index 2b9008a..9a14b3f 100644 --- a/client/src/Loadable.hs +++ b/client/src/Loadable.hs @@ -1,9 +1,12 @@ module Loadable ( Loadable (..) + , Loadable2 (..) , fromEvent , view + , view2 ) where +import qualified Data.Map as M import Reflex.Dom (MonadWidget) import qualified Reflex.Dom as R @@ -50,3 +53,37 @@ view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe view _ Loading = (R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing view _ (Error e) = R.text e >> return Nothing view f (Loaded x) = Just <$> f x + +data Loadable2 t a = Loadable2 + { _loadable_isLoading :: Dynamic t Bool + , _loadable_value :: Dynamic t (Maybe a) + } + +view2 :: forall t m a b. MonadWidget t m => Loadable2 t a -> (a -> m b) -> m (Event t (Maybe b)) +view2 (Loadable2 isLoading value) f = + withLoader isLoading $ + R.dyn . R.ffor value . viewMaybe $ f + + where + viewMaybe _ Nothing = return Nothing + viewMaybe f (Just x) = Just <$> f x + +withLoader + :: forall t m a. MonadWidget t m + => Dynamic t Bool + -> m a + -> m a +withLoader isLoading block = + R.divClass "g-Loadable" $ do + R.elDynAttr "div" (spinnerAttrs <$> isLoading) $ + R.divClass "spinner" R.blank + R.elDynAttr "div" (blockAttrs <$> isLoading) $ + block + where + spinnerAttrs l = M.singleton "class" $ + "g-Loadable__Spinner" + <> (if l then " g-Loadable__Spinner--Loading" else "") + + blockAttrs l = M.singleton "class" $ + "g-Loadable__Content" + <> (if l then " g-Loadable__Content--Loading" else "") diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index d82ab4d..fa2585d 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -19,6 +19,7 @@ import Loadable (Loadable (..)) import qualified Loadable import qualified Util.Ajax as AjaxUtil import qualified Util.Reflex as ReflexUtil +import qualified Util.Reflex as ReflexUtil import qualified View.Income.Header as Header import View.Income.Init (Init (..)) import qualified View.Income.Reducer as Reducer @@ -33,9 +34,8 @@ data In t = In view :: forall t m. MonadWidget t m => In t -> m () view input = do rec - incomes <- Reducer.reducer $ Reducer.In - { Reducer._in_newPage = newPage - , Reducer._in_currentPage = currentPage + incomePage <- Reducer.reducer $ Reducer.In + { Reducer._in_page = page , Reducer._in_addIncome = R.leftmost [headerAddIncome, tableAddIncome] , Reducer._in_editIncome = editIncome , Reducer._in_deleteIncome = deleteIncome @@ -44,15 +44,14 @@ view input = do let eventFromResult :: forall a. ((Header.Out t, 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 + page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c) headerAddIncome <- eventFromResult $ Header._out_add . (\(a, _, _) -> a) tableAddIncome <- eventFromResult $ Table._out_add . (\(_, b, _) -> b) editIncome <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b) deleteIncome <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b) - result <- R.dyn . R.ffor ((,) <$> incomes <*> currentPage) $ \(is, p) -> - flip Loadable.view is $ \(IncomePage header incomes count) -> do + result <- Loadable.view2 incomePage $ + \(IncomePage page header incomes count) -> do header <- Header.view $ Header.In { Header._in_users = _in_users input , Header._in_header = header @@ -69,7 +68,7 @@ view input = do 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 (header, table, pages) diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs index 092d9b3..391890f 100644 --- a/client/src/View/Income/Reducer.hs +++ b/client/src/View/Income/Reducer.hs @@ -11,53 +11,51 @@ import qualified Reflex.Dom as R import Common.Model (IncomePage) -import Loadable (Loadable (..)) -import qualified Loadable as Loadable +import Loadable (Loadable2 (..)) import qualified Util.Ajax as AjaxUtil +import qualified Util.Either as EitherUtil perPage :: Int perPage = 7 data In t a b c = In - { _in_newPage :: Event t Int - , _in_currentPage :: Dynamic t Int + { _in_page :: Event t Int , _in_addIncome :: Event t a , _in_editIncome :: Event t b , _in_deleteIncome :: Event t c } -data Action - = LoadPage Int - | GetResult (Either Text IncomePage) - -reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomePage)) +reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Loadable2 t IncomePage) reducer input = do postBuild <- R.getPostBuild + currentPage <- R.holdDyn 1 (_in_page input) + let loadPage = R.leftmost [ 1 <$ postBuild - , _in_newPage input + , _in_page input , 1 <$ _in_addIncome input - , R.tag (R.current $ _in_currentPage input) (_in_editIncome input) - , R.tag (R.current $ _in_currentPage input) (_in_deleteIncome input) + , R.tag (R.current currentPage) (_in_editIncome input) + , R.tag (R.current currentPage) (_in_deleteIncome input) ] getResult <- AjaxUtil.get $ fmap pageUrl loadPage - R.foldDyn - (\action _ -> case action of - LoadPage _ -> Loading - GetResult (Left err) -> Error err - GetResult (Right incomes) -> Loaded incomes - ) - Loading + isLoading <- R.holdDyn + True (R.leftmost - [ LoadPage <$> loadPage - , GetResult <$> getResult + [ True <$ loadPage + , False <$ getResult ]) + incomePage <- R.holdDyn + Nothing + (fmap EitherUtil.eitherToMaybe getResult) + + return $ Loadable2 isLoading incomePage + where pageUrl p = "api/incomes?page=" diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs index 99dce13..064b5b3 100644 --- a/client/src/View/Payment/Form.hs +++ b/client/src/View/Payment/Form.hs @@ -113,6 +113,7 @@ view input cancel = do setCategory <- R.debounce (1 :: NominalDiffTime) (R.updated $ Input._out_raw name) + >>= (return . R.ffilter (\name -> T.length name >= 3)) >>= (Ajax.get . (fmap ("/api/payment/category?name=" <>))) >>= (return . R.mapMaybe (join . EitherUtil.eitherToMaybe)) 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 () diff --git a/client/src/View/Payment/Reducer.hs b/client/src/View/Payment/Reducer.hs index 0b6c041..d221ff0 100644 --- a/client/src/View/Payment/Reducer.hs +++ b/client/src/View/Payment/Reducer.hs @@ -13,9 +13,9 @@ import qualified Reflex.Dom as R import Common.Model (Frequency (..), PaymentPage) -import Loadable (Loadable (..)) -import qualified Loadable as Loadable +import Loadable (Loadable2 (..)) import qualified Util.Ajax as AjaxUtil +import qualified Util.Either as EitherUtil perPage :: Int perPage = 7 @@ -29,10 +29,6 @@ data In t a b c = In , _in_deletePayment :: Event t c } -data Action - = LoadPage - | GetResult (Either Text PaymentPage) - data Params = Params { _params_page :: Int , _params_search :: Text @@ -48,7 +44,7 @@ data Msg | ResetSearch deriving Show -reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable PaymentPage)) +reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Loadable2 t PaymentPage) reducer input = do postBuild <- R.getPostBuild @@ -94,19 +90,19 @@ reducer input = do getResult <- AjaxUtil.get (pageUrl <$> paramsEvent) - - R.foldDyn - (\action _ -> case action of - LoadPage -> Loading - GetResult (Left err) -> Error err - GetResult (Right payments) -> Loaded payments - ) - Loading + isLoading <- R.holdDyn + True (R.leftmost - [ LoadPage <$ paramsEvent - , GetResult <$> getResult + [ True <$ paramsEvent + , False <$ getResult ]) + paymentPage <- R.holdDyn + Nothing + (fmap EitherUtil.eitherToMaybe getResult) + + return $ Loadable2 isLoading paymentPage + where pageUrl (Params page search frequency) = "api/payments?page=" -- cgit v1.2.3